R Shiny:读取数据文件,让用户选择变量,使用ggplot进行绘制

时间:2018-11-02 05:22:28

标签: r ggplot2 shiny

如标题中所述,我正在尝试使用R中的Shiny创建一个程序,该程序读取用户上传的csv文件,然后用户可以从该文件中选择一个变量以查看绘制的图通过ggplot。我正在尝试通过两个选项卡实现此目的,第一个选项卡将读取文件,第二个选项卡将使用户选择变量以查看图。

我的代码如下。当前,我能够成功读取用户的文件,但无法基于所选变量进行绘图(我目前仅具有1个变量“ Location”用于演示)。 (HomeWTaxAmt是要绘制的y变量。)

library(shiny)
library(ggplot2)
library(data.table)
library(RColorBrewer)
options(scipen=1000)

ui <- fluidPage(
  navbarPage("User Interface:",tabPanel("Upload",
  titlePanel("Uploading Files"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File",
                multiple = TRUE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),
      tags$hr(),
      checkboxInput("header", "Header", TRUE),
      radioButtons("sep", "Separator",
                   choices = c(Comma = ",",
                               Semicolon = ";",
                               Tab = "\t"),
                   selected = ","),
      tags$hr(),
      radioButtons("disp", "Display",
                   choices = c(Head = "head",
                               All = "all"),
                   selected = "head"),
      radioButtons("quote", "Quote",
                   choices = c(None = "",
                               "Double Quote" = '"',
                               "Single Quote" = "'"),
                   selected = '"')),
    mainPanel(
      verbatimTextOutput("summary"),
      tableOutput("contents")
    ))), 
  tabPanel("Graphing",
                 titlePanel("Plotting Graphs"),
                 sidebarLayout(
                   sidebarPanel(
                     selectInput("variable", "Variable:",
                                 list("Location"))),
                   mainPanel(
                     h3(textOutput("caption")),
                     plotOutput("ggplot")
                   )
  ))
))

server <- function(input, output) {
  output$contents <- renderTable({
    req(input$file1)
    library(data.table)
    data <- fread(input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote)

    if(input$disp == "head") {
      return(head(data))
    }
    else {
      return(data)
    }

  })
  output$summary <- renderPrint({
    summary(data)
  })

  formulaText <- reactive(function() {
    paste("HomeWTaxAmt ~", input$variable)
  })

  output$caption <- renderText(function() {
    formulaText()
  })

  output$ggplot <- renderPlot(function() {
    data <- fread(input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote)
    if(is.null(data)) return(NULL)
    # check for the input variable
    ggplot(data, aes(x=reorder(factor(data[input$variable]), -abs(HomeWTaxAmt), function(x){sum(x)}), 
                     weight = abs(HomeWTaxAmt), fill = factor(data[input$variable]))) + geom_bar(show.legend=FALSE) + xlab(input$variable) + 
            scale_fill_manual(values=brewer.pal(n = 12, name = "Paired"))
  })
}

shinyApp(ui, server)

2 个答案:

答案 0 :(得分:1)

稍微修改了您的代码,希望对您有所帮助。

library(shiny)
library(ggplot2)

ui <- fluidPage(
  navbarPage("User Interface:",tabPanel("Upload",
                                        titlePanel("Uploading Files"),
                                        sidebarLayout(
                                          sidebarPanel(
                                            fileInput("file1", "Choose CSV File",
                                                      multiple = TRUE,
                                                      accept = c("text/csv",
                                                                 "text/comma-separated-values,text/plain",
                                                                 ".csv")),
                                            tags$hr(),
                                            checkboxInput("header", "Header", TRUE),
                                            radioButtons("sep", "Separator",
                                                         choices = c(Comma = ",",
                                                                     Semicolon = ";",
                                                                     Tab = "\t"),
                                                         selected = ","),
                                            tags$hr(),
                                            radioButtons("disp", "Display",
                                                         choices = c(Head = "head",
                                                                     All = "all"),
                                                         selected = "head"),
                                            radioButtons("quote", "Quote",
                                                         choices = c(None = "",
                                                                     "Double Quote" = '"',
                                                                     "Single Quote" = "'"),
                                                         selected = '"')),
                                          mainPanel(
                                            verbatimTextOutput("summary"),
                                            tableOutput("contents")
                                          ))), 
             tabPanel("Graphing",
                      titlePanel("Plotting Graphs"),
                      sidebarLayout(
                        sidebarPanel( uiOutput("variable_x"),
                                      uiOutput("variable_y")),
                        mainPanel(
                          h3(textOutput("caption")),
                          plotOutput("plot")
                        )
                      ))
  ))

