光沢のある複数の動的サブセット

Question

私はユーザーが入力したデータセットを3回動的にサブセット化するアプリケーションをShinyで作成しようとしています。 のは、データセットが

Number<- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140) 
Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b') 
Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g') 
Index<-c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14') 
df <- data.frame(Number, Att1 , Att2,Index) 

は、私は何をしたいことはATT1からあなたの選択肢AまたはBを与えるドロップダウンメニューを作成することであるということであると仮定しましょう、その後の選択はの選択肢番目のドロップダウンと反応し、 att2が表示されますが、選択肢att1に対してサブセット化されています。選択肢に応じて、ユーザは最後のドロップダウンを選択して、どのインデックスを選択するかを選択できます。インデックスの選択後、データフレームはインデックスによって示された数字だけで返されなければならず、この番号は次のステップで使用されます。

# 
# This is a Shiny web application. You can run the application by clicking 
# the 'Run App' button above. 
# 
# Find out more about building applications with Shiny here: 
# 
# http://shiny.rstudio.com/ 
# 

library(shiny) 
library(data.table) 
# Define UI for application that draws a histogram 
ui <- fluidPage(

    # Application title 
    titlePanel("App"), 

    sidebarLayout(
    sidebarPanel(
     selectInput("Att1", "Choose Att1",choices= c(as.character(unique(df$Att1)) )), 
     uiOutput("c")), 
    # Show a plot of the generated distribution 
    mainPanel(DT::dataTableOutput("table") 

    ) 
) 
) 

# Define server logic required to draw a histogram 
server <- function(input, output) { 
    Number<- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140) 
    Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b') 
    Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g') 
    Index<-c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14') 
    df <- data.frame(Number, Att1 , Att2,Index) 


    selectedData <- reactive({ 
    Ddata<-subset(df,Att1==input$Att1) 
    }) 

    output$c<-renderUI({selectInput("Att2", "Choose Att2",choices= c(as.character(unique(selectedData()$Att2))))}) 
    selectedData2 <- reactive({ 
    Vdata<-subset(selectedData(),Att2==input$c) 
    Vdata<-as.data.frame(Vdata) 
    Vdata 
    }) 

    output$table <- DT::renderDataTable({ 
    head(selectedData2(), n = 10) 
    }) 



} 

# Run the application 
shinyApp(ui = ui, server = server) 

私は限りだところですが、問題は、私は、反応式で反応性のデータセット二度目を使用する方法であり、また最初の2つの属性の出力がnullです。私は何日もこの問題を解決しようとしています。

Answer 1

SelectInputの内容を更新する特定の光沢のある機能があります。updateSelectInput()です。正確に何をしようとするためにそれを使用することができobserve内部で使用される場合

：ここ

server <- function(input, output, session) { 

    observe({ 
     input$Att1 

     x <- df[df$Att1 == input$Att1, 'Att2'] 
     xs <- as.character(unique(x)) 
     updateSelectInput(session, 'Att2', choices = xs) 
    }) 

    selectedData <- reactive({ 
     df[df$Att2 == input$Att2, ] 
    }) 

    output$table <- DT::renderDataTable({ 
     head(selectedData(), n = 10) 
    })  

} 

はちょうどあなたが持っているものを続ける完全

ui <- fluidPage(

    # Application title 
    titlePanel("App"), 

    sidebarLayout(
     sidebarPanel(
      selectInput("Att1", "Choose Att1",choices = as.character(unique(df$Att1)) ), 
      selectInput("Att2", "Choose Att2",choices = NULL, selected = 1) 
      ), 
     # Show a plot of the generated distribution 
     mainPanel(DT::dataTableOutput("table") 

     ) 
    ) 
) 

Answer 2

ためui ..です。ドロップダウンに選択肢として"NULL"を追加しました。"NULL"が選択されている場合は、完全なデータセットが保持されます。

Number <- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140) 
Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b') 
Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g') 
Index <- c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14') 
df <- data.frame(Number, Att1, Att2, Index) 

# 
# This is a Shiny web application. You can run the application by clicking 
# the 'Run App' button above. 
# 
# Find out more about building applications with Shiny here: 
# 
# http://shiny.rstudio.com/ 
# 

library(shiny) 
library(data.table) 
# Define UI for application that draws a histogram 
ui <- fluidPage(

    # Application title 
    titlePanel("App"), 

    sidebarLayout(
    sidebarPanel(
     selectInput("Att1", "Choose Att1", choices = c("NULL", as.character(unique(df$Att1))), selected = "NULL"), 
     uiOutput("c"), 
     uiOutput("d")), 
    # Show a plot of the generated distribution 
    mainPanel(DT::dataTableOutput("table") 

    ) 
) 
) 

# Define server logic required to draw a histogram 
server <- function(input, output) { 

    selectedData <- reactive({ 
    if(input$Att1 == "NULL") Ddata <- df #Keep full data set if NULL 
    else Ddata <- subset(df, Att1 == input$Att1) 

    Ddata 
    }) 

###################### 
    output$c <- renderUI({selectInput("Att2", "Choose Att2", choices = c("NULL", as.character(unique(selectedData()$Att2))), selected = "NULL")}) 

    selectedData2 <- reactive({ 
    if(input$Att2 == "NULL") Vdata <- selectedData() 
    else Vdata <- subset(selectedData(), Att2 == input$Att2) 

    Vdata 
    }) 
###################### 

#===================== 
    output$d <- renderUI({selectInput("Index", "Choose Index", choices = c("NULL", as.character(unique(selectedData2()$Index))), selected = "NULL")}) 

    selectedData3 <- reactive({ 
    if(input$Index == "NULL") Fdata <- selectedData2() 
    else Fdata <- subset(selectedData2(), Index == input$Index) 

    Fdata 
    }) 
#===================== 

    output$table <- DT::renderDataTable({ 
    head(selectedData3(), n = 10) 
    }) 
} 

# Run the application 
runApp(shinyApp(ui = ui, 
     server = server), launch.browser=TRUE 
)