Selective y variable in shiny plotly output - r

I'm trying to include a plotly plot in a shiny app where the y variable is selected by the user. I initially used ggplot2 and plotly together, and the code I have works just fine for that. But because the number of data points is quite large, the plot takes several minutes to load, so I tried switching to plotly only because I read somewhere that that makes it faster. Unfortunately I cannot get the y variable selection to work.
I have tried the suggestions given here: Change plotly chart y variable based on selectInput and here: Error: invalid first argument with R Shiny plot and none of them work. At this point I have tried so many things I don't remember in detail, but basically I either get the error "invalid first argument" when using some variation of yvar <- get(input$yvariable1) and then including ~yvar in the plot function, or I get "Error: cannot set attribute on a symbol" when it's y = ~input$yvariable1. When I use y = newdata[ ,input$yvariable1] something gets plotted but it's completely wrong (the scale of the axis is up to 50k or something instead of 10 and the distribution is not right either - basically it looks nothing like when I plot it by simply entering the same y variable non-reactively).
My code looks as follows - in UI:
uiOutput("ySelection1")
in server:
function(input, output) {
output$ySelection1 <- renderUI({
varSelectInput("yvariable1", "Y Variable:", df[, c('PO_count_citing', 'cpc_3digits_count_citing', 'cpc_4digits_count_citing')], selected='PO_count_citing')
})
yvar1 <- eventReactive(input$yvariable1, {input$yvariable1})
output$plot1 <- renderPlotly({
newdata <- subset(df, Technology == input$type & appln_auth%in%input$PO)
validate(no_data(nrow(newdata)))
#yvar <- get(yvar1()) (failed attempt at making this work)
#yvar <- get(input$yvariable1) (another failed attempt)
scatterPlot <- plot_ly(newdata, x = ~appln_filing_year, y = ~input$yvariable1, type="scatter", mode="markers",
# Hover text:
text = ~paste(some text),
color = ~appln_auth)
})
}
But I can't get it to work. In the original ggplot2 version it was entered as aes(x = appln_filing_year, y = !!yvar1(), bla bla)
But the !! or even one ! or removing the brackets after yvar1 all throw up errors in plotly.
Does anyone have any suggestions?

Here is a simple example using get:
library(shiny)
library(plotly)
DF <- setNames(data.frame(rep(1:20, 5), mapply(runif, min = 1:5, max = 2:6, MoreArgs = list(n = 20))), c("x", paste0("y", 1:5)))
library(shiny)
ui <- fluidPage(
plotlyOutput("myPlot"),
selectInput("yvariable", "Select the Y variable", paste0("y", 1:5))
)
server <- function(input, output, session) {
output$myPlot <- renderPlotly({
req(input$yvariable)
plot_ly(data = DF, x = ~x, y = ~get(input$yvariable), type = "scatter", mode = "markers")
})
}
shinyApp(ui, server)

Related

How to change the y in flexdashboard selectInput

I'm trying to make a flexdashboard using IMDb data, that has an interactive jitter plot where you can change the x and y for visualizing hierarchical clustering result. The code that I've already made can change only the x and number of k. I think I should use reactive function but I don't really understand in using that. I've already tried many other ways from youtube and some documentary but still can't change the y. Here is layout of my dashboard, The y stuck at the runtime variable
data=df %>%
select(Rating, Votes, Gross, Runtime, Metascore)
selectInput("x", label = "X : ",choices = names(data))
selectInput("y", label = "Y : ",choices = names(data))
sliderInput('k',"Cluster",min = 2,max = 10, value = 6)
selectedData=reactive({
data %>% select(input$x, input$y)
})
data_scaled=scale(data)
dist_data=dist(data_scaled, method='euclidean')
hc_data=hclust(dist_data, method = "average")
renderPlot({
ggplot(selectedData(),
aes(x=!!rlang::sym(input$x), y=!!rlang::sym(input$y),
col=factor(cutree(hc_data, k=input$k))))+
geom_jitter(size=5, alpha=0.5 )+
labs(col="Cluster")
})
Here is an alternative example that seems to work, using the diamonds dataset from ggplot2. My guess is that the scaling and clustering steps take so long to run that the the y reactive only appears not to work. I would suggest pre-processing your data if app run times are a problem.
data=diamonds[1:1e3,] %>%
dplyr::select(where(is.numeric))
selectInput("x", label = "X : ",choices = names(data))
selectInput("y", label = "Y : ",choices = names(data))
sliderInput('k',"Cluster",min = 2,max = 10, value = 6)
data_scaled=scale(data)
dist_data=dist(data_scaled, method='euclidean')
hc_data=hclust(dist_data, method = "average")
renderPlot({
ggplot(data,
aes(x=!!rlang::sym(input$x), y=!!rlang::sym(input$y),
col=factor(cutree(hc_data, k=input$k))))+
geom_jitter(size=5, alpha=0.5 )+
labs(col="Cluster")
})

