从反应集中下载 ggvis 图
Download ggvis plot from reactive set
我有一个闪亮的应用程序,允许用户根据加载的数据框选择要在 x 轴和 y 轴上绘制的内容。我试图让用户下载当前的绘图视图。我在 Google Chrome 打开启动应用程序,因为我知道如果应用程序在 R studio 中启动,则无法保存文件。截至目前,它保存了一个 png 文件,但它是空白的。
Screenshot of app UI can be seen here
我已经使用这些帖子来尝试解决问题:
Downloading png from Shiny (R)
Downloading png from Shiny (R) pt. 2
如果 vis()
更改为函数而不是响应式,则该应用程序无法运行。但是,当 filteredData()
从响应式更改为函数时,应用程序仍然可以正常工作。但是,如果在 downloadHandler(...
内我有 vis()
、filteredData()
或 print(filteredData())
,仍然会生成空白 png。如果使用 print(vis())
,另一个 window 会在浏览器中弹出 "Key / already in use"。下面是复制问题的最小工作代码,非常感谢您提供的任何帮助。
#Check packages to use in library
library('shiny') #allows for the shiny app to be used
library('stringr') #string opperator
library('ggvis') #allows for interactive ploting
library('dplyr')
alldata <- iris
#establish options for drop down menus
specieschoices <- unique(as.character(alldata$Species))
petalwchoices <- unique(as.character(alldata$Petal.Width))
petallchoices <- unique(as.character(alldata$Petal.Length))
sepallchoices <- unique(as.character(alldata$Sepal.Length))
sepalwchoices <- unique(as.character(alldata$Sepal.Width))
# UI
ui<-fluidPage(
titlePanel("Explorer"),
fluidRow(
column(4,
wellPanel(
h4("Apply Filters"),
selectInput(inputId = "species", label="Select a Species:", choices = sort(specieschoices), selected="setosa", multiple = TRUE, selectize = TRUE),
selectInput(inputId = "petalw", label="Select Petal Width:", choices = sort(petalwchoices), selected=petalwchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "petall", label="Select Petal Length", choices = sort(petallchoices), selected=petallchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "sepall", label="Select Sepal Length", choices = sort(sepallchoices), selected=sepallchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "sepalw", label="Select Sepal Width", choices = sort(sepalwchoices), selected=sepalwchoices, multiple = TRUE, selectize = FALSE),
downloadButton('downloadPlot', 'Download Plot')
)),
column(8,
ggvisOutput("plot1")
),
column(4,
wellPanel(
h4("Data Variables"),
selectInput(inputId = "x", label="Select x-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Length', multiple = FALSE),
selectInput(inputId = "y", label="Select y-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Width', multiple = FALSE)
))
))
#SERVER
server<-function(input,output,session)
{
#Set up reactive variables
filteredData <- reactive({
# Apply filters
m <- alldata %>% filter(
`Species` %in% input$species,
`Petal.Width` %in% input$petalw,
`Petal.Length` %in% input$petall,
`Sepal.Width` %in% input$sepalw,
`Sepal.Length` %in% input$sepall
)
m <- droplevels(as.data.frame(m))
m
})
vis <- reactive({
xvar <- prop("x", as.symbol(input$x))
yvar <- prop("y", as.symbol(input$y))
p1 = filteredData() %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size.hover := 200,
fillOpacity:= 0.5, fillOpacity.hover := 1,
fill = ~Species
)
})
#Actually plots the data
vis %>% bind_shiny("plot1")
################# THIS IS THE PART THAT I NEED HELP WITH#####################
output$downloadPlot <- downloadHandler(
filename = paste0(input$y, '_vs_', input$x, "_", Sys.Date(), ".png"),
content = function(file) {
png(file)
vis()
dev.off()
},
contentType = 'image/png'
)
##############################################################################
}
#Run the Shiny App to Display Webpage
shinyApp(ui=ui, server=server)
我通过创建另一个函数解决了这个问题,该函数创建了一个 ggplot 图,该图是我的 ggvis 图的精确复制,用于 downloadHandler。
我有一个闪亮的应用程序,允许用户根据加载的数据框选择要在 x 轴和 y 轴上绘制的内容。我试图让用户下载当前的绘图视图。我在 Google Chrome 打开启动应用程序,因为我知道如果应用程序在 R studio 中启动,则无法保存文件。截至目前,它保存了一个 png 文件,但它是空白的。
Screenshot of app UI can be seen here
我已经使用这些帖子来尝试解决问题:
Downloading png from Shiny (R)
Downloading png from Shiny (R) pt. 2
如果 vis()
更改为函数而不是响应式,则该应用程序无法运行。但是,当 filteredData()
从响应式更改为函数时,应用程序仍然可以正常工作。但是,如果在 downloadHandler(...
内我有 vis()
、filteredData()
或 print(filteredData())
,仍然会生成空白 png。如果使用 print(vis())
,另一个 window 会在浏览器中弹出 "Key / already in use"。下面是复制问题的最小工作代码,非常感谢您提供的任何帮助。
#Check packages to use in library
library('shiny') #allows for the shiny app to be used
library('stringr') #string opperator
library('ggvis') #allows for interactive ploting
library('dplyr')
alldata <- iris
#establish options for drop down menus
specieschoices <- unique(as.character(alldata$Species))
petalwchoices <- unique(as.character(alldata$Petal.Width))
petallchoices <- unique(as.character(alldata$Petal.Length))
sepallchoices <- unique(as.character(alldata$Sepal.Length))
sepalwchoices <- unique(as.character(alldata$Sepal.Width))
# UI
ui<-fluidPage(
titlePanel("Explorer"),
fluidRow(
column(4,
wellPanel(
h4("Apply Filters"),
selectInput(inputId = "species", label="Select a Species:", choices = sort(specieschoices), selected="setosa", multiple = TRUE, selectize = TRUE),
selectInput(inputId = "petalw", label="Select Petal Width:", choices = sort(petalwchoices), selected=petalwchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "petall", label="Select Petal Length", choices = sort(petallchoices), selected=petallchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "sepall", label="Select Sepal Length", choices = sort(sepallchoices), selected=sepallchoices, multiple = TRUE, selectize = FALSE),
selectInput(inputId = "sepalw", label="Select Sepal Width", choices = sort(sepalwchoices), selected=sepalwchoices, multiple = TRUE, selectize = FALSE),
downloadButton('downloadPlot', 'Download Plot')
)),
column(8,
ggvisOutput("plot1")
),
column(4,
wellPanel(
h4("Data Variables"),
selectInput(inputId = "x", label="Select x-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Length', multiple = FALSE),
selectInput(inputId = "y", label="Select y-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Width', multiple = FALSE)
))
))
#SERVER
server<-function(input,output,session)
{
#Set up reactive variables
filteredData <- reactive({
# Apply filters
m <- alldata %>% filter(
`Species` %in% input$species,
`Petal.Width` %in% input$petalw,
`Petal.Length` %in% input$petall,
`Sepal.Width` %in% input$sepalw,
`Sepal.Length` %in% input$sepall
)
m <- droplevels(as.data.frame(m))
m
})
vis <- reactive({
xvar <- prop("x", as.symbol(input$x))
yvar <- prop("y", as.symbol(input$y))
p1 = filteredData() %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size.hover := 200,
fillOpacity:= 0.5, fillOpacity.hover := 1,
fill = ~Species
)
})
#Actually plots the data
vis %>% bind_shiny("plot1")
################# THIS IS THE PART THAT I NEED HELP WITH#####################
output$downloadPlot <- downloadHandler(
filename = paste0(input$y, '_vs_', input$x, "_", Sys.Date(), ".png"),
content = function(file) {
png(file)
vis()
dev.off()
},
contentType = 'image/png'
)
##############################################################################
}
#Run the Shiny App to Display Webpage
shinyApp(ui=ui, server=server)
我通过创建另一个函数解决了这个问题,该函数创建了一个 ggplot 图,该图是我的 ggvis 图的精确复制,用于 downloadHandler。