单输出主面板闪亮

时间:2015-02-13 13:49:38

标签: r shiny

基于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])
})   
})

}) 

1 个答案:

答案 0 :(得分:0)

洛德

有几种方法可以实现这一目标。如果你想保留你的动作按钮,我会引入一个反应变量来决定要执行的任务。这是修改后的代码:

<强> 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.

银灯