#r #shiny #shinydashboard #shiny-reactivity
Вопрос:
Я пытаюсь создать приложение shinyApp с набором панелей вкладок внутри панелей вкладок. Однако, если на одной из этих встроенных панелей вкладок у меня есть панель вкладок, которая имеет реактивное значение (например, радиоБуттон или флажок), реактивный элемент не работает, и его значение во входных данных равно НУЛЮ. Это приводит к неправильному отображению некоторых моих графиков, если они находятся в поле с селектором. Любая идея о том, почему это происходит или что я могу сделать, чтобы это исправить, была бы отличной.
Приложение reprex (в этом случае флажок ввода для оси y работает, но в моем реальном приложении это не так.)
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyjs)
library(tidyverse)
options(warn=-1)
data(iris)
data(mtcars)
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
shinyjs::useShinyjs(),
sidebarMenu(id = "menume",
#selectInput("which unit", "Choose a unit", choices = c("aa", "bb", "cc", "dd")),
selectInput("colorme", "Choose a color", c("red", "yellow", "green", "blue", "black")),
#sidebarMenuOutput("colormenu"),
menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),
selectInput("irvar", "Choose a variable", choices = colnames(iris))
)
),
dashboardBody(
tabItems(
tabItem("mt", uiOutput("mttabs")),
tabItem("ir", uiOutput("irtabs"))
)
)
)
# ui <- secure_app(ui, enable_admin = TRUE)
# Begin Server ----------------------------------------------
server <- function(input, output, session) {
# output$colormenu = renderMenu({
# # Remove the req
# selectInput("colorme", "Choose a color", c("red", "yellow", "green", "blue", "black"))
#
#
# })
permission_color = reactive({
if(input$colorme =="green"){
TRUE
}else{
FALSE
}
})
output$mttabs = renderUI({
output$mtcarsplot1=renderPlot({
myplot = ggplot(mtcars, aes_string(x = input$mtvar)) stat_bin(nbins = 10)
if(input$tenfoldmt == TRUE){myplot = myplot ylim(c(0,10))}
myplot
})
output$mtcarsplot2=renderPlot({
ggplot(mtcars, aes_string(x = input$mtvar)) geom_density()
})
output$mtcarstable1=renderTable({
tabme= head(mtcars, 5)
tabme
})
if(permission_color()==TRUE){
tabsetPanel(id = "mtcarstabsall",
tabPanel("Plots",
tabsetPanel(id = "mtplotsall",
tabPanel(id = "mtplots","mtcars plots",value=2,
fluidRow(box(title = "Plot1",
checkboxInput("tenfoldmt", "Y axis lim 10?", value = FALSE),
plotOutput("mtcarsplot1"))
)),
tabPanel(id = "mtplots2","mtcars plots 2",value=3,
fluidRow(box(title = "Plot2", plotOutput("mtcarsplot2")))))
),
tabPanel("Tables",
tabsetPanel(id = "mttables",
tabPanel(id = "mttable","MTcars tables",value=1,
fluidRow(box(title = "Table 1", tableOutput("mtcarstable1")))
)))
)
} else{
tabsetPanel(id = "mtcarstabsall",
tabPanel("Plots",
tabsetPanel(id = "mtplotsall",
tabPanel(id = "mtplots","mtcars plots",value=2,
fluidRow(box(title = "Plot1",
checkboxInput("tenfoldmt", "Y axis lim 10?", value = FALSE),
plotOutput("mtcarsplot1"))
)),
tabPanel(id = "mtplots2","mtcars plots 2",value=3,
fluidRow(box(title = "Plot2", plotOutput("mtcarsplot2")))))
)
)
}
})
output$irtabs = renderUI({
output$irisplot1=renderPlot({
myplot = ggplot(iris, aes_string(x = input$irvar)) stat_bin(nbins = 10)
if(input$tenfoldir == TRUE){myplot = myplot ylim(c(0,10))}
myplot
})
output$irisplot2=renderPlot({
ggplot(iris, aes_string(x = input$irvar)) geom_density()
})
output$iristable1=renderTable({
tabme = head(iris, 5)
tabme
})
if(permission_color()==TRUE){
tabsetPanel(id = "iristabsall",
tabPanel("Plots",
tabsetPanel(id = "irisplotsall",
tabPanel(id = "irisplots","iris plots",value=5,
fluidRow(box(title = "Plot1",
checkboxInput("tenfoldir", "Y axis lim 10?", value = FALSE),
plotOutput("irisplot1"))
)),
tabPanel(id = "irisplots2","iris plots 2",value=6,
fluidRow(box(title = "Plot2", plotOutput("irisplot2"))
)))
),
tabPanel("Tables",
tabsetPanel(id = "iristables",
tabPanel(id = "irtable","iris tables",value=4,
fluidRow(box(title = "Table 1", tableOutput("iristable1")))
)))
)
} else{
tabsetPanel(id = "iristabsall",
tabPanel("Plots",
tabsetPanel(id = "irisplotsall",
tabPanel(id = "irisplots","iris plots",value=5,
fluidRow(box(title = "Plot1",
checkboxInput("tenfoldir", "Y axis lim 10?", value = FALSE),
plotOutput("irisplot1"))
)),
tabPanel(id = "irisplots2","iris plots 2",value=6,
fluidRow(box(title = "Plot2", plotOutput("irisplot2"))
)))
))
}
})
}
shinyApp(ui, server)
Комментарии:
1. Похоже, что вы можете повторно использовать идентификаторы на разных вкладках. Как входные, так и выходные идентификаторы должны быть уникальными.
2. У вас также есть функции рендеринга внутри функций рендеринга. Трудно сказать, какой эффект это может оказать, но в этом нет ни необходимости, ни рекомендации.
3. @Jan ах, я вынул эти графики из renderUI, и это ничего не изменило.
4. Вы тоже решили проблему с дубликатами удостоверений личности?
5. Да, у меня есть, и это все еще не работает