单输出主面板闪亮

Question

以 Stack Overflow 上的代码示例为基础，我构建了我的第一个闪亮的应用程序，其行为符合预期。我可以加载数据文件并对数据框中的变量执行各种统计任务。

我的 ui.r 和 server.r 脚本如下。

我想修改代码，使主面板只有一个输出窗口；目前，每个可能的操作按钮都有一个窗口。当前示例只有三个任务：str()、cor() 和 lm()。

我想要完成的是任何任务的结果都会出现在单个窗口中。如果用户选择不同的操作，窗口将更新为新结果。

谁能指出一个我可以研究的工作示例或建议一种相应修改我的代码的方法？

ui.r

library(shiny)
shinyUI(fluidPage(
titlePanel("Multiple Linear Regression"),
sidebarLayout(
sidebarPanel(
  fileInput('file1', 'Choose File',
            accept=c('text/csv', 
                     'text/comma-separated-values,text/plain', 
                     '.csv')),

  tags$hr(),
  checkboxInput('header', 'Header', TRUE),

  radioButtons('sep', 'Separator',
    c(Comma=',',
    Semicolon=';',
    Tab='\t'),
    'Comma'),

  radioButtons('quote', 'Quote',
    c(None='',
    'Double Quote'='"',
    'Single Quote'="'"),
    'Double Quote'),

  actionButton("structure", "View data structure"),

  uiOutput("dependent"),
  uiOutput("independents"),
  tags$hr(),
  actionButton("regression", "Linear regression"),
  actionButton("correlation", "Correlation")

),
mainPanel(
  verbatimTextOutput('structure'),
  verbatimTextOutput('regression'),
  verbatimTextOutput('correlation')
)
)
))

server.r

library(shiny)
shinyServer(function(input, output) {

filedata <- reactive({
infile <- input$file1
if (is.null(infile)){
  return(NULL)      
}

read.csv(infile$datapath, sep=input$sep, quote=input$quote)

})

output$dependent <- renderUI({
df <- filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
selectInput("dependent","Select dependent variable from:",items)
})


output$independents <- renderUI({
df <- filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
selectInput("independents","Select variable(s) from:",items,multiple=TRUE)
})

output$structure <- renderPrint({
input$structure
isolate({   
  df <- filedata()
  str(df)
})   
})

output$regression <- renderPrint({
input$regression
isolate({   
  df <- filedata()
  if (is.null(df)) return(NULL)
  fmla <- as.formula(paste(input$dependent," ~  ",paste(input$independents,collapse="+")))
  summary(lm(fmla,data=df))
})   
})

output$correlation <- renderPrint({
input$correlation
isolate({   
  df <- filedata()
  if (is.null(df)) return(NULL)
  vars <- c(input$dependent, input$independents)
  cor(df[,vars])
})   
})

}) 

Answer 1

哈罗德，

有几种方法可以做到这一点。如果你想保留你的动作按钮，我会引入一个反应变量来决定要执行什么任务。这是修改后的代码：

ui.r

library(shiny)
shinyUI(fluidPage(
  titlePanel("Multiple Linear Regression"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose File',
                accept=c('text/csv',
                         'text/comma-separated-values,text/plain',
                         '.csv')),

      tags$hr(),
      checkboxInput('header', 'Header', TRUE),

      radioButtons('sep', 'Separator',
                   c(Comma=',',
                     Semicolon=';',
                     Tab='\t'),
                   'Comma'),

      radioButtons('quote', 'Quote',
                   c(None='',
                     'Double Quote'='"',
                     'Single Quote'="'"),
                   'Double Quote'),

      actionButton("structure", "View data structure"),

      uiOutput("dependent"),
      uiOutput("independents"),
      tags$hr(),
      actionButton("regression", "Linear regression"),
      actionButton("correlation", "Correlation")

    ),
    mainPanel(
      verbatimTextOutput('alloutput')
    )
  )
))

server.r

library(shiny)
shinyServer(function(input, output) {

  filedata <- reactive({
    infile <- input$file1
    if (is.null(infile)){
      return(NULL)
    }

    read.csv(infile$datapath, sep=input$sep, quote=input$quote)

  })

  output$dependent <- renderUI({
    df <- filedata()
    if (is.null(df)) return(NULL)
    items=names(df)
    names(items)=items
    selectInput("dependent","Select dependent variable from:",items)
  })


  output$independents <- renderUI({
    df <- filedata()
    if (is.null(df)) return(NULL)
    items=names(df)
    names(items)=items
    selectInput("independents","Select variable(s) from:",items,multiple=TRUE)
  })

  viewStructure <- function(){
    df <- filedata()
    str(df)
  }

  doRegression <- function(){
    df <- filedata()
    if (is.null(df)) return(NULL)
    fmla <- as.formula(paste(input$dependent," ~  ",paste(input$independents,collapse="+")))
    summary(lm(fmla,data=df))
  }

  doCorrelation <- function(){
    df <- filedata()
    if (is.null(df)) return(NULL)
    vars <- c(input$dependent, input$independents)
    cor(df[,vars])
  }

  task <- reactiveValues(name="")
  observeEvent(input$structure, task$name <- 'structure')
  observeEvent(input$regression, task$name <- 'regression')
  observeEvent(input$correlation, task$name <- 'correlation')

  output$alloutput <- renderPrint({
    task$name
    isolate(
      switch(task$name, 'structure'=viewStructure(), 'regression'=doRegression(), 'correlation'=doCorrelation())
      )
  })

})

或者，您可以将 3 个操作按钮组合成一个 selectInput 和一个操作按钮，如下所示：

fluidRow(
  column(6, selectInput('analysis', '', choices=c('View data structure'='structure',
                                                  'Linear regression'='regression',
                                                  'Correlation', 'correlation'))),
  column(6, actionButton('go', 'Go')))

然后相应地修改server.r。

银灯