条件输出闪亮UI

Question

条件输出闪亮UI

Chr*_*ris 8 r shiny

我有调查数据.我想用Shiny与合作者分享我的单变量和双变量分析的结果.在调查中有数字和因子变量.根据观看Shiny应用程序的人是否对单变量/双变量摘要感兴趣,并且根据他们想要汇总的变量类型,我希望出现不同的输出.

特别,

i)如果是单变量和数字,则显示:

物品回复率: length() - sum(is.na())
hist()
summary()

ii)如果单变量和因子则显示:

项目回复率
barplot()
table()
prop.table()

iii)如果是双变量和数字*数字,则显示:

项目回复率
散点图: plot(x,y)
summary(x)
summary(y)
cor(x,y,method="spearman")

iv)如果显示双变量和因子*因子,则显示:

项目回复率
条形图...类似"rCharts nvd3 multiBarChart"
table(x,y)
prop.table(x,y)
chisq.test(x,y)

v)如果是双变量和(因子*数字或数字*因子),则显示:

项目回复率
箱形图
因子变量汇总数值变量: by(numeric, factor, summary)
Kruskal Wallis测试 kruskal.test(numeric ~ factor)

目前,我有代码为所有5个步骤生成所需的输出作为单独的应用程序.我想把它们组合成一个闪亮的应用程序.我在概念上苦苦思索如何mainPanel()根据用户在sidebarPanel()UI 上做出的选择来设置显示器以响应它将接收的不同输出.

特别,

如何更改mainPanel()UI标头以反映不同的输出
如何从概念上扩展我的代码以包含多个输出(即下面的代码适用于单个部分,verbatimTextOutput()但我不知道如何继续处理我希望显示的多个部分/类型的输出,如(i-iv中所述) )上面.例如文字,表格,图表.

下面是我的ui.R文件的代码:

library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Shiny Example"),
sidebarPanel(
wellPanel(
selectInput(inputId = "variable1",label = "Select First Variable:", 
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 1"
)
),

wellPanel(
checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
conditionalPanel(
condition="input.bivariate==true",
selectInput(inputId = "variable2", 
label = "Select Second Variable:",
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 2"
)
)
)
),

mainPanel(
h5("Output"),
verbatimTextOutput("out")
)
))

Run Code Online (Sandbox Code Playgroud)

下面是我的模拟数据和我的server.R文件:

binary1 <- rbinom(100,1,0.5)
binary2 <- rbinom(100,1,0.5)
cont1   <- rnorm(100)
cont2   <- rnorm(100)

dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

dat$binary1 <- as.factor(dat$binary1)
dat$binary2 <- as.factor(dat$binary2)
dat$cont1 <- as.numeric(dat$cont1)
dat$cont2 <- as.numeric(dat$cont2)

library(shiny)
library(rCharts)

shinyServer(function(input, output) {

inputVar1 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable1)))
})

inputVar2 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable2)))
})

output$out <- renderPrint({

if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
table(eval(inputVar1()))
} else {

if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
summary(eval(inputVar1()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
table(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
cor(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar2()), eval(inputVar1()), summary)
} else { 

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar1()), eval(inputVar2()), summary)
}
}
}
}
}
}

})

})

Run Code Online (Sandbox Code Playgroud)

您将提供的任何帮助将不胜感激.甚至简单地展示如何调整代码以在给定变量选择的情况下呈现两个期望的输出.以及如何调整标题以反映命名的输出部分.

提前谢谢......克里斯

Answer 1

sir*_*rus 12

即使这个问题很久以前,我想也许这种方法更好,不需要服务器端的额外代码.

mainPanel(

  wellPanel(
    conditionalPanel(
        condition = "input.myInput == 'value'",
        ..... Your UI for this case ...........
    ),

    conditionalPanel(
        condition = "input.myInput == 'value2'",
        ..... Your UI for this case ...........
    )                 
  )
  )

Run Code Online (Sandbox Code Playgroud)

Answer 2

Ram*_*han 5

我修改了您的Shiny代码(见下文),以便它能够满足您的需求.根据Uni vs Bivariate分析的选择,它会切换选项卡并显示相关结果.

从广义上讲,以下是我必须在代码中更改以获得所需行为的内容:

引入tabPanel以便输出可以分段.
引入了一个observe被动的,以便可以在那里监视你所拥有的嵌套if-else.
我创建了多个输出$变量,以便可以在那里呈现每个选项.
对于标题,我只是h4在各自的tabPanels中添加了一个

工作闪亮应用程序的屏幕截图下面附有一个完整的代码.以此为出发点,从那里开始.

UI.R

