It seems that trelliscope is not able to use within shiny even though renderTrelliscope function is included. Could any of you help me to confirm this ?
Although these link seems to help:
https://www.rdocumentation.org/packages/trelliscopejs/versions/0.1.18/topics/Trelliscope-shiny
An issue but couldnt help me
https://github.com/hafen/trelliscopejs/issues/37
library(shiny)
install.packages("gapminder")
library(gapminder)
devtools::install_github("hafen/trelliscopejs")
library(trelliscopejs)
ui <- fluidPage(
# App title ----
titlePanel("Hello trelliscope in Shiny!"),
# Sidebar layout with input and output definitions ----
fluidPage(
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
trelliscopeOutput("plot", width = "100%", height = "400px")
)
)
)
server <- function(input, output) {
output$plot <- renderTrelliscope(
qplot(year, lifeExp, data = gapminder) +
xlim(1948, 2011) + ylim(10, 95) + theme_bw() +
facet_trelliscope(~ country + continent,
nrow = 2, ncol = 7, width = 300, as_plotly = TRUE)
)
}
shinyApp(ui, server)
How can we render facet_trelliscope within shiny ?
Related
My shiny app generates a number of useful graphs. I would like to allow the user to download the graphs in various formats.
I have done this before for a single graph using How to save plots that are made in a shiny app as a guide. However, I am ending up creating more repeated code for each additional plot. I am not a programmer, but it really seems like I should be able to write one function to do this since I am just passing parameters to downloadHandler and ggsave, but I can't figure it out.
The MRE below represents a page with, say, ten different graphs. Is there a way to write a single function that receives the plot ID from a button (like a tag or something?) and the format from the selectInput to pass those parameters to downloadHandler and ggsave to save each of those graphs in the selected format? The function at the bottom shows my thinking, but I don't know where to go from here or if that is even the right direction.
Thanks!
library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show plots and download buttons
mainPanel(
plotOutput("distPlot"),
fluidRow(
column(3,
downloadButton("dl_plot1")
),
column(3,
selectInput("plot1_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
)
),
plotOutput("scat_plot"),
column(3,
downloadButton("dl_plot2")
),
column(3,
selectInput("plot2_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
)
)
)
)
# Define server logic required to draw a histogram and scatterplot
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
binwidth<-(max(x)-min(x))/input$bins
p<-ggplot(faithful,aes(waiting))+
geom_histogram(binwidth = binwidth)
p
})
output$scat_plot<-renderPlot({
p<-ggplot(faithful,aes(x=waiting,y=eruptions))+
geom_point()
p
})
downloadPlot <- function(plot_name,file_name,file_format){#concept code
downloadHandler(
filename=function() { paste0(file_name,".",file_format)},
content=function(file){
ggsave(file,plot=plot_name,device=file_format)
}
)
}
}
# Run the application
shinyApp(ui = ui, server = server)
To achieve your desired result without duplicating code you could (or have to) use a Shiny module. Basically a module is a pair of an UI function and a server function. For more on modules I would suggest to have a look at e.g. Mastering shiny, ch. 19.
In the code below I use a module to take care of the download part. The job of downloadButtonUI and downloadSelectUI is to add a download button and a selectInput for the file format. The downloadServer does the hard work and saves the plot in the desired format.
Note: Besides the download module I moved the code for the plots to reactives so that the plots could be passed to the downloadHandler or the download module.
EDIT: Added a fix. We have to pass the reactive (e.g. dist_plot without parentheses) to the download server and use plot() inside the downloadServer instead to export the updated plots.
library(shiny)
library(ggplot2)
# Download Module
downloaButtondUI <- function(id) {
downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
selectInput(NS(id, "format"), label = "Format", choices = c("SVG", "PDF", "JPEG", "PNG"), width = "75px")
}
downloadServer <- function(id, plot) {
moduleServer(id, function(input, output, session) {
output$dl_plot <- downloadHandler(
filename = function() {
file_format <- tolower(input$format)
paste0(id, ".", file_format)
},
content = function(file) {
ggsave(file, plot = plot())
}
)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30
)
),
# Show plots and download buttons
mainPanel(
plotOutput("distPlot"),
fluidRow(
column(3, downloaButtondUI("distPlot")),
column(3, downloadSelectUI("distPlot"))
),
plotOutput("scat_plot"),
fluidRow(
column(3, downloaButtondUI("scatPlot")),
column(3, downloadSelectUI("scatPlot"))
),
)
)
)
server <- function(input, output) {
dist_plot <- reactive({
p <- ggplot(faithful, aes(waiting)) +
geom_histogram(bins = input$bins)
p
})
scat_plot <- reactive({
p <- ggplot(faithful, aes(x = waiting, y = eruptions)) +
geom_point()
p
})
output$distPlot <- renderPlot({
dist_plot()
})
output$scat_plot <- renderPlot({
scat_plot()
})
downloadServer("distPlot", dist_plot)
downloadServer("scatPlot", scat_plot)
}
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4092
I have created a shiny app should take input from three sliders and:
Plots a distribution in ggplot
Show a summary table of values underneath the plot in #1 above
If I just want to plot the histogram (and I comment out the table data), I can get the code to work correctly. However, when I add the table, the plot disappears even though the plot header is still there. I have tried moving the commas a braces around to see if it's a simple syntax error but haven't had any luck.
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Test Shiny Layout"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
# Show a plot of the generated distribution
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
))
Server
library(shiny)
library(ggplot2)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
bins <- input$bins
df1 <- (iris$Sepal.Length)
x <- mean(df1)
y <- sd(df1)
ggplot(data = iris) +
geom_histogram(mapping = aes(x = Sepal.Length), color = "blue", binwidth = "bins")
# Create an empty dataframe and then plug in the mean and standard deviation
results <- data.frame("0", "0")
results[1,1] = x
results[1,2] = y
colnames(results) <- c("Mean", "SD")
rownames(results) <- c("Sepal Length")
output$table <- renderTable(results)
})
})
Your renderTable() is inside your renderPlot() call. So renderPlot isn't returning anything.
You were right: it was a simple syntax error. But you also had several other issues in your code. At least a dozen. Three in binwidth = "bins" alone.
Here's a working version. I suspect you will still want to make tweaks, but at least you have both a histogram and a summary table that both look reasonably sensible.
library(shiny)
library(ggplot2)
data(iris)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
ggplot(data = iris) +
geom_histogram(aes(x = Sepal.Length), color = "blue", bins = input$bins)
})
output$table <- renderTable({
iris %>%
summarise(Mean=mean(Sepal.Length),
SD=sd(Sepal.Length))
})
}
ui <- fluidPage(
titlePanel("Test Shiny Layout"),
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
)
shinyApp(ui = ui, server = server)
I have a shiny application with the following ui:
library(rhandsontable)
library(shiny)
library(ggplot2)
ui = fluidPage(
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Summary", rHandsontableOutput('contents'),
actionButton("saveBtn", "Save changes")
),
tabPanel("Tab",
rHandsontableOutput('contentFinal')),
tabPanel("Dashboard",
plotOutput('dashboard1'))
)
)
)
)
And the following server
library(dplyr)
library(rhandsontable)
options(shiny.maxRequestSize = 9*1024^2)
server = function(input, output) {
values <- reactiveValues()
Post <- c("", "")
list2 <- c(12,13)
df <- data.frame(Post, list2)
output$contents <- renderRHandsontable({
rhandsontable(df, width = 550, height = 300) %>%
hot_col(col = "Post", type = "dropdown")
})
saveData <- eventReactive({input$saveBtn},{
finalDF <- hot_to_r(input$contents)
finalDF$Post <- ifelse(finalDF$Post =="",NA,finalDF$Post)
newDF <- finalDF[complete.cases(finalDF),]
return(newDF)
})
output$contentFinal <- renderRHandsontable(
rhandsontable(saveData())
)
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
)
observeEvent(input$saveBtn, saveData())
}
shinyApp(ui = ui, server = server)
The flow is like this:
In the first tab, I bring up data with an empty post column
In this tab, I can add a name for the post and save it.
As soon as I save he rows with values for post become visible in the next tab.
Then the next thing I want to do is to have a visual in the dashboard tab that shows the data. Therefore I create:
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = List2 )) +
geom_bar(stat = "identity")
)
This however gives me the following ggplot2 errror:
ggplot2 doesn't know how to deal with data of class list
Any thoughts on what goes wrong here?
The problem is because input$contentFinal is handsontable data. We need to convert it to R object using hot_to_r function.
The ggplot should be plotted using the following:
ggplot(hot_to_r(input$contentFinal), aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
Hope it helps!
I've recently started learning Shiny and am developing my first practice app. For some reason, my app doesn't take up the entire browser window but is cutoff about half way. The page can still scroll down to see the rest of the output but there is a high fold for some reason. Below is my code:
library(foreign)
library(dplyr)
library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
thesis <- read.csv("thesis.csv", stringsAsFactors = T)
ui <- fluidPage(theme = shinytheme("cerulean"),
# Application title
titlePanel("Annual Prices by City"),
# Sidebar with choice selected
sidebarLayout(
sidebarPanel(
selectInput("city","City",as.character(thesis$city)),
tableOutput("table")
),
# Show a time series line plot
mainPanel(
textOutput("cityheader"),
plotOutput("plot", width="100%")
)
)
)
server <- function(input, output, session) {
df <- reactive({
thesis %>%
select(city, year, price) %>%
filter(city == input$city)
})
output$plot <- renderPlot({
ggplot(df(), aes(x=year, y=price)) +
labs(title=input$city, x="Year", y="Annual Avg Price") +
geom_line(col="blue")
}, height=400, width = 700)
output$table <- renderTable({
df()
})
output$cityheader <- renderText({
input$city
})
}
shinyApp(ui=ui,server=server)
Here is a screenshot of the white space:
Screenshot of the Shiny App
UPDATE:
Here is what it looks like from within the viewer's pane in Rstudio:
Rstudio Screenshot
Thanks.
I had the same issue, try
shinyApp(ui = ui, server = server, options = list(height = 1080))
I am new to shiny and have a problem about the slider input, it works well for the dataset but not working for my histogram, could you please help me to look at it, thanks.
Overview
I am trying to build a shiny application to display the attitude{datasets}, the first tab just displays the data, the slider works pretty well, but in the second tab the slider input not works for my histogram. I don't know why, I tried rChart before it also works. Please ignore the about.md file, it's just description.
Code
ui.r
library(shiny)
require(markdown)
library(ggplot2)
# Define UI for application that draws a histogram
shinyUI(
navbarPage("Employee attitude survey",
# multi-page user-interface that includes a navigation bar.
tabPanel("Explore the Data",
sidebarPanel(
sliderInput("rating",
"Employee rating filter:",
min = 1,
max = 100,
value = c(10,50))
),
# Show a plot of the generated distribution
# mytable1: dataset
# distPlot: histogram
mainPanel(
tabsetPanel(
tabPanel(p(icon("table"), "Dataset"),
dataTableOutput("mytable1")),
tabPanel(p(icon("search"), "Visualize the Data"),
plotOutput("distPlot"))
)
)
),
tabPanel("About",
mainPanel(
includeMarkdown("about.md")
)
) # end of "About" tab panel
)
)
server.R
library(shiny)
library(ggplot2)
# Define server logic required to draw a histogram and a table
shinyServer(function(input, output) {
# table to display the attitude, slider works
output$mytable1 = renderDataTable({
attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
})
# histogram of rating, but slider not works
output$distPlot <- renderPlot({
df <- attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
p1 <- ggplot() + aes(df[,"rating"])
p1 <- p1 + geom_histogram(binwidth=2, col="skyblue", aes(fill=..count..), alpha=0.6)
p1
})
})
My Question
Why the slider not working for my ggplot histogram. But works for the dataset ?Thanks a lot.
Try this
# histogram of rating, but slider not works
output$distPlot <- renderPlot({
df <- attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
test <<- (df[,"rating"])
p1 <- ggplot() + aes(test)
p1 <- p1 + geom_histogram(binwidth=2, col="skyblue", aes(fill=..count..), alpha=0.6)
p1
})