I am trying to adjust plots in flexdashboard by taking the pixelratio provided by the user session, this works fine when I am rendering plot with renderPlot but I am struggling to assign dynamic heights / widths to plots that are rendered with renderPlotly
I extract the user pixel ratio as followed
pixelratio <- reactive({
session$clientData$pixelratio
})
attempt 1
output$myplot <- renderPlotly(myplot())
plotlyOutput("myplot", height = function() {900 / pixelratio()}, width = 825)
the first attempt is giving the following error msg :
Error : CSS units must be single element numeric or character vector
attempt 2
output$myplot <- renderPlotly(myplot())
plotlyOutput("myplot", height = 900 / pixelratio(), width = 825)
the second attempt is submitting the following error msg:
Error : Operation not allowed without an active reactive context.
* You tried to do something that can only be done from inside a reactive consumer
Is there a way to get pixelratio in order to autoscale plotlyOutput?
You can set the height in the plotl_ly function and set height = "auto" in plotlyOutput.
library(shiny)
library(plotly)
library(dplyr)
library(tibble)
state <- data.frame(state.x77, state.region, state.abb) %>%
rename(Region = state.region) %>%
rownames_to_column("State")
ui <- fluidPage(
br(),
plotlyOutput("myplotly", width = 825, height = "auto")
)
server <- function(input, output, session){
pixelratio <- reactive({
session$clientData$pixelratio
})
output[["myplotly"]] <- renderPlotly({
plot_ly(
data = state,
x = ~ Income,
y = ~ Murder,
type = "scatter",
mode = "markers",
text = ~ paste(State, "<br>Income: ", Income, '<br>Murder Rate:', Murder),
height = 900 / pixelratio()
)
})
observe({
print(pixelratio())
})
}
shinyApp(ui, server)
Related
I am plotting a matrix using heatmaply and plotly
I want to make the plotylOutput height and width reactive to the size of the matrix
If I use a reactive value in the plotlyOutput width argument I get the following error:
Error in htmltools::validateCssUnit: CSS units must be a single-element numeric or character vector
See below for a minimum version of my code:
library(shiny)
library(heatmaply)
library(plotly)
ui <- tags$div(id = "placeholderimage", uiOutput("plotlyimage"))
server <- shinyServer(function(input, output, session) {
matsample <- reactive({cbind(c("A","A","A","T"),c("A","A","A","T"),c("A","A","A","G"))})
ranges <- reactiveValues(width_im = NULL,height_im=NULL)
ranges$width_im <- reactive(ncol(matsample())*20)
ms <- reactive({
alph <- c("A"=1, "C"=2, "G"=3, "T"=4, "-"=5, "N"=6, "S"=7)
ms <- matrix(alph[matsample()], ncol = ncol(matsample()), byrow=FALSE))
rownames(ms) <- rownames(matsample())
return(ms)
})
mm <- reactive({
data.frame(do.call(rbind, lapply(rownames(ms()), rep, ncol(matsample()))))
})
output$matimage <- renderPlotly({
heatmaply(ms(), custom_hovertext = mm(),
cellnote = matsample(),cellnote_size = 6,
cellnote_textposition = "middle center",
fontsize_col = 6,grid_gap = 1,grid_size = 0.01,
show_dendrogram = c(FALSE, FALSE),
Rowv=NULL, Colv=NULL, color=rainbow(7),
hide_colorbar=FALSE, plot_method = "plotly")
})
output$plotlyimage <- renderUI(
tags$div(class="superbigimage",
plotlyOutput("testplot", **width = isolate(ranges$width_im)**)
)
})
This code currently throws the error because of width = isolate(ranges$width_im), how can I make the width reactive to size of matrix?
Note my real work has matrices with over 600 columns
I forgot brackets and did not need to use isolate
output$plotlyimage <- renderUI(
tags$div(class="superbigimage",
plotlyOutput("testplot", width = ranges$width_im())
)
While building up my Shiny App I came across situation where ggplot2 graphic looks very different with different window sizes. The first graphic shows the plot in full desktop size - everything works great:
However, when I change the size of output window every element seems to scale down properly, but not geom_label (see the graphic below).
Why is that a case and how can I make the geom_label to scale down correspondigly?
The Shiny set-up is:
ui <- fluidPage(
mainPanel(
selectInput('cluster', '', 1:7),
plotOutput('ap_plot', height = 200)
)
)
)
server <- function(input, output, session) {
output$ap_plot <- renderPlot({
data %>%
filter(cluster == input$cluster) %>%
plot_sequences(.by = ts_cluster, .colour = id)
})
}
shinyApp(ui = ui, server = server)
As detailed in the shiny documentation the plot width for the current plot is defined within session$client_data$output_<plotname>_width, so for your example session$client_data$output_ap_plot_width. This can be used to scale the text argument of geom_label. You don't provide a minimal reproducible example, but here's one:
data <- tibble(
cluster = sample(7, 100, replace = TRUE),
x = rnorm(100),
y = rnorm(100)
)
plot_sequences <- function(data_set, width) {
label_data <- data_set %>%
summarise(
n = n(),
mean_x = mean(x),
mean_y = mean(y),
label = sprintf("N: %d\nMean x: %0.3f\nMean y: %0.3f", n, n, mean_x, mean_y)
)
ggplot(data, aes(x, y)) +
geom_point() +
geom_label(aes(x = 1.5, y = 1.5, label = label), label_data, size = 4 / 900 * width)
}
ui <- fluidPage(
mainPanel(
width = 12,
selectInput('cluster', '', 1:7),
plotOutput('ap_plot', height = 200)
)
)
server <- function(input, output, session) {
width <- 400
output$ap_plot <- renderPlot(execOnResize = TRUE, {
data %>%
filter(cluster == input$cluster) %>%
plot_sequences(session$clientData[["output_ap_plot_width"]])
})
}
shinyApp(ui = ui, server = server)
You can see that my plot function takes the plot width as an input and then scales the text size accordingly, using a width of 900 pixels as a baseline. Note also that I've set execOnResize to be TRUE, since otherwise the plot is replayed rather than recalculated when the window/plot are resized.
I have the dataframe below:
col1<-sample(500, size = 500, replace = TRUE)
col2<-sample(500, size = 500, replace = TRUE)
d<-data.frame(col1,col2)
And I create a histogram of this data frame that has click-event activated. When the user clicks on a bar the rows of the dataframe that have the relative value are displayed in a datatable. The problem is that the app works fine with a few values. If for example my dataframe had 5 rows instead of 500 with :
col1<-sample(5, size = 5, replace = TRUE)
col2<-sample(5, size = 5, replace = TRUE)
d<-data.frame(col1,col2)
But with more values the app does not work since the plotly gives a range of values in every single bar instead of a unique value.
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
render_value(d) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = d$col2, type = "histogram",source="subset") # set source so
# that you can get values from source using click_event
})
render_value=function(NN){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(d[d$col2==s$y,]))
})
}
}
shinyApp(ui, server)
You can try this (added code to capture the count). You need to plot a histogram of count and then you can able to get your original data based on click event.
library(plotly)
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
col1<-sample(500, size = 500, replace = TRUE)
col2<-sample(500, size = 500, replace = TRUE)
d<-data.frame(col1,col2)
d=d %>%
group_by(col2) %>%
mutate(count = n()) # You can programatically add count for each row
render_value(d) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = d$count, type = "histogram",source="subset")
# You should histogram of count
# set source so that you can get values from source using click_event
})
render_value=function(d){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(d[d$count==s$x,]))
})
}
}
shinyApp(ui, server)
Screenshot from the working prototype:
In ShinyApp, I want to plot a graph whose name has an interactive input value. So in the ui.R side, the user chooses an input value from 0, 1 or 2. And in the server.R side, I want the App to plot a graph whose name is either pl0, pl1 or pl2. That is to say, if the user chooses 0 as an input value, the App plots a graph pl0, so does the same for pl1 for input 1, and for pl2 and input 2. I am using plotly library for plotting graphs.
I have tried print(), plot(), return(), but neither of them worked.
Any solution or advice would be appreciated. Thank you very much!
Here is my ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Star Cluster Simulations"),
# Sidebar with a slider input for time
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "time",
label = "Select time to display a snapshot",
min = 0,
max = 2,
value = 0)
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("distPlot")
)
)
))
And here is my server.R
library(shiny)
library(plotly)
# load data
for(i in 0:2) {
infile <- paste0("Data/c_0", i, "00.csv")
a <- read.csv(infile)
b <- assign(paste0("c_0", i, "00"), a)
names(a) <- paste0("c_0", i, "00")
pl <- plot_ly(b, x = ~x, y = ~y, z = ~z, color = ~id) %>%
add_markers() %>%
layout(scene = list(xaxis = list(title = 'x'),
yaxis = list(title = 'y'),
zaxis = list(title = 'z')))
assign(paste0("pl", i), pl)
}
# shinyServer
shinyServer(function(input, output) {
output$distPlot <- renderPlotly({
# this doesn't work
print(paste0("pl", input$time))
})
})
I can't test this since your question isn't reproducible (i.e. doesn't include data), but one way to switch between text values (i.e. the values returned from Shiny inputs) and R objects is by making a reactive expression that uses the switch function. You can call the reactive expression (in the case below, plot.data()) inside renderPlotly (or any other render function) to switch between datasets.
shinyServer(function(input, output) {
plot.data <- reactive({
switch(paste0("pl", input$time),
"pl0" = pl0,
"pl1" = pl1,
"pl2" = pl2)
})
output$distPlot <- renderPlotly({
plot.data()
})
})
My problem here is, I think, an edge case for this type of problem. With that said, I've got some reproducible code here that might help a lot of people with similar issues they have, particularly the issue of changing a ggplot's plot height in RShiny (which is default set to 400px).
Here is a demo of a shiny app where the height of the ggplot is set equal to the width of the ggplot:
mydf = data.frame(x = 1:5, y = 1:5)
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotOutput('myplot', height = 'auto')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplot <- renderPlot({
ggplot(mydf, aes(x = x, y = x)) + geom_point()
}, height = function() { session$clientData$output_myplot_width })
})
# ====
shinyApp(ui, server)
Play around with the width of the window launched by launching this shiny app. By setting height = 'auto' in the UI, and then setting height = function() { session$clientData$output_myplot_width } in the Server, the height is dynamically updated. Very good indeed.
I am working on something similar in plotly, however a significant constraint that I have is that I currently need to pass a parameter for height and width to my call of plotly(), due to the very specific way I am trying to display the markers on my plot. An example of what I am trying to do is as such:
mydf <- data.frame(x = 1:5, y = 1:5)
myplotlyfunction <- function(mydf, myplotheight) {
plot_ly(mydf, height = myplotheight, width = myplotheight * 1.2) %>%
add_trace(x = ~x, y = ~y, type = 'scatter', mode = 'markers')
}
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotlyOutput('myplotly')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplotly <- renderPlotly({
this.height <- 600
myplotlyfunction(mydf, myplotheight = this.height)
})
})
# ====
shinyApp(ui, server)
The specific reason why I need to pass a height and width parameter to the plot_ly() call is deserving of a post of its own, and unfortunately I haven't thought of a work around yet. Here is a real example of my plot_ly output -
At a high level, the marker size parameter for plot_ly scatter plots sets the marker sizes based on pixels, and my plot needs very specifically sized markers, and these marker sizes are therefore a function of the plot size.
Here is my attempt to make my plot_ly plots dynamic in Shiny, despite having to initially pass a fixed parameter to the plot_ly height. The idea is motivated on the initial ggplot() dynamic height function:
mydf <- data.frame(x = 1:5, y = 1:5)
myplotlyfunction <- function(mydf, myplotheight) {
plot_ly(mydf, height = myplotheight, width = myplotheight * 1.2) %>%
add_trace(x = ~x, y = ~y, type = 'scatter', mode = 'markers')
}
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotlyOutput('myplotly', height = 'auto')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplotly <- renderPlotly({
this.height <- function() { session$clientData$output_myplotly_width }
myplotlyfunction(mydf, myplotheight = this.height)
}, height = function() { session$clientData$output_myplotly_width })
})
# ====
shinyApp(ui, server)
This does not work, and in fact the app crashes right away.
Thank you a ton for anybody who made it to the end of this post. Any help is appreciated regarding how I can dynamically resize a plot_ly() plot in R Shiny, based on the height or width of the app window, given that the plot_ly function itself requires a height parameter. Thoughts on how to solve the underlying problem of needing a height parameter to plot_ly() in the first place are appreciated as well, but that's a separate issue (that I've posted about myself, here - Set marker size based on coordinate values, not pixels, in plotly R - and in other posts as well).
Once again, thanks a ton for any help!