I have asked this question on the Shiny Google group but once it is published it is immediately deleted, I don't know why.
So I ask this question here.
I know how to upload a file created from a Shiny application but I have unsuccessfully spent a couple of hours to find how to save a file on the hard drive. Please could you show me a way to do so ? For instance I'd like to save a file created with sink() or a RData file.
Below is an (artificial) example of one of my numerous attempts. The sweaveSave() function does not work. Please don't pay attention to the plot, it does not play a role in my question.
server.R
library(shiny)
##
## function creating a Sweave report
##
createReport <- function(file){
sink(file)
cat(
"\\documentclass{article}\n
\\begin{document}\n
\\SweaveOpts{concordance=TRUE}
This is the Rnw file.\n
<<fig=TRUE>>=
plot(0,0)
#\n
\\end{document}\n")
sink()
}
##
## Shiny server
##
shinyServer(function(input, output) {
##
## Create plot
##
createPlot <- reactive({
# generate an rnorm distribution and plot it
titl <- paste0("Exponential distribution with rate ", round(input$parameter,2))
curve(dexp(x,rate=input$parameter), from=0, to=5, main=titl, ylab=NA, xlab=NA)
})
##
## output : plot
##
output$distPlot <- renderPlot({
createPlot()
})
##
## output : download Sweave file
##
output$sweavedownload <- downloadHandler(
filename="report00.Rnw",
content = createReport
)
##
## save Sweave file
##
sweaveSave <- reactive({
if(input$save){
createReport("REPORT00.Rnw")
}else{NULL}
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Hello Shiny!"),
# Sidebar panel
sidebarPanel(
sliderInput("parameter",
"Rate parameter:",
min = 0.0000000001,
max = 10,
value = 5),
checkboxInput("save", "Check to save and download")
),
# Main panel
mainPanel(
plotOutput("distPlot"),
conditionalPanel(
condition = "input.save",
downloadLink("sweavedownload", "Download")
)
)
))
It make it your life easy by using shinyFiles package.
install.package('shinyFiles')
require(shinyFiles)
shinyFilesExample()
Related
I am new to using Shiny, I have read the tutorials, and a few questions on stacked overflow, but I think I"m still missing some key concept.
Basically I want users to first select a dataset.
Then based on that dataset they can select an OTU of interest.
Then I will display a plot and maybe a table.
I have the syntax for selecting the dataset correct, but how do I generate the choices of OTUs to select based on that ?
Any help appreciated.
thanks
ui <- fluidPage(
# Make a title to display in the app
titlePanel(" Exploring the Effect of Metarhizium on the Soil and Root Microbiome "),
# Make the Sidebar layout
sidebarLayout(
# Put in the sidebar all the input functions
sidebarPanel(
# drop down menu to select the dataset of interest
selectInput('dataset', 'dataset', names(abundance_tables)),
# drop down menu to select the OTU of interest
uiOutput("otu"),
#
br(),
# Add comment
p("For details on OTU identification please refer to the original publications")
),
# Put in the main panel of the layout the output functions
mainPanel(
plotOutput('plot')
# ,dataTableOutput("anova.tab")
)
)
)
server <- function(input, output){
# Return the requested dataset ----
datasetInput <- reactive({
switch(input$dataset)
})
#
dataset <- datasetInput()
# output otus to choose basaed on dataset selection
output$otu <- renderUI({
selectInput(inputId = "otu", label = "otu",
choices = colnames(dataset))
})
output$plot <- renderPlot({
#
dataset <- datasetInput()
otu <- input$otu
#dataset<-abundance_tables[[1]]
## melt and add sample metadata
df_annot<-merge(dataset,sample_metadata,by="row.names",all.x=T)
rownames(df_annot)<-df_annot[,1]
df_annot<-df_annot[,-1]
#
dfM<-melt(df_annot,id.vars = c("Location","Bean","Fungi","Insect"),value.name="abund")
# renaming Fungi level to metarhizium
levels(dfM$Fungi)<-c("Metarhizium","No Meta")
#
ggplot(subset(dfM, variable==otu),
aes(x=Insect,y=abund,fill=Fungi))+geom_boxplot()+facet_wrap(~Location,scales="free_y" )+
guides(fill=guide_legend("Metarhizium")) +
ggtitle(otu)
})
}
##
shinyApp(ui=ui,server=server)
Okay, I have made some fixes after some answers, but am now getting the following error.
Listening on http://127.0.0.1:5684
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Stack trace (innermost first):
41: .getReactiveEnvironment()$currentContext
40: .dependents$register
39: datasetInput
38: server [/Users/alisonwaller/Documents/Professional/Brock/Bidochka_Microbiome/shiny/Barelli_shiny.R#68]
1: runApp
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Yes you are really close. Just replace this line:
selectInput('otu', 'otu', uiOutput("otu")),
with this: uiOutput("otu"),
There's no need for SelectInput() here since that is in the renderUI in the server function.
I have created several likert scales with R package "likert" and would like to plot each one of them in shiny when the radio button of that one is selected.
The sample scales is:
a <- sample(rep((1:5),5))
b <- sample(rep((1:5),5))
c <- data.frame(sapply(data.frame(a), factor))
d <- data.frame(sapply(data.frame(b), factor))
scaledc <- likert(c)
scaledd <- likert(d)
The shiny codes are:
ui <- fluidPage(
titlePanel("Survey"),
sidebarLayout(
sidebarPanel(
selectInput("type",
"Plot Type",
choices = c("Likert"="bar",
"Density"="density",
"Heatmap"="heat"), selected="Likert"),
radioButtons("qtype",
"Question type:",
c("Agreement"="scaledc", "Helpfulness"="scaledd"),
selected="scaledc")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Yearly Data", plotOutput("distPlot1"))
)
)
)
)
#server
server <- function(input, output) {
output$distPlot1 <- renderPlot({plot(input$qtype, type=input$type)+
ggtitle("How agree are you with following statements?")}, height = 1000)
}
The shiny returned error "need finite 'ylim' values." I think it's becaue the input$qtype doesn't pass the correct information to the plot command, but I don't know how to fix it. Thank you for advance!
I've just solved the problem.
The missing codes in server are:
scale <- reactive({
get(input$qtype)
})
output$dat <- renderPrint({
scale()
})
And then do plot with scale() will show selected plot.
I'm trying to write a shiny app that takes a file as an input and uploads the data in that file to a bigquery table where some other stuff will go on. Everything appears to be working fine in terms of getting the data into my app, but when I try to upload the data to bigquery, nothing happens. No error messages, just nothing.
I can run the code on its own and it executes just fine. I'm having a little trouble figuring out how to create a reproducible example because you can't write to a public dataset, but I've included my code below.
Additional info:
working directory contains my .httr-oauth file
data is visible in my shiny app
Please let me know if there's something I can add to make this question easier to answer. Thanks.
############# UI ############
#
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Upload"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput('list', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'.csv'
)),
tags$hr(),
textInput('sql', 'Or give a query to get the customer_ids you want'),
tags$hr(),
actionButton('go', 'Go')
),
# Show a plot of the generated distribution
mainPanel(
tableOutput('log')
)
)
))
############# server ##############
### setting up the environment
library(shiny)
library(data.table)
library(bigrquery)
### setting up the constants
project <- 'xxxxxxx'
dest_dataset <- 'temp'
dest_table <- 'custs_hash'
cd <- 'CREATE_IF_NEEDED'
wd <- 'WRITE_TRUNCATE'
options(shiny.maxRequestSize = 100*1024^2)
shinyServer(function(input, output) {
logs <- eventReactive(input$go, {
inFile <- input$list
dat <- fread(inFile$datapath)
dat <- head(dat)
return(list(dat = dat))
})
upload <- eventReactive(input$go, {
data <- dat()$dat
ins <- insert_upload_job(project, dataset = dest_dataset, table = dest_table, values = data,
create_disposition = cd, write_disposition = wd)
return(list(ins = ins))
})
output$log <- renderTable(logs()$dat)
})
An eventReactive returns a reactive expression object. Like other reactive objects, you need to expressly call it like a function. Otherwise it won't run by itself.
So in your case, you have upload <- eventReactive(...), then you need to call it using upload().
I'm working on leaflet with shiny. The tools is basic, i have a map with some markers (coming from a table with LONG and LAT).
What I want to do is to open a table or a graph when i click on the marker.
Is there a simple way to do it?
Do you have a really simple example: you have a maker on a map, you click on the marker, and there is a plot or a table or jpeg that s opening?
Here is another example, taken from here and a little bit adapted. When you click on a marker, the table below will change accordingly.
Apart from that, a good resource is this manual here:
https://rstudio.github.io/leaflet/shiny.html
library(leaflet)
library(shiny)
myData <- data.frame(
lat = c(54.406486, 53.406486),
lng = c(-2.925284, -1.925284),
id = c(1,2)
)
ui <- fluidPage(
leafletOutput("map"),
p(),
tableOutput("myTable")
)
server <- shinyServer(function(input, output) {
data <- reactiveValues(clickedMarker=NULL)
# produce the basic leaflet map with single marker
output$map <- renderLeaflet(
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lat = myData$lat, lng = myData$lng, layerId = myData$id)
)
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(myData,id == data$clickedMarker$id)
)
})
})
})
shinyApp(ui, server)
There is a leaflet example file here:
https://github.com/rstudio/shiny-examples/blob/ca20e6b3a6be9d5e75cfb2fcba12dd02384d49e3/063-superzip-example/server.R
# When map is clicked, show a popup with city info
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
isolate({
showZipcodePopup(event$id, event$lat, event$lng)
})
})
Online demo (see what happens when you click on a bubble):
http://shiny.rstudio.com/gallery/superzip-example.html
On the client side, whenever a click on a marker takes place, JavaScript takes this event and communicates with the Shiny server-side which can handle it as input$map_shape_click.
I am new to Shiny and am trying to add a chord diagram to a shiny server. When I hit the runApp button in RStudio I get the application to run and it generates the UI, but then closes down immediately and I get the following error in the RConsole window: Error in (structure(function (input, output) :
could not find function "renderplot".
Unfortunately, I cannot attach the data as it is proprietary, but I am just creating an adjacency matrix in order to generate the chord plot. The Chord plot works fine outside Shiny. Thanks in advance!
My UI and Server code is below:
library(shiny)
# Starting line
shinyUI(fluidPage(
# Application title
titlePanel("Chord Chart"),
# Sidebar
sidebarLayout(
sidebarPanel(
#Data selection for Chord Chart
selectInput("data","Select a Dataset:",
c("Marine"))),
#The plot created in server.R is displayed
mainPanel(
plotOutput("plot")
)))
)
library(circlize)
library(dplyr)
library(reshape2)
library(manipulate)
library(shiny)
# read marine summaries
marine <- readfile("C:/Personal/R/MarineDataSummary.csv")
# group and summarize by O-D
marine.sum <- marine %>%group_by(Handling_Port, OD_Port_Country) %>%
summarise(tons <-sum(tonnes)) # prepare pivot table
marine.sum1 <- acast(marine.sum, Handling_Port~OD_Port_Country, value.tons="z") # reshape matrix
marine.sum1[is.na(marine.sum1)] <- 0 # set NA to zero
#initialization of server.R
shinyServer(function(input, output) {
output$plot <- renderplot({
c <- chordDiagram(marine.sum1,annotationTrack="grid",preAllocateTracks=list(track.height = 0.3))
##change axis
c <- c + circos.trackPlotRegion(track.index=1, panel.fun=function(x,y) {
xlim = get.cell.meta.data("xlim")
ylim = get.cell.meta.data("ylim")
sector.name=get.cell.meta.data("sector.index")
circos.text(mean(xlim), ylim[1], sector.name,facing="clockwise",
niceFacing=TRUE,adj=c(0,0.4), cex = 0.4)},bg.border=NA)
print(c)
})
})