我正在编写一个闪亮的应用程序来实现以下效果:
每当我选择categoryname
包含的变量时,web都会生成滑块(这里我使用条件面板),它提供了一个分隔符。它将所选变量分为两组,并形成一个添加到原始数据集的新列。
现在可以生成网页。我的问题是:
categoryname
中选择变量时,应该隐藏滑块,但它总是出现。categoryname
中选择变量时,页面都会退出。错误显示:
Warning in max(MT_EG$id_arm) :
no non-missing arguments to max; returning -Inf
Warning in input$divider$max <- max(MT_EG$id_arm) :
Coercing LHS to a list
Warning: Error in $<-.reactivevalues: Attempted to assign value to a read-only reactivevalues object
75: stop
74: $<-.reactivevalues
72: observeEventHandler [/opt/bee_tools/shiny/3.5.1/users/denga2/teal.modules.km/testapp/app.R#75]
1: runApp
那么改变滑块最大值的尝试并不是唯一的原因。当我将其设置为固定时,页面也会退出。
在代码中我只使用mtcars数据集,以便所有人都可以访问。
library(shiny)
categoryname = c("mpg_group", "disp_group")
MT_EG = mtcars[,1:5]
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Mtcars Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(inputId = "arm",
label = "ARM VARIABLE",
choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
selected = "cyl"),
conditionalPanel(
condition = "categoryname.includes(input.arm)",
#condition = "categoryname == input.arm",
#optionalSliderInputValMinMax("divider", "divide slider", c(50,0,100), ticks = FALSE)
sliderInput("divider", "divide slider", 0, 100, 50)
)
),
# Show a plot of the generated distribution
mainPanel(
uiOutput("data")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observeEvent(
input$arm,
{
if (input$arm %in% categoryname){
# start over and remove the former column if exists
MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]
id_arm_var <- input$arm
id_arm <- unlist(str_split(id_arm_var,'_'))[1]
# change the range of the slider
input$divider$max = max(MT_EG$id_arm)
input$divider$min = min(MT_EG$id_arm)
# generate a new column and bind
divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
MT_EG <- cbind(MT_EG,divi)
}
output$data=renderTable(MT_EG)
})
}
# Run the application
shinyApp(ui = ui, server = server)
有任何想法吗?感谢你们!
有几个错误。
id_arm
不是MT_EG
专栏的名称。这是一个包含字符串的变量,该字符串是MT_EG
列的名称。所以你必须做MT_EG[[id_arm]]
而不是MT_EG$id_arm
。
您无法通过执行input$divider$max = max(MT_EG$id_arm)
更新滑块。请参阅?updateSliderInput
以更新滑块。
condition = "categoryname.includes(input.arm)"
不正确。 JavaScript方面没有变量categoryname
。相反,你可以这样做:
condition = "input.arm == 'mpg_group' || input.arm = 'disp_group'"
MT_EG$id_arm
无效R语法特别是id_arm一个变量包含列名,要做一个这样的调用使用MT_EG[[id_arm]]
或MT_EG[,id_arm]
。在MT_EG[,id_arm]
,因为drop = FASLE和drop = TRUE。在视觉期间使用updateSliderInput
更新Sliderinput。
library(shiny)
categoryname = c("mpg_group", "disp_group")
MT_EG = mtcars[,1:5]
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Mtcars Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput(inputId = "arm",
label = "ARM VARIABLE",
choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
selected = "cyl"),
conditionalPanel(
#condition = "categoryname.includes(input.arm)",
condition = "input.arm == 'disp_group' | input.arm == 'mpg_group'",
sliderInput("divider", "divide slider", 0, 100, 50)
)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
uiOutput("data")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- MT_EG[, 1]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
observeEvent(
input$arm,
{
if (input$arm %in% categoryname){
#browser()
# start over and remove the former column if exists
MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]
id_arm_var <- input$arm
id_arm <- unlist(str_split(id_arm_var,'_'))[1]
# change the range of the slider
#input$divider$max = max(MT_EG$id_arm)
val <- input$divider
mx = max(MT_EG[[id_arm]])
mn = min(MT_EG[[id_arm]])
updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
#input$divider$min = min(MT_EG$id_arm)
# generate a new column and bind
#divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
MT_EG <- cbind(MT_EG,divi)
}
output$data=renderTable(MT_EG)
})
}
# Run the application
shinyApp(ui = ui, server = server)
server <- function(input, output, session) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- MT_EG[, 1]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
data <- reactiveValues()
observeEvent(
input$arm,
{
if (input$arm %in% categoryname){
#browser()
# start over and remove the former column if exists
MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]
id_arm_var <- input$arm
id_arm <- unlist(str_split(id_arm_var,'_'))[1]
data$armv <- id_arm_var
data$arm <- id_arm
# change the range of the slider
#input$divider$max = max(MT_EG$id_arm)
val <- input$divider
mx = max(MT_EG[[id_arm]])
mn = min(MT_EG[[id_arm]])
updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
#input$divider$min = min(MT_EG$id_arm)
# generate a new column and bind
#divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
}
})
df_final <- reactive({
req(data$armv, data$arm) #Do not start process data$armv and data$arm unless they are available. To prevent unnecessary Error messages
id_arm_var <- data$armv
id_arm <- data$arm
divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
MT_EG <- cbind(MT_EG,divi)
})
output$data=renderTable(df_final())
}