Extract all click event plots from Shiny, Plotly - R

In the following shiny app, the plotly package is used to create an interactive correlation heat map. When individual tiles are clicked, the corresponding scatter plot appears. One can then download the individual scatters by clicking download plot as png. But is there a way to download all the possible scatter plots at once without having to click each individual tile and save each individual one? Thank you
library(plotly)
library(shiny)
# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat"),
plotlyOutput("scatterplot")
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
plot_ly(x = nms, y = nms, z = correlation,
key = correlation, type = "heatmap", source = "heatplot") %>%
layout(xaxis = list(title = ""),
yaxis = list(title = ""))
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a cell in the heatmap to display a scatterplot"
} else {
cat("You selected: \n\n")
as.list(s)
}
})
output$scatterplot <- renderPlotly({
s <- event_data("plotly_click", source = "heatplot")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(mtcars[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = ~x) %>%
add_markers(y = ~y) %>%
add_lines(y = ~yhat) %>%
layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plotly_empty()
}
})
}
shinyApp(ui, server)
You can use webshot to capture a static image of Plotly's HTML output using the instructions here: https://plot.ly/r/static-image-export/
An example for loop below generates random scatter plots from mtcars.
library(plotly)
library(webshot)
## You'll need to run the function the first time if you dont't have phantomjs installed
#webshot::install_phantomjs()
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("Scatter_",xCol,"_vs_",yCol,".png")
plot_ly(x = mtcars[[xCol]], y = mtcars[[yCol]], type = "scatter", mode = "markers") %>%
export(., file = ThisFileName)
}
However, if you're going to be potentially doing this dozens of times, the amount of computation required to go through the following steps really adds up.
Generate a JSON plotly object from R
Use htmlwidgets/htmltoolsto generate a self-contained HTML web page
Render that HTML as a browser would see it with an external program --webshot
Use webshot to render an image of that HTML and save it as a PNG
This isn't really a reflection of plotly being slow, but to make an analogy it's kind've like using an airplane to travel half a mile -- the plane gets you there, but if you need to make that trip more than a few times you should probably consider a car.
The plotly loop above takes 27 seconds to render 5 PNG images, but the alternative method below using ggplot2 takes 1.2 seconds.
library(ggplot2)
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("ggplot2_Scatter_",xCol,"_vs_",yCol,".png")
ggplot() +
geom_point(aes(x = mtcars[[xCol]], y = mtcars[[yCol]])) +
labs(x = xCol, y = yCol) -> ThisPlot
ggsave(plot = ThisPlot, filename = ThisFileName)
}

Is it possible to achieve Shiny plot interaction with multiple categorical axes?

