Ես ունեմ որոշ տվյալներ (design.df
ստորև), որոնք ուզում եմ ուսումնասիրել R
shiny
հավելվածով.
set.seed(1)
library(dplyr)
samples <- paste0("s",1:5)
clusters <- paste0("c",1:10)
groups <- paste0("g",1:20)
design.df <- expand.grid(samples,clusters,groups) %>%
dplyr::rename(sample=Var1,cluster=Var2,group=Var3) %>%
dplyr::mutate(value=rnorm(nrow(.)))
Ես ուզում եմ թույլ տալ օգտվողին, որ կարողանա սյունակներից որևէ մեկով սահմանել design.df
-ը (դուրս գալ value
սյունակից): Այս օրինակում դրանք կլինեն sample
, cluster
և group
, բայց իրականում սա հավելված է, որտեղ տարբեր օգտվողներ կբեռնեն data.frame
s տարբեր սյունակներով (թողեք value
սյունակը, որը բոլորը կունենան):
Ես փորձում եմ 10.3.2 Դինամիկ զտման օրինակը հարմարեցնել իմ գործին, բայց ոչ բավականին այնտեղ:
Ահա իմ կոդը.
library(shiny)
library(dplyr)
make_ui <- function(x, var) {
if (is.numeric(x)) {
rng <- range(x, na.rm = TRUE)
sliderInput(var, var, min = rng[1], max = rng[2], value = rng)
} else if (is.factor(x)) {
levs <- levels(x)
selectInput(var, var, choices = levs, selected = levs, multiple = TRUE)
} else {
# Not supported
NULL
}
}
filter_var <- function(x, val) {
if (is.numeric(x)) {
!is.na(x) & x >= val[1] & x <= val[2]
} else if (is.factor(x)) {
x %in% val
} else {
# No control, so don't filter
TRUE
}
}
server <- function(input, output)
{
data <- reactive({
get(input$dataset, data.frame(dplyr::select(design.df,-value)))
})
vars <- reactive(names(data()))
output$filter <- renderUI(
purrr::map(vars, ~ make_ui(data()[[.x]], .x))
)
selected <- reactive({
each_var <- purrr::map(vars, ~ filter_var(data()[[.x]], input[[.x]]))
purrr::reduce(each_var, `&`)
})
scatter.plot <- reactive({
scatter.plot <- NULL
if(!is.null(data()[selected(),]){
plot.df <- suppressWarnings(data()[selected(), ])
scatter.plot <- suppressWarnings(plotly::plot_ly(marker=list(size=3),type='scatter',mode="markers",color=plot.df$sample,x=plot.df$group,y=plot.df$value) %>%
plotly::layout(xaxis=list(title="group",showgrid=F),yaxis=list(title="value",showgrid=F)))
}
return(scatter.plot)
})
output$out.plot <- plotly::renderPlotly({
scatter.plot()
})
}
ui <- fluidPage(
titlePanel("Data Explorer"),
sidebarLayout(
sidebarPanel(
tags$head(
tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
selectInput("dataset", label = "Dataset", choices = colnames(dplyr::select(design.df,-value))),
uiOutput("filter"),
),
mainPanel(
plotly::plotlyOutput("out.plot")
)
)
)
shinyApp(ui = ui, server = server)
Այն մոտ է իմ ուզածին, բայց դեռ մի քանի խնդիր ունի.
- Այն ներկայացնում է design.df-ի բոլոր սյունակները, այլ ոչ թե արձագանքում ընտրվածին:
- Այն չի ցուցադրում ցրման սյուժեն, հավանաբար այն պայմանի պատճառով, որ ես ստեղծել եմ
scatter.plot
reactive
-ում:
Կա՞ պատկերացում, թե ինչն է սխալ:
Երբ դրանք լուծվեն, ես նույնպես պետք է թարմացնեմ գծագրման կոդը scatter.plot
reactive
-ում, որպեսզի այն բացահայտորեն չընտրի design.df-ից սյունակների անունները, այլ ընտրվածները, բայց դա բացարձակապես կարևոր չէ այս գրառման համար: