2017-06-27 52 views
0

我有一個數據集,顯示了一組網站,如果每一個定期使用(是/否每個網站),當它最後使用(yesteraday /上週/ ...每個網站)。 我想用一個動態的用戶界面來構建一個閃亮的儀表板,該界面顯示兩個選定網站相鄰的社會人口統計網站配置文件,通過網站使用或網站覆蓋進行過濾。動態UI的閃亮的儀表板。動態用戶界面與多個selectInput每井面板

結構:

選擇濾波器類型(1)網站使用VS(2)網頁到達

在 「網站使用」 的情況下:

選擇第一網站(web1-web5)

選擇第二個網站(web1-web5)

在網站河段的情況下:

選擇第一個網站(WEB1-WEB5)

選擇到達第一個網站(每日,每週,每月,每年)

選擇第二個網站(WEB1-WEB5)

選擇河段第二個網站(每日,每週,每月,每年)

我嘗試以下解決方案從Rstudio: Dynamic UI Guide from Rstudio

我的問題是,使用「開關」的解決方案只允許每個wellPanel一個selectInput字段。像這樣,我無法爲第二個網站添加額外的過濾器。有沒有使用開關的解決方法或不同的解決方案?

樣品數據幀

gender <- factor(sample(1:2, 5, replace = TRUE), 
       levels = c(1,2,99), labels = c("Male", "Female", "Missing Value")) 
age <- sample(18:55, 5, replace = TRUE) 
web1 <- factor(sample(1:2, 5, replace = TRUE), levels = c(1,2,99), 
       labels = c("Yes", "No", "Missing Value")) 
web2 <- factor(sample(1:2, 5, replace = TRUE), levels = c(1,2,99), 
       labels = c("Yes", "No", "Missing Value")) 
web3 <- factor(sample(1:2, 5, replace = TRUE), levels = c(1,2,99), 
       labels = c("Yes", "No", "Missing Value")) 
web4 <- factor(sample(1:2, 5, replace = TRUE), levels = c(1,2,99), 
       labels = c("Yes", "No", "Missing Value")) 
web5 <- factor(sample(1:2, 5, replace = TRUE), levels = c(1,2,99), 
       labels = c("Yes", "No", "Missing Value")) 
web1Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
        labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web2Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
        labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web3Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
        labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web4Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
        labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web5Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
        labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
popWeight <- sample(1000:1500, 5, replace = TRUE) 

df <- data.frame(gender, age, web1, web2, web3, web4, web5, web1Rch, 
       web2Rch, web3Rch, web4Rch, web5Rch, popWeight) 
df 

下面的代碼是多遠我得了。但是我無法創建一個動態UI,允許我爲第二個網站使用圖形填充第二個儀表板列。開關不允許放置兩個selectInput字段。

示例代碼

library(shiny) 
library (tidyr) 
library (dplyr) 
library(ggplot2) 
library(scales) 

# Create Two Versions of Data Frame for "Regular Usage" and "Reach" 

