【发布时间】：2019-03-15 14:36:08
【问题描述】：
几天来，我一直在尝试开发一个用于学习目的的应用程序，并且在此过程中我在 SO 中提出了很多问题。最近的一个是this，它帮助开发了我现在拥有的代码。
现在我正在尝试为应用程序生成一个下载按钮（使用来自 datacamp.com 的示例的一部分），但我没有获得所需的输出。新的调整是 (i) 添加文件扩展名（例如 csv 或 tsv）的选择和 (ii) 在应用程序主体中的下载按钮，以便下载由侧边栏中的输入选择的数据集。
我了解 RStudio 浏览器的下载按钮存在问题，因此我在 chrome 上运行该应用程序。当我尝试打开它时，我的下载文件既不是 csv 也不是 tsv，也不是与数据集有任何相似之处（它在我的机器中作为 HTML 文件打开）。
我相信我可能在服务器上的响应式或创建的用于处理多个菜单项的函数(convertMenuItem)* 中遇到问题，在添加下载选项时可能无法正常工作。
*我需要更仔细地理解它。顺便说一句，我感谢@phalteman。这个功能真的很有帮助。
SUMMARY：下载的输出不是想要的，而是一个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)
【问题讨论】：
标签： r shiny download shinydashboard