(Shiny,R)从csv文件制作直方图(通过组合框选择列/选择输入。

时间:2016-04-19 11:04:04

标签: r plot shiny histogram

我的申请还有另外一个问题。我需要添加直方图功能。

在第三个选项卡上,应用程序应该从上传的文件创建直方图(通过组合框/选择输入选择列)。

应用程序实际上可以使用csv文件中的列创建组合框。

但是当我想制作直方图时,在选项卡"直方图只显示错误:

ERROR: object of type 'closure' is not subsettable

我不知道我做错了什么。

有代码

ui <- shinyUI(fluidPage(
  titlePanel("Aplikacja testowa nr 6. Praca z plikiem- wybór kolumny"),

  sidebarLayout(
    sidebarPanel(
      fileInput("file", label = h3("Wgraj Plik")),
      checkboxInput(inputId = 'header', label = 'Pierwszy wers to etykiety', value = FALSE),
      radioButtons(inputId = 'sep', label = 'Co jest separatorem', choices = c("Przecinek"=',',"Średnik"=';',"Tabulator"='\t', "Spacja"=''), selected = ','),

      checkboxGroupInput("choices1", label = h3("Wybierz Kolumny"), choices = NULL),
      # there is combobox to pick column
        selectInput("combobox", label = h3("(Histogram) Wybierz kolumne"),  choices = NULL)





    ),

    mainPanel(
       uiOutput("tb")
    )
  )
))

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

  data <- reactive({
    file1 <- input$file
    if(is.null(file1)){return()} 
    dataSet <- read.csv(file=file1$datapath, sep=input$sep, header = input$header )

    updateCheckboxGroupInput(session, "choices1", choices = colnames(dataSet))
      # this line updates selection in combobox 
    updateSelectInput(session, "combobox", choices = colnames(dataSet))

    dataSet
  })

  output$table <- renderTable({
    if(is.null(data())){return ()}
    data()    
  })

  output$table2 <- renderTable({


    if(is.null(data()) || is.null(input$choices1)){return ()}
    data()[input$choices1]    
  })

# there is part of file where i make histogram
 output$wykres <- renderPlot({
x    <- data[0, input$combobox] 
 hist(x , col = 'blue', border = 'white')
})


  output$tb <- renderUI({
    if(is.null(data()))
      h5("Wgraj Plik jeśli chcesz cokolwiek zrobić.")
    else
      tabsetPanel(tabPanel("dane", tableOutput("table")),tabPanel("wybrane kolumny", tableOutput("table2")), tabPanel("Histogram", plotOutput("wykres")))
  })
}

shinyApp(ui, server)

1 个答案:

答案 0 :(得分:1)

问题是您忘记在以下代码块中将()添加到data

output$wykres <- renderPlot({
    # x  <- data[, input$combobox] # zapomniales klamry 
    x    <- data()[, input$combobox] 
    hist(x , col = 'blue', border = 'white')
  })

我还扩展了您的代码,以避免通过使用hist包创建警报并添加shinyBS来将离散变量传递到req(is.numeric(x))函数中。

library(shinyBS)

ui <- shinyUI(fluidPage(
  titlePanel("Aplikacja testowa nr 6. Praca z plikiem- wybór kolumny"),

  sidebarLayout(
    sidebarPanel(
      fileInput("file", label = h3("Wgraj Plik")),
      checkboxInput(inputId = 'header', label = 'Pierwszy wers to etykiety', value = FALSE),
      radioButtons(inputId = 'sep', label = 'Co jest separatorem', choices = c("Przecinek"=',',"Średnik"=';',"Tabulator"='\t', "Spacja"=''), selected = ','),

      checkboxGroupInput("choices1", label = h3("Wybierz Kolumny"), choices = NULL),
      # there is combobox to pick column
      selectInput("combobox", label = h3("(Histogram) Wybierz kolumne"),  choices = NULL)

    ),

    mainPanel(
      uiOutput("tb")
    )
  )
))

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

  data <- reactive({
    file1 <- input$file
    if(is.null(file1)){return()} 
    dataSet <- read.csv(file=file1$datapath, sep=input$sep, header = input$header )

    updateCheckboxGroupInput(session, "choices1", choices = colnames(dataSet))
    # this line updates selection in combobox 
    updateSelectInput(session, "combobox", choices = colnames(dataSet))

    dataSet
  })

  output$table <- renderTable({
    if(is.null(data())){return ()}
    data()    
  })

  output$table2 <- renderTable({


    if(is.null(data()) || is.null(input$choices1)){return ()}
    data()[input$choices1]    
  })

  # there is part of file where i make histogram
  output$wykres <- renderPlot({
    x    <- data()[, input$combobox] 

    if (!is.numeric(x)) {
      createAlert(session, "alarm", alertId = "niebezpieczenstwo", 
                  title = "Niebezpieczenstwo: ",
                  content = "Histogram przyjmuje tylko wartosci ciagle!", 
                  style = "danger", dismiss = TRUE, append = TRUE)
    }
    if (is.numeric(x)) {
      closeAlert(session, "niebezpieczenstwo")
    }

    req(is.numeric(x))
    hist(x , col = 'blue', border = 'white')
  })


  output$tb <- renderUI({
    if(is.null(data()))
      h5("Wgraj Plik jeśli chcesz cokolwiek zrobić.")
    else
      tabsetPanel(tabPanel("dane", tableOutput("table")),
                  tabPanel("wybrane kolumny",
                            tableOutput("table2")), 
                  tabPanel("Histogram", 
                           bsAlert("alarm"),
                           plotOutput("wykres")))
  })
}

shinyApp(ui, server)