I'm in the process of creating my first Shiny app that returns a data table when a user interacts with a ggplot object (plot) with a mouse event. Using this example from RStudio, I've been able to produce something which filters and returns a data table (diamonds) based upon the position on the x-axis (cut). Its almost there... However, I have two outstanding issues that I have been unable to solve:
Is it possible to return a data table based upon a mouse event that is filtered by the y-axis (color) as well as the x-axis (cut)?
Following from (1), can the data table then be further filtered so that it returns only information from that facet (type)?
This is where I've got up to using reproducible code:
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
fluidRow(
plotOutput("plot1", click = "plot1_click")),
fluidRow(column(width = 10, dataTableOutput("selected_rows"))))
server <- function(input, output) {
is.even <- function(x) x %% 2 == 0
plot <- diamonds %>%
mutate(cut = as.factor(cut)) %>%
mutate(colour = as.factor(color)) %>%
mutate(type = is.even(price)) %>%
group_by(type, color, cut) %>%
count()
output$plot1 <- renderPlot({
ggplot(plot, aes(x = cut, y = color, colour = type)) +
geom_point(aes(size = n)) +
facet_grid(~type) +
theme(legend.position = "none")
})
output$selected_rows <- renderDataTable({
if (is.null(input$plot1_click$x)) return()
keeprows <- round(input$plot1_click$x) == as.numeric(diamonds$cut)
diamonds[keeprows, ]
})
}
shinyApp(ui, server)
Any help would be much appreciated. Thanks in advance.
I believe this is possible if you do a bit more logic within output$selected_rows. To filter by the y variable, simply add a reference to input$plot1_click$y. For the facet (or panels), you'll want to use input$plot1_click$panelvar1:
keeprows_x <- round(input$plot1_click$x) == as.numeric(diamonds$cut)
keeprows_y <- round(input$plot1_click$y) == as.numeric(diamonds$color)
keeprows_panel <- input$plot1_click$panelvar1 == is.even(diamonds$price)
diamonds[keeprows_x & keeprows_y & keeprows_panel, ]
Note: I'm mimicing the logic for type with is.even(diamonds$price). You may want to see this github issue for further discussion and solutions.

Strategies for editing reactive functions in Shiny, 'data' must be of a vector type, was 'NULL' error