dfRegular <- df[,c(1:7,13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 

dfReach <- df[,c(1:2,8:13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 

# Code for Shiny App  
ui <- fluidPage(  
    titlePanel ("Website Profile"),  
    br(),  
    fluidRow(     
    column(2, 
      wellPanel(
      selectInput(inputId = "evalType", label = "Choose Evaluation", 
         choices = c("Regular", "Reach")) 
      ),    
      wellPanel(uiOutput("ui")) 
    ),    
    column(5, plotOutput("Gender")),     
    column(5, plotOutput("Gender1")) 
) 
) 

server <- function(input, output) { 
    # Output UI 
    output$ui <- renderUI({ 
    if(is.null(input$evalType)) 
     return()   
    switch(
     input$evalType, 
     "Regular" = selectInput(
     inputId = "websiteName", label = "Choose first Website", 
     choices = unique(dfRegular$web)), 
     "Reach" = selectInput(
     inputId = "reachWeb", label = "Choose Reach (second Website)", 
     choices = c("web1Rch", "web2Rch", "web3Rch", "web4Rch", "web5Rch")) 
    )  
    }) 

    output$evalTypeText <- renderText({ 
    input$evalType 
    })  

    dfInput <- reactive({ 
    dfRegular %>% filter(web == input$websiteName & value == "Yes") 
    }) 

    output$Gender <- renderPlot({ 
    df1 <- dfInput() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    })  

    dfInput <- reactive({ 
    dfRegular %>% filter(web == input$websiteName & value == "Yes") 
    }) 

    output$Gender1 <- renderPlot({ 
    df1 <- dfInput() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    })  
} 

shinyApp(ui = ui, server = server) 

回答

1

有一些方法可以幫助你實現你所需要的,你可以使用例如conditionalPanel代替:

[更新]

gender <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Male", "Female", "Missing Value")) 
age <- sample(18:55, 5, replace=TRUE) 
web1 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value")) 
web2 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value")) 
web3 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value")) 
web4 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value")) 
web5 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value")) 
web1Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web2Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web3Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web4Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
web5Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value")) 
popWeight <- sample(1000:1500, 5, replace=TRUE) 

df <- data.frame(gender, age, web1, web2, web3, web4, web5, web1Rch, web2Rch, web3Rch, web4Rch, web5Rch, popWeight) 
df 

library(shiny) 
library (tidyr) 
library (dplyr) 
library(ggplot2) 
library(scales) 

# Create Two Versions of Data Frame for "Regular Usage" and "Reach" 

dfRegular <- df[,c(1:7,13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 

dfReach <- df[,c(1:2,8:13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 


# Code for Shiny App 

ui <- fluidPage(

    titlePanel ("Website Profile"), 

    br(), 

    fluidRow(

    column(2, 
      wellPanel(
      selectInput(inputId = "evalType", label = "Choose Evaluation", choices = c("Regular", "Reach")) 
      ), 

      wellPanel(
      conditionalPanel(condition="input.evalType == 'Regular'", 
           selectInput(inputId = "websiteName", label = "Choose first Website", choices = unique(dfRegular$web))), 
      conditionalPanel(condition="input.evalType == 'Regular'", 
           selectInput(inputId = "websiteName2", label = "Choose second Website", choices = unique(dfRegular$web))), 
      conditionalPanel(condition="input.evalType == 'Reach'", 
           selectInput(inputId = "websiteName3", label = "Choose first Website", choices = unique(dfRegular$web))), 
      conditionalPanel(condition="input.evalType == 'Reach'", 
           selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly"))), 
      conditionalPanel(condition="input.evalType == 'Reach'", 
           selectInput(inputId = "websiteName4", label = "Choose first Website", choices = unique(dfRegular$web))), 
      conditionalPanel(condition="input.evalType == 'Reach'", 
           selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly")))) 
    ) 
    , 

    column(5, 
     plotOutput("Gender") 
), 

    column(5, 
     plotOutput("Gender1") 
)) 
) 




server <- function(input, output) { 

    dfInput <- reactive({ 
    dfRegular %>% filter(web == input$websiteName & value == "Yes") 
    }) 

    output$Gender <- renderPlot({ 
    df1 <- dfInput() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    }) 


    dfInput1 <- reactive({ 
    dfRegular %>% filter(web == input$websiteName2 & value == "Yes") 
    }) 

    output$Gender1 <- renderPlot({ 
    df1 <- dfInput1() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    }) 

} 

shinyApp(ui = ui, server = server) 

if...else statement

您正在使用的switch函數僅適用於當前的一個小部件,因此您需要創建多個output$ui(基於switch)。

+0

謝謝你完美的作品。但由於某種原因,它弄亂了我的列布局。 UI顯示在圖形上方而不是旁邊。 – Finn

+0

只需要移動'fluidRow'的''',看更新 –

1

您可以返回任何你在renderUI想,只要它是類shiny.tag的。例如

# context server 
output$ui <- renderUI({ 
    if (input$evalType == "regular") 
    return(actionButton("some_id", "you clicked option regular")) 
    else 
    return(icon("bolt")) 
}) 
+0

嗨格里高,感謝您的回答。通過這個解決方案,我得到了與「開關」代碼示例相同的錯誤信息。 「不允許多參數回報」。是否有可能將兩個selctInputs返回到一個wellPanel? – Finn

+0

當你輸入'return(a,b)'之類的東西時,通常會發生這個錯誤。你確定,你沒有將多個值傳遞給'return'函數嗎? –

+0

你是對的。將selectInput()按鈕作爲列表返回後,現在一切正常。我將把下面的代碼作爲完整答案。 – Finn

0

我使用@Gregor de Cillia的輸入。以下代碼最終對我最有效。

library(shiny) 
library (tidyr) 
library (dplyr) 
library(ggplot2) 
library(scales) 

# Create Two Versions of Data Frame for "Regular Usage" and "Reach" 

dfRegular <- df[,c(1:7,13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 

dfReach <- df[,c(1:2,8:13)] %>% 
    gather(web, value, -age, -gender, -popWeight) 


# Code for Shiny App  
ui <- fluidPage(  
    titlePanel ("Website Profile"),  
    br(),  
    fluidRow(     
    column(2, 
      wellPanel(
      selectInput(inputId = "evalType", label = "Choose Evaluation", 
         choices = c("Regular", "Reach")) 
      ),    
      wellPanel(uiOutput("ui")) 
    ),    
    column(5, plotOutput("Gender")),     
    column(5, plotOutput("Gender1")) 
) 
) 

server <- function(input, output) { 

# Output UI 
    output$ui <- renderUI({ 
    if (input$evalType == "Regular") 
     return(
     list(uiWeb1 = selectInput(inputId = "websiteName1", label = "Choose first Website", choices = unique(dfRegular$web)), 
      uiWeb2 = selectInput(inputId = "websiteName2", label = "Choose second Website", choices = unique(dfRegular$web))) 
    ) 

    else if(input$evalType == "Reach") 
     return(
     list(uiRch1 = selectInput(inputId = "websiteName3", label = "Choose first Website", choices = unique(dfReach$web)), 
      uiRch2 = selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly")), 
      uiRch3 = selectInput(inputId = "websiteName4", label = "Choose second Website", choices = unique(dfReach$web)), 
      uiRch4 = selectInput(inputId = "reach2", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly")) 
      ) 
    ) 

    else 
     return(icon("bolt")) 
    }) 

    dfInput1 <- reactive({ 
    dfRegular %>% filter(web == input$websiteName1 & value == "Yes") 
    }) 

    output$Gender <- renderPlot({ 
    df1 <- dfInput1() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    })  

    dfInput2 <- reactive({ 
    dfRegular %>% filter(web == input$websiteName2 & value == "Yes") 
    }) 

    output$Gender1 <- renderPlot({ 
    df1 <- dfInput2() 
    ggplot(df1) + 
     aes(x = gender, y = popWeight/sum(popWeight)) + 
     stat_summary(fun.y = sum, geom = "bar") + 
     scale_y_continuous("Population (%)", labels = scales::percent) 
    })  
} 

shinyApp(ui = ui, server = server)