I'm having some trouble creating interactive plots in shiny that facet my data.
Here's some code that shows what I want, but it uses ggplot2 which is not interactive.
library(shiny)
library(data.table)
library(ggplot2)
x <- 1:10000
dt <- data.frame(a = 1:100, b = sample(x,100,replace=T), c = sample(x,100,replace=T), d = sample(x,100,replace=T))
dt.molten <- melt(dt,id.vars="a")
ui <- fluidPage(
plotOutput("gplot")
)
server = function(input, output) {
output$gplot <- renderPlot({
ggplot(y.molten,aes(x = value)) +
geom_histogram(binwidth = 100000) +
facet_wrap( ~ variable,ncol = 1)
})
}
shinyApp(ui = ui, server = server)
In my actual app, the amount of facets varies, so I can't simply hard code in 3 separate plots using highcharter, ggvis,or plotly.
Ideally I'd like it to look something like this:
require(highcharter)
x <- stl(log(AirPassengers), "per")
hchart(x)
Except with histograms instead of time-series data.
The main issue is that the data i'm plotting stretches over like -3,000,000 to +3,000,000 with a high concentration around 0. This makes it hard to see the bars at the edges, so I'd like for users to be able to zoom into certain ranges of the plot without having to select it via some ui element.
I'm open to suggestions using any plotting method in R, although i'd like to stay away from rCharts.
EDIT: I did discover that using plotly::ggplotly almost achieved what I'm looking for, however it isn't very clean. I did g <- ggplot(*plot code*) then ggplotly(g). Works decent, but it'll take quite a bit of work to clean up I think.
Related
So for example suppose I have these three plots
p1 <- iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_point()
p2 <- iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="#98ff98")
p3 <- iris%>%ggplot(aes(x=Species,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="blue")
So instead printing each plot out separately in the html markdown so that the user has to scroll down to view each of the figures, is there a way to output some sort of ui where the left hand side is the plot and right hand side are the selection for the plots. Then the user can simply select which plot to view and it will appear on the left. Is this possible? The reason why I ask is because often I can have 10-20 figures per comparison that can get unwieldy very fast and I think this would be an excellent way to organize them.
thanks!
Maybe something like this can get you started
library(shiny)
# create a list of plots
plots <- list(
p1 = iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_point(),
p2 = iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="#98ff98"),
p3 = iris%>%ggplot(aes(x=Species,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="blue")
)
# put names of plots in a list in sidebar
ui <- fluidPage(sidebarLayout(
sidebarPanel(tags$ul(purrr::map(names(plots), ~tags$li(actionLink(paste0("show", .), .))))),
mainPanel(plotOutput("currentplot"))
))
server <- function(input, output, session) {
# draw the first plot by default
current_plot <- reactiveVal(plots[[1]]);
# set up observers for each of the action links in the UI
purrr::map(names(plots), function(p) {
observeEvent(input[[paste0("show",p)]], {
# set current plot
current_plot(plots[[p]])
})
})
# render whatever the current plot is
output$currentplot <- renderPlot(current_plot())
}
shinyApp(ui, server)
This will give you a list of plots on the left and will draw which ever you click on on the right.
you could probably make this more efficient if you wanted to write some javascript, but this at least gives a basic idea of how it might work.
I'm plotting a bubble map in R Shiny which displays the sales volume of different city locations (called 'Stadt' in the data) in Germany. Therefore, I basically use a German default map (.rds) and complement it with plot layers of the bubbles.
Instead of ggplot I would like to use plotly, since it has more default features which are very useful for arranging the displayed information on the map.
However, when I apply the plotly function, the plot shows a very widely deformed country shape. The bubbles and the map legend displayed on the side work fine.
Here is the ggplot with the correct shape: https://ibb.co/dL4HTRG
Here is the deformed output of plotly: https://ibb.co/bWR2XP2
I'm aware that it is possible to fix height and size by the corresponding commands inside the ggplot brackets, but this does not lead to the required result in this case.
The map should adapt to the window size with maintaining its correct width-to-height ratio.
Is there another possibility to solve this except of fixing manually size and width by trial and error?
The basic code looks like the following:
library(shiny)
library(tidyverse)
library(ggplot2)
library(plotly)
##pool package necessary for dbpool function in order to access database via function in 'database_init.R'
library(pool)
### load and preprocess the German geo map polygons. Download here http://biogeo.ucdavis.edu/data/gadm2.8/rds/DEU_adm1.rds
map_data_sp2 <- readRDS("gadm36_DEU_2_sp.rds")
map_data_1 <- fortify(map_data_sp2, region = "NAME_1")
# link to database and declaration as 'pool'
pool <- dbPool(
drv = RMySQL::MySQL(),
dbname = "rlyshiny_",
host = "85.214.74.4",
username = "xxxxxxxx",
password = "xxxxxxxxxxxxxxxx")
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarPanel()
),
dashboardBody(
plotlyOutput("heatmap")
)
)
server <- function(input, output, session) {
output$heatmap <- renderPlotly({
locations <- dbReadTable(pool,"Locations")
##tbl extrahiert salesdata aus pool
sales_data <- pool%>%
tbl("Salesdata")%>%
as.data.frame()%>%
merge(locations, by="Stadt")%>%
select(Material,Nettogewicht,Stadt,Longitude,Latitude)%>%
group_by(Material,Stadt,Longitude,Latitude)%>%
summarise(Nettogewicht=sum(Nettogewicht))
ggplot() + geom_polygon(data=map_data_1,aes(x=long,y=lat,group=group),fill="grey",color="white")+
geom_point(data=sales_data,aes(x=Longitude,y=Latitude, size=Nettogewicht,colour=Stadt),alpha=0.7)+
scale_size(range = c(2,20))+
theme_void() +
coord_map()
}
)
}
shinyApp(ui, server)
I am struggling with my first shiny app and having problems to make it work due to, I think, I am missing out something in the server function.
I have a R script that has two variables (the two reactive values in shiny) that creates a plot (a histogram) and a csv file with two columns (time and mm).
library(ggplot2)
**Pdmm** <- 125 # numeric input in shiny
**IndiceTorrencial** <- 10 # slider between 8 and 12 in shiny
DuracionAgua <- 24
IntervaloMin <- 60
IntervaloTiempo <- IntervaloMin/60
Intervalos <- DuracionAgua/IntervaloTiempo
t <- seq(1,Intervalos,IntervaloTiempo)
DF <- data.frame(t)
DF$I <- (**Pdmm**/24)*(**IndiceTorrencial**)^(((28^0.1)-(DF$t^0.1))/((28^0.1)-1)) # equation where the reactive values are running
DF$Pacu <- DF$t*DF$I
DF$Pmm <- c(DF$Pacu[1], diff(DF$Pacu, lag = 1))
DF$mm <- c(DF$Pmm[23],DF$Pmm[21],DF$Pmm[19],DF$Pmm[17], DF$Pmm[15],DF$Pmm[13],DF$Pmm[11],DF$Pmm[9],DF$Pmm[7],DF$Pmm[5],DF$Pmm[3],DF$Pmm[1],DF$Pmm[2],DF$Pmm[4],DF$Pmm[6],DF$Pmm[8],DF$Pmm[10],DF$Pmm[12],DF$Pmm[14],DF$Pmm[16],DF$Pmm[18],DF$Pmm[20],DF$Pmm[22],DF$Pmm[24])
ggplot(DF,aes(x=t,y=mm)) + geom_bar(stat = "identity",fill = "dodgerblue",color = "black") + scale_x_continuous(name = "t(h)", breaks = seq(1,24,1)) + scale_y_continuous(name = "mm")
My shiny app has, in its UI, a slider, a numeric input and a plot. It works, I will have time to make something better.
ui <- basicPage(
sliderInput(inputId = "coefTo",
label = h3("Torrentiality Coefficient"),
value = 10, min = 8, max = 12),
numericInput(inputId = "PmmS",
label = h3("Areal Precipitation"),
value = 100),
imageOutput("plot")
)
The problem is in the server function. I think I am sure that I have to use a reactive function in order to execute the code and to yield the results (histogram and csv). Also, to plot the histogram, I have a renderPlot.
server <- function(input, output, session){
data <- reactive({
DuracionAgua <- 24
IntervaloMin <- 60
IntervaloTiempo <- IntervaloMin/60
Intervalos <- DuracionAgua/IntervaloTiempo
t <- seq(1,Intervalos,IntervaloTiempo)
DF <- data.frame(t)
DF$I <- (input$PmmS/24)*(input$coefTo)^(((28^0.1)-(DF$t^0.1))/((28^0.1)-1))
DF$Pacu <- DF$t*DF$I
DF$Pmm <- c(DF$Pacu[1], diff(DF$Pacu, lag = 1))
DF$mm <- c(DF$Pmm[23],DF$Pmm[21],DF$Pmm[19],DF$Pmm[17], DF$Pmm[15],DF$Pmm[13],DF$Pmm[11],DF$Pmm[9],DF$Pmm[7],DF$Pmm[5],DF$Pmm[3],DF$Pmm[1],DF$Pmm[2],DF$Pmm[4],DF$Pmm[6],DF$Pmm[8],DF$Pmm[10],DF$Pmm[12],DF$Pmm[14],DF$Pmm[16],DF$Pmm[18],DF$Pmm[20],DF$Pmm[22],DF$Pmm[24])
DFm <- DF$mm
return(DFm)
})
output$plot <- renderPlot({
ggplot(data(DFm),aes(x=t,y=mm)) + geom_bar(stat = "identity",fill = "dodgerblue",color = "black") + scale_x_continuous(name = "t(h)", breaks = seq(1,24,1)) + scale_y_continuous(name = "mm")
})
}
When I run this script, I get the shiny app I have the slider and the numeric input, but not the plot getting an error message saying Error: unused argument (DFm). DFm is not created, so I assume that I am placing bad the code from my original script inside the shiny app, but I cannot figure out how to do it.
I have tried several things to make the server works, but I think that the script never runs inside the shiny app. I tried to create two reactive functions, one per each reactive value. I tried to put all the code from my original script out of the shiny leaving just the reactive values inside the shiny code... I tried with observe function as well.
Another problem I have is that I am not sure about the renderPlot. I am aware that I have to call the reactive function, data, but as I am not sure if it is well made.
I think that my server function is a total disaster. I have looked for examples in the shiny gallery and in Google, but I do not see something similar to help me.
Could anyone give a tip in order to fix my server function?
Many thanks in advance.
Following the advice of our colleague, I could solve my problem by setting DF, the first data frame I created, in return() inside the reactive function. Another confusion was how to set the object from the reactive function inside the renderplot.
In short: I'm looking for a way to get the exact coordinates of a series of mouse positions (on-clicks) in an interactive x/y scatter plot rendered by ggplot2 and ggplotly.
I'm aware that plotly (and several other interactive plotting packages for R) can be combined with Shiny, where a box- or lazzo select can return a list of all data points within the selected subspace. This list will be HUGE in most of the datasets I'm analysing, however, and I need to be able to do the analysis reproducibly in an R markdown format (writing a few, mostly less than 5-6, point coordinates is much more readable). Furthermore, I have to know the exact positions of the clicks to be able to extract points within the same polygon of points in a different dataset, so a list of points within the selection in one dataset is not useful.
The grid.locator() function from the grid package does almost what I'm looking for (the one wrapped in fx gglocator), however I hope there is a way to do the same within an interactive plot rendered by plotly (or maybe something else that I don't know of?) as the data sets are often HUGE (see the plot below) and thus being able to zoom in and out interactively is very much appreciated during several iterations of analysis.
Normally I have to rescale the axes several times to simulate zooming in and out which is exhausting when doing it MANY times. As you can see in the plot above, there is a LOT of information in the plots to explore (the plot is about 300MB in memory).
Below is a small reprex of how I'm currently doing it using grid.locator on a static plot:
library(ggplot2)
library(grid)
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_point()
locator <- function(p) {
# Build ggplot object
ggobj <- ggplot_build(p)
# Extract coordinates
xr <- ggobj$layout$panel_ranges[[1]]$x.range
yr <- ggobj$layout$panel_ranges[[1]]$y.range
# Variable for selected points
selection <- data.frame(x = as.numeric(), y = as.numeric())
colnames(selection) <- c(ggobj$plot$mapping$x, ggobj$plot$mapping$y)
# Detect and move to plot area viewport
suppressWarnings(print(ggobj$plot))
panels <- unlist(current.vpTree()) %>%
grep("panel", ., fixed = TRUE, value = TRUE)
p_n <- length(panels)
seekViewport(panels, recording=TRUE)
pushViewport(viewport(width=1, height=1))
# Select point, plot, store and repeat
for (i in 1:10){
tmp <- grid.locator('native')
if (is.null(tmp)) break
grid.points(tmp$x,tmp$y, pch = 16, gp=gpar(cex=0.5, col="darkred"))
selection[i, ] <- as.numeric(tmp)
}
grid.polygon(x= unit(selection[,1], "native"), y= unit(selection[,2], "native"), gp=gpar(fill=NA))
#return a data frame with the coordinates of the selection
return(selection)
}
locator(p)
and from here use the point.in.polygon function to subset the data based on the selection.
A possible solution could be to add, say 100x100, invisible points to the plot and then use the plotly_click feature of event_data() in a Shiny app, but this is not at all ideal.
Thanks in advance for your ideas or solutions, I hope my question was clear enough.
-- Kasper
I used ggplot2. Besides the materials at https://shiny.rstudio.com/articles/plot-interaction.html, I'd like to mention the following:
Firstly, when you create the plot, don't use "print( )" within "renderPlot( )", or the coordinates would be wrong. For instance, if you have the following in UI:
plotOutput("myplot", click = "myclick")
The following in the Server would work:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
p
})
But the clicking coordinates would be wrong if you do:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
print(p)
})
Then, you could store the coordinates by adding to the Server:
mydata = reactiveValues(x_values = c(), y_values = c())
observeEvent(input$myclick, {
mydata$x_values = c(mydata$x_values, input$myclick$x)
mydata$y_values = c(mydata$y_values, input$myclick$y)
})
In addition to X-Y coordinates, when you use facet with ggplot2, you refer to the clicked facet panel by
input$myclick$panelvar1
I've been looking into ways to update a plot within an R Shiny application without having to re-render the whole plot. I'm working with temporal data which is animated via a Slider Input (animationOptions(playButton = TRUE)). The idea is to somehow highlight the part of the plot which is selected via the Slider Input. Re-rendering the whole plot at every animation step would make the whole application uselessly slow.
The most elegant solution with ggplot2 would have been, if shiny offered a way to add layers to the ggplot (e.g. + geom line()) and integrated this layer seamlessly into the plot without re-rendering it. Sadly, this does not seem to work. A bit of a hack could include creating a second ggplot-instance with exactly the same x/y-dimensions and overlapping the two plots.
EDIT:
I've just learnt that there are more javascript oriented plotting methods than ggplot2. For example, using dygraphs and adding a layer of dyShading, the selected area gets highlighted nicely. The basic question remains the same though, since changing the start- and end values of dyShading() seems to require re-rendering the whole plot.
library(shiny)
library(dygraphs)
library(xts)
data <- data.frame(
datetime = as.POSIXct("2016-06-20 17:00:00", tz = "UTC") + 1:100*60,
y = rnorm(100)
)
data_xts <- as.xts(data[,-1], data[,1])
minDatetime <- min(data$datetime)
maxDatetime <- max(data$datetime)
minY = min(data$y)
maxY = max(data$y)
plotlimits <- lims(x = c(minDatetime, maxDatetime), y = c(minY, maxY))
ui <- fluidPage(
sliderInput("timeslider", "Time Slider",
min = minDatetime,
max = maxDatetime,
value = c(minDatetime, minDatetime+10*60),
animate = animationOptions(interval=200)
),
dygraphOutput("dyplot")
)
server <- function(input, output) {
data_fil <- reactive({
data[data$datetime <= input$timeslider[2] & data$datetime >= input$timeslider[1],]
})
output$dyplot <- renderDygraph({
dygraph(data_xts) %>%
dyShading(
from = as.character(input$timeslider[1]),
to = as.character(input$timeslider[2]),
color = "tomato")
})
}
shinyApp(ui = ui, server = server)