server <- function(input, output, session) {
  onSessionEnded(stopApp)
  data <- reactive({
    req(input$file1)
    df <- read.csv(input$file1$datapath, header = input$header, sep = input$sep, quote = input$quote)
    return(df)
  })

  output$contents <- renderTable({
    if (input$disp == "head") {
      return(head(data()))
    }
    else {
      return(data())
    }
  })
  output$summary <- renderPrint({
    summary(data())
  })

  output$variable_x <- renderUI({
    selectInput("variableNames_x", label = "Variable_X", choices = names(data()))  
  })
  output$variable_y <- renderUI({
    selectInput("variableNames_y", label = "Variable_Y", choices = names(data()) ) 
  })
  dat <- reactive({
    test <- data.frame(data()[[input$variableNames_x]], data()[[input$variableNames_y]])
    colnames(test) <- c("X", "Y")
    return(test)
  })

  output$plot <- renderPlot({
    if (is.null(data)) { return(NULL)
    } else {
      ggplot(dat(),aes(x = X,y = Y)) + geom_point(colour = 'red',height = 400,width = 600) +
        labs(y = input$variableNames_y,
             x = input$variableNames_x,
             title = "ggplot")
    }
  })
}

shinyApp(ui, server)

注意:我已经更改了您的ggplot函数,但是您可以根据需要进行更改。

答案 1 :(得分:0)

由于我无权访问您确切的.csv文件,因此我不得不对plotting命令进行一些调整,但是我很确定您可以从那里开始使用它来处理您的数据。请注意,现在不加载.csv文件会在第一个标签上给您带来错误,该错误会在加载数据后立即消失。您可能要在此处使用一些ifelse开关,以确保最终用户不必看到这些R错误。

以下是根据我拥有的一些样本数据按预期绘制图表的代码:

library(shiny)
library(ggplot2)
library(data.table)
library(RColorBrewer)
options(scipen=1000)

#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
# I didn't change anything in this section
ui <- fluidPage(
  navbarPage("User Interface:",tabPanel("Upload",
                                        titlePanel("Uploading Files"),
                                        sidebarLayout(
                                          sidebarPanel(
                                            fileInput("file1", "Choose CSV File",
                                                      multiple = TRUE,
                                                      accept = c("text/csv",
                                                                 "text/comma-separated-values,text/plain",
                                                                 ".csv")),
                                            tags$hr(),
                                            checkboxInput("header", "Header", TRUE),
                                            radioButtons("sep", "Separator",
                                                         choices = c(Comma = ",",
                                                                     Semicolon = ";",
                                                                     Tab = "\t"),
                                                         selected = ","),
                                            tags$hr(),
                                            radioButtons("disp", "Display",
                                                         choices = c(Head = "head",
                                                                     All = "all"),
                                                         selected = "head"),
                                            radioButtons("quote", "Quote",
                                                         choices = c(None = "",
                                                                     "Double Quote" = '"',
                                                                     "Single Quote" = "'"),
                                                         selected = '"')),
                                          mainPanel(
                                            verbatimTextOutput("summary"),
                                            tableOutput("contents")
                                          ))), 
             tabPanel("Graphing",
                      titlePanel("Plotting Graphs"),
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("variable", "Variable:",
                                      list("Location"))),
                        mainPanel(
                          h3(textOutput("caption")),
                          plotOutput("ggplot")
                        )
                      ))
  ))
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


server <- function(input, output, session) {  # make sure to include "session" here, in order to update your inputs later
  # create an reactive upload to access your data more quickly and easily
  reactive_data <- reactive({
    print(input$file1$datapath)
    data <- fread(input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote)
    return(data)
  })

  # preview
  # no library(data.table) required here, as its already loaded at the beginning of the script)
  output$contents <- renderTable({
    # load your data
    data <- reactive_data()

    if(input$disp == "head") {
      return(head(data))
    }
    else {
      return(data)
    }

  })
  output$summary <- renderPrint({
    summary(reactive_data())
  })

  formulaText <- reactive({ # no need for function() here
    paste("HomeWTaxAmt ~", input$variable)
  })

  output$caption <- renderText({
    formulaText()
  })

  output$ggplot <- renderPlot({

    # load your data
    data <- reactive_data()

    # to only plot when data is not NULL, make sure to include the plotting command in the if-else statement
    # no data
    if(is.null(data)){
      return(NULL)

    }else{
    # data

      # update your selectInput first, so that all the variables match your .csv headers
      updateSelectInput(session, "variable",
                        choices = colnames(data),
                        selected = input$variable) # this keeps the input on the last thing selected on tab-change

      # check for the input variable
      # I used aes_string here so that indexing the colnames works
      # you'll have to adjust the plotting command to your needs as my .csv files aren't the same as yours
      plot <- ggplot(data, aes_string(x=colnames(data)[colnames(data) == input$variable], colnames(data)[length(colnames(data))]))+
        geom_bar(stat="identity")

      # Display your plot
      print(plot)

    }

  })
}

shinyApp(ui, server)