What to add in server in order to save the plot as either png or svg?
Does ggsave work with ggtern? (which is an extension to ggplot for ternary plots)
Here is a minimal reproducible example of what I'm trying to do in Shiny:
library(shiny)
library(ggtern)
library(tidyverse)
ui <- fluidPage(
downloadButton("dwnld", label = "Save plot"),
plotOutput("ternary")
)
server <- function(input, output) {
# ternary plot via ggtern
output$ternary <- renderPlot({
data <- tibble(x = 0.2, y = 0.3, z = 0.5)
plot <- ggtern(data, aes(x = x, y = y, z = z)) + geom_point(size = 8)
print(plot)
})
# download the plot
#????????
}
shinyApp(ui = ui, server = server)
You can proceed as follows:
myPlot <- reactive({
data <- tibble(x = 0.2, y = 0.3, z = 0.5)
ggtern(data, aes(x = x, y = y, z = z)) + geom_point(size = 8)
})
output[["ternary"]] <- renderPlot({
myPlot()
})
output[["dwnld"]] <- downloadHandler(
filename = "myPlot.png",
content = function(file){
ggsave(file, myPlot())
}
)
Related
When I run this code with renderPlotly. It gives me error but without renderplotly it is working fine. Can you help me in fixing this code with renderPlotly? Thanks in advance.
output$tot_finalized_claims1 <- renderPlotly({
req(input$yearSelectInput)
#filter df to be used in graph
claims1 <- newly_formatted_logResults %>% filter(YEAR == input$yearSelectInput) %>% filter(PEND == "CMI") %>% select(YEAR,MONTH_NUM,PEND, TOTAL_FINALIZE,TOTAL)
data_pcode <- summarize(group_by(claims1,MONTH_NUM), actual_auto = round(sum(as.numeric(TOTAL_FINALIZE),na.rm = TRUE)/sum(as.numeric(TOTAL),na.rm = TRUE),digits = 2))
data_pcode <- data.frame(data_pcode)
ggplot(data = data_pcode,aes(x = MONTH_NUM, y = actual_auto )) +
geom_point() + geom_line() + # add the points and lines
stat_QC(method = "XmR" # specify QC charting method
auto.label = T, # Use Autolabels
label.digits = 2, # Use two digit in the label
show.1n2.sigma = T # Show 1 and two sigma lines
)+
labs(x = "Months",y = "Automation Rate",title = paste("Actual automations by CMI Pend code"))+
geom_text(aes(label=paste(actual_auto ,"%")), position=position_dodge(width=0.95), vjust=-0.5)+
scale_x_continuous(breaks = 1:12,labels = c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"))+
scale_y_continuous(breaks = seq(0.0, 1.0, 0.1))
}) #end tot finalized plot summary
Apart from the fact that you didn't even use the plotly function to create the plot, if you want to generate plotly output you must remember two things:
In server section renderPlotly instead of renderPlot
In UI section plotlyOutput instead of plotOutput
You can try this code to see how it works:
library(shiny)
library(ggplot2)
library(ggthemes)
library(plotly)
ui <- fluidPage(
titlePanel("Plotly"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotlyOutput("plot2"))
))
server <- function(input, output) {
output$plot2 <- renderPlotly({
ggplotly(
ggplot(data = mtcars, aes(x = disp, y = cyl)) +
geom_smooth(method = lm, formula = y~x) +
geom_point() +
theme_gdocs())
})
}
shinyApp(ui, server)
Hello is there a way to display the data labels only for specific data of my dataset? I used key instead of label in order to create the tooltip but I cannot make it work. As a final result I want to be able to display labels of my choice as now and also have some data labels always displayed.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
output$iris <- renderPlotly({
# set up plot
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
key = "Species")) +
geom_point()+
geom_text(data=subset(iris, Sepal.Lenth > 6),
aes(Sepal.Length,Sepal.Width,label=Species))
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# if a point has been clicked, add a label to the plot
if(!is.null(click_data)) {
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
p1 <- p1 +
geom_text(data = label_data,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
}
# return the plot
ggplotly(p1, source = "select", tooltip = c("key"))
})
}
shinyApp(ui, server)
A possible solution is:
library(shiny)
library(plotly)
library(ggplot2)
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
text = "Species")) +
geom_point() +
geom_text(data=subset(iris, Sepal.Length > 6),
aes(Sepal.Length,Sepal.Width,label=Species))
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
output$iris <- renderPlotly({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# if a point has been clicked, add a label to the plot
if(!is.null(click_data)) {
pos <- click_data$pointNumber+1
label_data <- data.frame(x = iris$Sepal.Length[pos],
y = iris$Sepal.Width[pos],
label = iris$Species[pos],
stringsAsFactors = FALSE)
p1 <<- p1 +
geom_text(data = label_data,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_y=.1)
}
# return the plot
ggplotly(p1, source = "select", tooltip = c("text"))
})
}
shinyApp(ui, server)
I am having some difficulties with plotly. I would like to be able to download plotly as pdf. However while adding to my code some x and y axis parameters (cause if i transfer ggplot to plotly, titles of x and y axis are cut)
This code is working to download pdf file:
library(shiny)
library(DT)
library(ggplot2)
library(plotly)
shinyApp(
ui = fluidPage(
fluidRow(downloadButton('downloadplot',label='Download Plot')),
plotlyOutput('plot1')
),
server = function(input, output) {
testplot <- function(){
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
}
output$plot1 <- renderPlotly({testplot()})
output$downloadplot <- downloadHandler(
filename ="plot.pdf",
content = function(file) {
pdf(file, width=12, height=6.3)
print(testplot())
dev.off()
})})
and addition of this code to fix the titles of the ggplotly fails:
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
p <- ggplotly(a + ylab(" ") + xlab(" "))
x <- list(
title = "[x]"
)
y <- list(
title = "[y]"
)
p %>% layout(xaxis = x, yaxis = y)}
gives an empty plot...
Thanks for any help!
I have solved my question. The solution is not elegant but it works!
So the trick is to set the x and y titles in renderPlotly and NOT in testplot() function.
However the x and y axis titles have to be additionally typed in testplot() function - cause this is going to be our output as pdf, and view of the plot is done with plotly.
Here is code:
library(shiny)
library(DT)
library(ggplot2)
library(plotly)
shinyApp(
ui = fluidPage(
fluidRow(downloadButton('downloadplot',label='Download Plot')),
plotlyOutput('plot1')
),
server = function(input, output) {
testplot <- function(){
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
}
output$plot1 <- renderPlotly({
p <- ggplotly(testplot() + ylab(" ") + xlab(" "))
x <- list(
title = "[x]"
)
y <- list(
title = "[y]"
)
p %>% layout(xaxis = x, yaxis = y)})
output$downloadplot <- downloadHandler(
filename ="plot.pdf",
content = function(file) {
pdf(file, width=12, height=6.3)
print(testplot())
dev.off()
})})
I have a situation in which I would like to have multiple ggplot graphics in a Shiny app. Typically this is addressed via the facet techniques. However, in my case some of my x values are categorical and others are continuous. To try to address this issue, I have use the gridExtra package to combine the multiple plots into a single plot using the arrangeGrob and grid.arrange function. When I use the click action on the plot, the returned coordinates do not correspond to the points in the plot. The following is a self-contained example:
library(shiny)
library(miniUI)
library(ggplot2)
library(gridExtra)
test_addin <- function() {
ui <- miniPage(
miniTitleBar(title = 'Example', right = miniTitleBarButton("done", "Done", primary = TRUE)),
miniContentPanel(plotOutput('plot', height = '100%', click = 'plot_click'))
)
server <- function(input, output, session) {
observeEvent(input$plot_click, {
tmp = isolate(input$plot_click)
cat(sprintf('Location was: %0.2f, %0.2f\n', tmp$x, tmp$y))
})
plot_reactive = reactive({
contdata = data.frame(x = 1:10, y = runif(10), term = as.factor('one'))
discdata = data.frame(x = as.factor(rep(c('A', 'B'), each = 5)), y = runif(10), term = as.factor('two'))
contplot = ggplot(contdata) + theme_bw() +
geom_line(aes(x = x, y = y)) +
labs(x = '', y = '')
discplot = ggplot(discdata) + theme_bw() +
geom_point(aes(x = x, y = y)) +
labs(x = '', y = '')
p1 = ggplot_gtable(ggplot_build(contplot))
p2 = ggplot_gtable(ggplot_build(discplot))
grid.arrange(arrangeGrob(p1, p2, layout_matrix = matrix(c(1, 2), ncol = 2, byrow = TRUE)))
})
observe({
output$plot <- renderPlot({
plot_reactive()
})
})
observeEvent(input$done, {
stopApp()
})
}
viewer <- paneViewer(300)
runGadget(ui, server, viewer = viewer)
}
test_addin()
Can somebody point me in the right direction to make this function as intended? I have spent far too long on this (read as browsing ggplot and shiny source code) to not ask the question. Thanks for any help.
I am trying to create an interactive visualisation of data in shiny. The visualisation shows the distribution (or histogramm) of parts of a series. For example, the following code creates a series and two selections (two is fixed) of parts of the series, which is then displayed using ggplot:
library(ggplot2)
set.seed(123)
dat <- data.frame(x = 1:1000,
y = cumsum(rnorm(1000, mean = 0.1)))
sel1 <- 200:400 # selection 1
sel2 <- 700:900 # Selection 2
# create a plot of the series
ggplot() + geom_line(data = dat, aes(x = x, y = y)) +
geom_rect(aes(xmin = sel1[1], xmax = sel1[length(sel1)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = sel2[1], xmax = sel2[length(sel2)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "blue")
# Histogramm preparation
# create another df that contains the selection of the two selections
pdat <- rbind(data.frame(y = dat[dat$x %in% sel1, 2],
sel = 1),
data.frame(y = dat[dat$x %in% sel2, 2],
sel = 2))
# plot the histograms
ggplot(pdat, aes(x = y, fill = as.factor(sel))) +
geom_histogram(alpha = 0.5, position = "dodge")
which creates:
Now I want the user to be able to move the areas (preferably by dragging the shaded areas in plot 1 around!) using shiny.
I played around with the (new) interactive options of shiny (more info here, look for section "Interactive plots"). I think I can remember that there is an option to specify an area, which the user is able to drag around, but I can't find it anymore.
Any ideas?
As mentioned in the comments do look into rCharts and dygraphs, below is the example taken from tutorials with some modifications. Please note that the dygraphs require a timeseries object to plot, refer to official docs for more information. The summary statistics can be performed by a package of your choice. Also note that the shaded regions are user specified...
rm(list = ls())
library(shiny)
library(dygraphs)
library(xts)
library(rCharts)
index <- as.Date(c(seq(Sys.time(), length.out = 1000, by = "days")))
dat <- data.frame(x = index,y = cumsum(rnorm(1000, mean = 0.1)))
dat <- xts(dat[,-1], order.by=dat[,1])
ui <- fluidPage(
titlePanel("Shaded Regions using dygraphs and rCharts by Pork Chop"),
sidebarLayout(
sidebarPanel(
sliderInput("range_one", "Range One:",min = 100, max = 1000, value = c(200,300)),
sliderInput("range_two", "Range Two:",min = 100, max = 1000, value = c(500,600)),width=3),
mainPanel(
column(12,dygraphOutput("dygraph")),
column(12,showOutput("summary", "Highcharts"))
)
)
)
server <- function(input, output) {
output$dygraph <- renderDygraph({
dygraph(dat, main = "Sample Data") %>%
dyShading(from = index[input$range_one[1]], to = index[input$range_one[2]], color = "#FFE6E6") %>%
dyShading(from = index[input$range_two[1]], to = index[input$range_two[2]], color = "#CCEBD6")
})
output$summary <- renderChart2({
Selection1 <- dat[input$range_one[1]:input$range_one[2]]
Selection2 <- dat[input$range_two[1]:input$range_two[2]]
subset_data <- data.frame(merge(Selection1,Selection2))
a <- rCharts:::Highcharts$new()
a$chart(type = "column")
a$title(text = "Summary Stats")
a$yAxis(title = list(text = "Count"))
a$data(subset_data)
a$exporting(enabled=T)
a$set(width = 1200,height = "100%",slider = TRUE)
return(a)
})
}
shinyApp(ui, server)
I think I found a solution that is able to use interactive ggplot's in a shiny environment. The code looks like this:
library(shiny)
library(ggplot2)
ifna <- function(x, elseval = NA) ifelse(is.na(x) || is.null(x), elseval, x)
# two plots: as described in the question
ui <- fluidPage(
uiOutput("plotui"),
plotOutput("plot2")
)
server = function(input, output) {
set.seed(123)
dat <- data.frame(x = 1:1000,
val = cumsum(rnorm(1000, mean = 0.1)))
base <- 200:400 # Base Selection
# reactive expressions to get the values from the brushed area
selmin <- reactive(round(ifna(input$plot_brush$xmin, elseval = 700), 0))
selmax <- reactive(round(ifna(input$plot_brush$xmax, elseval = 900), 0))
# include the brush option: direction = "x" says that y values are fixed (min and max)
output$plotui <- renderUI({
plotOutput("plot", height = 300,
brush = brushOpts(id = "plot_brush", direction = "x",
fill = "blue", opacity = 0.5)
)
})
# render the first plot including brush
output$plot <- renderPlot({
ggplot() + geom_line(data = dat, aes(x = x, y = val)) +
geom_rect(aes(xmin = base[1], xmax = base[length(base)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = 700, xmax = 900,
ymin = -Inf, ymax = Inf), alpha = 0.1, fill = "blue") +
ylab("Value") + xlab("t")
})
# render the second plot reactive to the brushed area
output$plot2 <- renderPlot({
# prepare the data
pdat <- rbind(data.frame(y = dat[dat$x %in% base, "val"],
type = "Base"),
data.frame(y = dat[dat$x %in% selmin():selmax(), "val"],
type = "Selection"))
ggplot(pdat, aes(x = y, fill = type)) +
geom_histogram(alpha = 0.5, position = "dodge") +
scale_fill_manual(name = "", values = c("red", "blue")) +
theme(legend.position = "bottom") + ylab("Frequency") + xlab("Value")
})
}
# run the app
shinyApp(ui, server)
Which gives something like this (the dark-blue box is interactive, as in you can push it around and the lower graph updates!
Picture of Shiny App