Goal: I am trying to create a shiny app that displays (1) the stressplot of a non-metric multidimensional scaling solution, (2) a ggplot of the point configuration, and (3) the results of clustering the point configuration by plotting the point configuration and superimposing chulls of the clustering.
Problem: The first two plots work without difficulty. Instead of a third plot, I get the error: 'data' must be of a vector type, was 'NULL'
I would appreciate any advice on how to resolve the specific problem, i.e. "error in array: 'data' must be of a vector type, was 'NULL'"
I would also appreciate any general advice on how to debug shiny. My only strategy is to treat the code like it isn't reactive code, and I suspect that this strategy isn't terribly effective.
My attempt to solve: I've searched the error on rseek and stack overflow and reviewed the posts. In some of the cases with similar errors the problem was that necessary data wasn't being calculated. I went through the code, treated it as normal (non-reactive) code, and used fake data. When I did this I didn't have any problem, so I assume it is something about the reactivity? Question 2 about how to debug is a reaction to the fact that trying to debug like the code wasn't dynamic didn't identify the problem.
Reproducible Example: I put together a shiny app that has randomly generated data. Before doing the testing I updated R and all the packages I use.
# Packages and options
library(shiny)
library(vegan)
library(cluster)
library(tidyverse)
options(digits = 3)
# Create dissimilarity matrix
d <- rnorm(1000)
mat <- matrix(d, ncol = 10)
diss_m <- daisy(mat) %>% as.matrix()
# Function
find_chulls <- function(df, x, y) {
ch <- chull(df[[x]], df[[y]])
df[ch,] %>% as.data.frame()
}
ui <- fluidPage(
titlePanel("Research"),
sidebarLayout(
sidebarPanel(
numericInput('dim', 'Dimensions', 2, min = 2, max = 15)
),
mainPanel(
h3('Stressplot'),
plotOutput('plot0'),
h3('Non-Metric Multidimensional Scaling'),
plotOutput('plot1'),
h3('2d Density Plot'),
plotOutput('plot2'),
h3('Cluster Analysis'),
plotOutput('plot3')
)
)
)
server <- function(input, output, session) {
nmds <- reactive({
metaMDS(diss_m,
distance = "euclidean",
k = input$dim,
trymax = 200,
autotransform = FALSE,
noshare = FALSE,
wascores = FALSE)
})
output$plot0 <- renderPlot({
stressplot(nmds())
})
pts <- reactive({
nmds()$points %>% as.data.frame()
})
output$plot1 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point()
})
output$plot2 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point() +
geom_density2d()
})
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
df_ch <- reactive({
df_ch_temp <- df_cl() %>% group_by(clust) %>% do(find_chulls(., 1, 2))
df_ch_temp %>% as.data.frame()
})
The plot below is the one that doesn't work
output$plot3 <- renderPlot({
ggplot(df_ch(), aes(x = MDS1, y = MDS2, fill = as.factor(clust))) + geom_polygon(alpha = 0.10)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your input$clust is undefined in:
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
You need to add an input binding for clust, e.g.:
numericInput('clust', 'Clusters', 2, min = 2, max = 15)
As for debugging: I added browser() at the top in df_cl, then execution stops and you can inspect variables and run code in the terminal (e.g. in Rstudio). When I ran km <- kmeans(x = pts(), centers = input$clust) I got the error you described and could then see that input contains no clust element.

plotly linear trend line not updating in shiny

I am trying to add a linear trend line to a plotly plot in a shiny app. When I change the selection parameters, I see that the coefficients of the linear model change (using observe(print(summary(l)). However, the actual line on the plot seems to stay in the same place.
Here is one plot, where the trend line at least seems close to intersecting the two points:
In another plot, the trend line is nowhere near the first point:
Here is a minimal working example:
library(dplyr)
library(shiny)
library(plotly)
df <- as.data.frame(list("UserID"=c(1,1,1,1,2,2,2,2),
"QuestionID"=c(4,4,5,5,4,4,6,6),
"KeystrokeRate"=c(8,4,6,15,8,6,7,8),
"cumul.ans.keystroke"=c(1,7,1,5,1,14,1,9),
"Relative.Time.Progress"=c(0.1,1.0,0.4,1.0,0.8,1.0,0.8,1.0)
))
ui <- (fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("userInput","Select User", sort(unique(df$UserID)),
selected = sort(unique(df$UserID))[1]),
uiOutput("answerOutput")#,
),
mainPanel(
plotlyOutput("mainPlot")#,
)
)
))
server <- function(input, output, session) {
# filter only based on selected user
filteredForUser <- reactive({
try(
df %>%
filter(
UserID == input$userInput
), silent=T)
})
# filter for both user and answer
filteredFull <- reactive({
try (
df %>%
filter(
UserID == input$userInput,
QuestionID == input$answerInput
), silent=T)
})
# filter answer choices based on user
output$answerOutput <- renderUI({
df.u <- filteredForUser()
if(!is.null(df)) {
selectInput("answerInput", "Select A Typing Session",
sort(unique(df.u$QuestionID)))
}
})
output$mainPlot <- renderPlotly({
if (class(filteredForUser()) == "try-error" ||
class(filteredFull()) == "try-error") {
return(geom_blank())
} else {
# plot scatter points and add trend lines
p <- plot_ly(filteredFull(), x=Relative.Time.Progress, y=cumul.ans.keystroke,
mode='markers', color=KeystrokeRate, size=KeystrokeRate,
marker=list(sizeref=100), type='scatter')
l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
data=filteredFull())
observe(print(summary(l)))
p <- add_trace(p, y= fitted(l))
p
}
})
}
shinyApp(ui, server)
The problem is with the add_trace functionality. You need to provide it the x-axis to be able to correctly plot the lm result.
p <- add_trace(p, y = fitted(l), x = Relative.Time.Progress)
To see the problem more clearly, visualize the results with the entire dataset.
p <- plot_ly(df, x=Relative.Time.Progress, y=cumul.ans.keystroke,
mode='markers', color=KeystrokeRate, size=KeystrokeRate,
marker=list(sizeref=100), type='scatter')
p
l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
data=df)
p <- add_trace(p, y = fitted(l))
p
p <- plot_ly(df, x=Relative.Time.Progress, y=cumul.ans.keystroke,
mode='markers', color=KeystrokeRate, size=KeystrokeRate,
marker=list(sizeref=100), type='scatter')
l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
data=df)
p <- add_trace(p, y = fitted(l), x = Relative.Time.Progress)
p
So as you would see, add_trace was plotting the fitted(y) correctly but using x-axis to be c(0:7). I am guessing it is a default passed to add_trace, but I haven't looked deeply of the 'why' of this. The dataset df has eight points. You instead needed to give the actual Relative.Time.Progress values on the x-axis to correctly plot the fitted(y) w.r.t. actual x values. Hope this clarifies.

Resources