Скрыть / Показать таблицу в R блестящий на основе входного значения - PullRequest
0 голосов
/ 25 мая 2018

Я пытаюсь показать / скрыть таблицу на основе выбора ввода.Исходя из моего первого выпадающего списка, если пользователь выбирает значение wave2, он должен показать таблицу 2 на 1-й вкладке, иначе он должен скрыться.Я попытался использовать значение выбора входа реакции, чтобы, если еще условие для вывода, которое не соответствует реакции, работает в R. Может ли кто-нибудь проверить и сообщить мне, где я ошибаюсь.

UI.r

library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinythemes)

dashboardPage(
  dashboardHeader(disable = F, title = "PATH Study"),
  dashboardSidebar(
    uiOutput("choose_wave"),
    uiOutput("choose_category"),
    uiOutput("choose_ethnicity"),
    uiOutput("choose_age"),
    uiOutput("choose_gender")
  ),
  #S dashboardPage(header = dashboardHeader(), sidebar = dashboardSidebar(),body,title = NUll, skin = "yellow"),
  dashboardBody(box(
    width = 12,
    tabBox(
      width = 12,
      id = "tabBox_next_previous",
      tabPanel("Initiation",
               fluidRow(
                 box(
                   title = "TABLE1",
                   width = 5,
                   solidHeader = TRUE,
                   status = "primary",
                   tableOutput("smoke"),
                   collapsible = T,

                 ),
                 box(
                   title = "TABLE2",
                   width = 7,
                   solidHeader = TRUE,
                   status = "primary",
                   tableOutput("first_flov"),
                   collapsible = T
                 )
                  ))
    ),
    uiOutput("Next_Previous")
  ))
)

SERVER.r

library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(plyr)
library(tidyverse)
library(DT)
library(dplyr)

shinyServer(function(input, output) {
  print(sessionInfo())

  with_demo_vars <- reactive({
    data_selector(wave(), youth()) %>%
      mutate(
        ethnicity = !!ethnicity(),
        age = !!age_group(),
        gender = !!gender()
      )
  })
  # Drop-down selection box for which Wave and User Type bracket to be selected
  output$choose_wave <- renderUI({
    # This can be static: it is the highest level and the options won't change
    selectInput(
      "selected_wave",
      "Wave",
      choices = list(
        "Wave 1 Adult" = "wave1youthFALSE",
        "Wave 1 Youth" = "wave1youthTRUE",
        "Wave 2 Adult" = "wave2youthFALSE",
        "Wave 2 Youth" = "wave2youthTRUE"
      )
    )
  })

  wave <- reactive({
    as.integer(gsub("wave(\\d)youth.*", "\\1", input$selected_wave))
  })

  youth <- reactive({
    as.logical(gsub("wave\\dyouth(.+)$", "\\1", input$selected_wave))
  })


  # Drop-down selection box for which Gender bracket to be selected
  output$choose_ethnicity <- renderUI({
    selectInput("selected_ethnicity", "Ethnicity", as.list(levels(with_demo_vars()$ethnicity)))
  })
  # Drop-down selection box for which Age bracket to be selected
  output$choose_age <- renderUI({
    selectInput("selected_age", "Age", as.list(levels(with_demo_vars()$age)))
  })
  # Drop-down selection box for which Gender bracket to be selected
  output$choose_gender <- renderUI({
    selectInput("selected_gender", "Gender", as.list(levels(with_demo_vars()$gender)))
  })

  output$selected_var <- renderText({
    paste("You have selected", input$selected_wave)
  })

    myData <- reactive({
    # wave_selected <- input$selected_wave
    category_selected <- req(input$selected_category)
    age_selected <- req(input$selected_age)
    gender_selected <- req(input$selected_gender)
    ethnicity_selected <- req(input$selected_ethnicity)

    # TABLE 1
    df<-data_selector(wave = 1, youth()) %>%
      filter(!!is_ever_user(type = category_selected)) %>%
      pct_first_flavored(type = category_selected)
    df_sub <- names(df) %in% c("variable")
    df <- df[!df_sub]

    df
      })

  first_flov <- reactive({
    category_selected <- req(input$selected_category)
    age_selected <- req(input$selected_age)
    gender_selected <- req(input$selected_gender)
    ethnicity_selected <- req(input$selected_ethnicity)

    first_flov_df <- data_selector(wave = 2, youth()) %>%
      filter(!!is_new_user(type = category_selected)) %>%  # this doesn't apply to wave 1
      pct_first_flavored(type = category_selected)

    first_flov_df_sub <- names(first_flov_df) %in% c("variable")
    first_flov_df <- first_flov_df[!first_flov_df_sub]
    first_flov_df
      })
  output$smoke <-
    renderTable({
      head(myData())
    })
  output$first_flov <-
        if (wave() == 2) {
      renderTable({
        head(first_flov())
      })
    } else {
      renderText({
        paste("You have selected", input$selected_wave)
      })
    }

})
...