library(shiny)
shinyUI(pageWithSidebar(
  headerPanel("Conditional Tab Switch Example"),
  sidebarPanel(
    wellPanel(
      selectInput(inputId = "variable1",label = "Select First Variable:", 
                  choices = c("Binary Variable 1 (Factor)" = "binary1",
                              "Binary Variable 2 (Factor)" = "binary2", 
                              "Continuous Variable 1 (Numeric)" = "cont1",
                              "Continuous Variable 2 (Numeric)" = "cont2"),
                  selected = "Binary Variable 1 (Factor)"
      )
    ),

    wellPanel(
      checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
      conditionalPanel(
        condition="input.bivariate==true",
        selectInput(inputId = "variable2", 
                    label = "Select Second Variable:",
                    choices = c("Binary Variable 1 (Factor)" = "binary1",
                                "Binary Variable 2 (Factor)" = "binary2", 
                                "Continuous Variable 1 (Numeric)" = "cont1",
                                "Continuous Variable 2 (Numeric)" = "cont2"),
                    selected = "Binary Variable 2 (Factor)"
        )
      )
    )
  ),

    mainPanel(
      h5("Output"),
      tabsetPanel(id ="analysisTabs",
              tabPanel(title = "Univariate Numeric", value="panel_uni_numeric",
                       h4(" Univariate Numeric"),                       
                       verbatimTextOutput("uni_numeric")),
              tabPanel(title = "Univariate Factor", value="panel_uni_factor",
                       h4(" Univariate Factor"),                       
                       verbatimTextOutput("uni_factor")),
              tabPanel(title = "Bivariate Numeric-Numeric", value="panel_bi_nn",
                       h4(" Bivariate Numeric Numeric"),                       
                       verbatimTextOutput("bi_numeric1_numeric2")),
              tabPanel(title = "Bivariate Factor-Factor", value="panel_bi_ff",
                       h4(" Bivariate Factor Factor"),                       
                       verbatimTextOutput("bi_factor1_factor2")),
              tabPanel(title = "Bivariate Numeric-Factor", value="panel_bi_nf",
                       h4(" Bivariate Numeric Factor"),                       
                           verbatimTextOutput("bi_numeric1_factor2")),
              tabPanel(title = "Bivariate Factor-Numeric", value="panel_bi_fn",
                       h4(" Bivariate Factor Numeric"),                       
                       verbatimTextOutput("bi_factor1_numeric2"))

              )
        )  
  ))

Run Code Online (Sandbox Code Playgroud)

Server.R

binary1 <- rbinom(100,1,0.5)
binary2 <- rbinom(100,1,0.5)
cont1   <- rnorm(100)
cont2   <- rnorm(100)

dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

dat$binary1 <- as.factor(dat$binary1)
dat$binary2 <- as.factor(dat$binary2)
dat$cont1 <- as.numeric(dat$cont1)
dat$cont2 <- as.numeric(dat$cont2)

library(shiny)
#library(rCharts)

shinyServer(function(input, output, session) {

  inputVar1 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable1)))
  })

  inputVar2 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable2)))
  })


  output$uni_factor = renderText({
    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) { 
      table(eval(inputVar1()))
    }
  })
  output$uni_numeric = renderPrint({
    if( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
      summary(eval(inputVar1()))
    }
  })
  output$bi_factor1_factor2 = renderText({
    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
        table(eval(inputVar1()), eval(inputVar2()))
     }    
  })
  output$bi_numeric1_numeric2 = renderPrint({
    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) { 
        cor(eval(inputVar1()), eval(inputVar2()))
    }
  })
  output$bi_numeric1_factor2 = renderPrint({
    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) { 
       by(eval(inputVar2()), eval(inputVar1()), summary)
    }
  })
  output$bi_factor1_numeric2 = renderPrint({
    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) { 
       by(eval(inputVar1()), eval(inputVar2()), summary)
    }
  })


  observe({  
    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
      print("uni f")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_uni_factor")
    } 
    else if( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
      print("uni n")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_uni_numeric")
      } 
    else if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
      print("bi f f")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_bi_ff")
        }
    else if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
      print("bi n n")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_bi_nn")
          } 
    else if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
      print("bi f n")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_bi_fn")
            } 
    else if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
      print("bi n f")
      updateTabsetPanel(session, inputId="analysisTabs", selected="panel_bi_nf")
    }

  })#end observe

})

Run Code Online (Sandbox Code Playgroud)

更新根据评论,我更新了server.R,仅在满足渲染条件的情况下显示结果.具体来说,请注意output$uni_factor = renderText({类型语句后面的每个if 语句.仍然可以单击选项卡,但它们不会显示任何结果.(据Shiny小组讨论过完全隐藏标签,但据我所知,它尚未明确实施.)

归档时间：	12 年，6 月前
查看次数：	27216 次
最近记录：	7 年，6 月前