downloadHandler无法产生所需的输出

时间:2019-03-15 14:36:09

标签: shiny download shinydashboard

我已经尝试了几天来开发用于学习目的的应用程序,并且在此过程中我问了很多关于SO的问题。最新的是this,它有助于开发我现在拥有的代码。

现在,我正在尝试为该应用程序生成一个下载按钮(使用datacamp.com的示例的一部分),但未获得所需的输出。新的改编是(i)添加文件扩展名的选择(例如csv或tsv),以及(ii)应用程序主体中的下载按钮,以便下载侧边栏中输入所选择的数据集。

我了解RStudio浏览器的下载按钮存在问题,因此我正在chrome上运行该应用。仍然我的下载文件既不是csv也不是tsv,当我尝试打开它时,它也不显示与数据集的任何相似之处(它在我的计算机中以HTML文件的形式打开)。

我相信我可能对服务器上的反应堆或侧边栏中的用于处理多个菜单项(convertMenuItem)*的创建函数有问题,可能无法添加下载选项。

*我需要更仔细地理解它。顺便说一句,我感谢@phalteman。该功能真的很有帮助。

摘要:下载的输出不是所需的输出,而是html文件。代替 我希望该选项选择文件类型(例如csv或tsv),并相应地在边栏中下载带有所选输入的数据集。目前,它似乎不起作用。

这是我要调试的代码:

library(shiny)
library(ggplot2)
library(dplyr)
library(shinydashboard)

rm(list=ls()); gc()

#function to adaptate menuItem

convertMenuItem <- function(mi,tabName) {
  mi$children[[1]]$attribs['data-toggle']="tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  mi
}

#functions to order the plot

reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
  new_x <- paste(x, within, sep = sep)
  stats::reorder(new_x, by, FUN = fun)
}

scale_x_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}

#example data

sample_data = data.frame(Company_Name=c("Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3"),
                         Profits_MM = c(20,100,80,
                                        45,120,70,
                                        50,110,130),
                         Sales_MM = c(200,800,520,
                                      300,1000,630,
                                      410,1150,1200),
                         Year=c(2016,2016,2016,
                                2017,2017,2017,
                                2018,2018,2018))

###app code###

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Dashboard Test"),
  dashboardSidebar(
    sidebarMenu(
      convertMenuItem(menuItem("Data Selection", tabName = "dc", icon = icon("dashboard"),
                               checkboxGroupInput(inputId = "sel_com",
                                                  label = "Company Selection:",
                                                  choices = c("Company 1","Company 2","Company 3"),
                                                  selected = "Company 1"),
                               selectInput(inputId = "y", 
                                           label = "Performance Variable",
                                           choices = c("Profits (in Millions)" = "Profits_MM", 
                                                       "Sales (in Millions)" = "Sales_MM"),
                                           selected = "Profits_MM"),
                               sliderInput("year","Year Selection:",
                                           min=2016,
                                           max=2018,
                                           value=c(2017,2018),
                                           step=1),
                               radioButtons(inputId = "filetype",
                                            label = "Select filetype:",
                                            choices = c("csv", "tsv"),
                                            selected = "csv")), tabName="dc")
    )
  ),  

 dashboardBody(

  tabItems(
    # First tab content
    tabItem(tabName = "dc",

            fluidRow(column(width=12,box(plotOutput("barplot"))),
             downloadButton(outputId = "download_data", 
                            label = "Download data")


              )
      )
    )
  )
)


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

  companies_sel <- reactive({

    req(input$sel_com)

    sample_data_gg = filter(sample_data, Company_Name %in% input$sel_com)
    #  print(sample_data_gg)
    sample_data_gg

  })

  year_sample <- reactive({

    req(input$year)
    sample_data_gg = sample_data
    if((input$year[2] - input$year[1])>1){

      Years = seq(input$year[1],input$year[2])

      sample_data_gg = filter(companies_sel(), Year %in% Years)

    }  

    if((input$year[2] - input$year[1])==1){

      sample_data_gg = filter(companies_sel(), Year %in% input$year)

    }
    #  print(sample_data_gg)
    sample_data_gg
  })


  output$barplot = renderPlot({

    sample_data_gg = year_sample()

    y <- input$y
    ggplot(data = sample_data_gg, aes(x=reorder_within(Company_Name, get( y ), Year), y = get( y ))) +
      geom_col(position="dodge", fill="darkred") +
      facet_wrap(Year~., scales = "free")  +
      scale_x_reordered() +
      theme(axis.text.x = element_text(angle = 60, hjust = 1))


  })

  # Download file as written in a datacamp example
  output$download = downloadHandler(filename = 
                                       function(){paste("company_obs", input$filetype, sep=".")},
                                    content = function(file) { 
                                       if(input$filetype == "csv"){ 
                                         write_csv(year_sample(), path = file) 
                                       }
                                       if(input$filetype == "tsv"){ 
                                         write_tsv(year_sample(), path = file) 
                                       }
                                     }
  )

}

app = shinyApp(ui, server)

runApp(app, launch.browser = TRUE)  

1 个答案:

答案 0 :(得分:1)

此问题的简单修复。您的downloadButton ID为download_data,但您在downloadHandler中引用了output$download。将其更改为output$download_data,就可以了。您还需要预先包含readr库,因为write_csv()write_tsv()来自该软件包。