Related
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)
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")
})
I have been trying for some time to debug my Shiny gadget but still cannot manage it. Really appreciate any help.
My gadget consists of a scatterplot generated with Plotly. The user can click one of the points, which will allow you to change some parameters associated with that point. To emphasise the fact that the user has selected that point, I wanted to highlight the selected point.
Alternatively, the user can also select a point from a dropdown menu, which also should highlight the corresponding point.
As an added feature, I want to additionally highlight points that are below a certain threshold on the x axis. This threshold is represented by a dotted line, which you can turn on and off, and move the value of the threshold.
In summary, the points on the plot should all be blue circles, except for the following two cases:
if it is clicked, i.e. it is the "active point" (this should create a red border around the point)
if it is below the threshold on the x-axis (the point should turn to an orange square)
If it is active AND below the threshold, it should be an orange square with a red border, as you would expect.
My gadget works, kind of. But in some cases not. In the example below, one of the points is already below the threshold, but when I select that point, the red marker appears on another point! Despite the active variable being the correct one.
I also get a weird behaviour that the points turn purple if the threshold is below all of the points. But if I move the threshold to be above one of the points, the colours are corrected.
I have a suspicion that this is something to do with the points being on different traces? Therefore when I try to highlight certain points, perhaps I am not indexing the vector as I am expecting. But I am finding it really difficult to debug inside Shiny and Plotly, and I have no good understanding of the Plotly object, so I don't have much clue as to what is going on.
The code below is a reproducible example. You have to run "dat1" through the "rew8r" function. I have taken out other features of the app to try to focus on the problem. Thanks very much to anyone who might take the time to have a look at this, and give any hints!
library(plotly)
library(dplyr)
library(shiny)
library(reactable)
dat1 <- data.frame(
Indicator = c("v1","v2","v3"),
Weight = rep(1,3),
Correlation = c(0.1, 0.8, 0.6) )
rew8r <- function(dat){
# get indicator names
inames <- dat$Indicator
## Create the shiny UI layout
ui <- fluidPage(
# the side panel
sidebarPanel(
selectInput("vseldrop", "Select indicator here or by clicking a point on plot.",
c("<Select>",inames)),
hr(style = "border-top: 1px solid #000000;"),
fluidRow(
column(6,numericInput("locorval", "Low correlation threshold:", 0.2, min = -1, max = 1, step = 0.05)),
column(6,br(),checkboxInput("locorsw", "Enable", value = FALSE)))
),
# the main panel (graph, table, etc)
mainPanel(
plotlyOutput("corrplot"),
textOutput("info")
)
)
## Create the Shiny Server layout
server <- function(input, output, session) {
# this is the plotly click data
event.data <- reactive({event_data(event = "plotly_click", source = "scplot")})
# First, monitor which variable is active
# Create reactive value for active var
acvar <- reactiveVal(NULL)
# update active variable via plot click
observeEvent(event.data(),{
acvar(event.data()$key)})
# update active variable via dropdown
observeEvent(input$vseldrop,
acvar(input$vseldrop))
## Create the plotly plot that compares price vs scoops
output$corrplot <- renderPlotly({
# colours around markers when selected or not
lincol <- ifelse(inames %in% acvar(), "red", "blue")
# size of line around marker (set to 0 if not selected)
linsize <- ifelse(inames %in% acvar(), 3, 0)
# symbol when above/below corr threshold
symbs <- if(input$locorsw==TRUE){c(16,15)}else{c(16,16)}
# colour when above/below threshold
pcols <- if(input$locorsw==TRUE){c("blue", "orange")}else{c("blue", "blue")}
# generate main plot
p <- plot_ly(dat, x = ~Correlation, y = ~Weight, type = "scatter", mode = "markers",
text = ~Indicator, key = ~Indicator, source = "scplot",
marker = list(size = 10, line = list(color = lincol, width = linsize)),
symbol = ~Correlation < input$locorval, symbols = symbs,
color = ~Correlation < input$locorval, colors = pcols) %>%
layout(showlegend = FALSE, yaxis = list(
range = c(0, 1.25),
autotick = FALSE,
dtick = 0.25),
xaxis = list(
range = c(-0.5, 1),
autotick = FALSE,
dtick = 0.2))
# add low correlation line, if activated
if(input$locorsw==TRUE){
p <- p %>% add_segments(x = input$locorval, xend = input$locorval, y = 0, yend = 1.25,
marker = list(color = 'red', opacity=0),
line = list(dash = 'dash')) %>%
layout(showlegend = FALSE)
}
p
})
# Text info
output$info <- renderText({
paste(acvar(), class(acvar()))
})
# update dropdown menu
observeEvent(acvar(),{
updateSelectInput(session, "vseldrop", selected = acvar())
})
}
runGadget(ui, server, viewer = browserViewer())
}
I am trying to create a shiny app with multiple sections, the section I am having trouble with right now displays calculated values on a ggplot graph. The user selects one Target gene from a dropdown list, and the graph displays calculated analysis values against a selection of other, Control genes. So far so simple.
I have a few default Control genesets, which I have preselected and that are always displayed, and then I have an option for the user to specify their own Control genes to perform analysis against. There is a checkbox that can be ticked if the user wants to select their own Controls. The user can also select different numbers of custom Controls, whereas the default controls each have sets of 3 Control genes.
Code for the default genesets as so:
ABC_control <- reactive(
Analysis_function(c("ACTB", "GAPDH", "TUBB")))
And code for the custom genesets is as so:
CUSTOM_control1 <- reactive( if (input$custom_checkbox1) {
Analysis_function(input$custom_controls1)
} else { NA } )
I have an if command in the Custom genesets so that they are not calculated and displayed if the tickbox is not checked.
First problem: The plot still displays an x axis label for the Custom control even if none is selected and the checkbox is not ticked. This is not a major problem, just an annoying one.
The second problem:
When displaying just the default genesets everything runs perfectly. And when the user selects their own Control genes, everything runs fine.
The problem is when the user ticks the CheckboxInput(), and the selectizeInput() for the custom control genes is still empty, the graph goes and re-orders its x-axis into alphabetical order, rather than the levels order that I have specified earlier. As soon as a Control gene is selected, it re-orders back into the levels order. The problem only occurs when the selectizeInput box is empty, or a new gene is being selected.
How can I force the plot to always display in the correct levels order, even when the reactive custom input is empty?
Also, preferably, how can I prevent the Custom input from being displayed on the graph at all unless the checkbox is ticked.
A full Shiny app data is below:
#### Load packages ####
library(shiny)
library(ggplot2)
library(dplyr)
#### Load data files ####
load("GeneNames.Rda")
load("Dataset.Rda")
#### Define UI ####
ui <- fluidPage(
#### Sidebar inputs ####
sidebarLayout(
sidebarPanel(width = 3,
#first wellpanel for selecting Target gene
h4("Target gene selection"),
wellPanel(
selectInput(
inputId = "gene_select",
label = NULL,
choices = GeneNames,
selected = "ESAM")),
#Second wellpanel for selecting custom Control genes
h4("Custom control genes"),
wellPanel(
checkboxInput(inputId = "custom_checkbox1",
label = "Custom 1:"),
conditionalPanel(condition = "input.custom_checkbox1 == true",
selectizeInput(inputId = "custom_controls1",
label = NULL,
choices = GeneNames,
multiple = TRUE,
options = list(openOnFocus = FALSE, closeAfterSelect = TRUE, maxOptions = 50, maxItems = 6))))
),
#### Mainpanel results Normal ####
mainPanel(width = 9,
#HTML code to have the last entry in any tables bolded (last entry is Mean in all tables)
#Results title and main bar plot graph
fluidRow(plotOutput(outputId = "celltype_bar_plot"),width = 9)
)))
#### Define server ####
server <- function(input, output) {
target_gene <- reactive({
input$gene_select
})
#### calculations ####
Analysis_function <- function(controls){
cor(Dataset[, target_gene()], Dataset[, controls])
}
ABC_control <- reactive(
Analysis_function(c("ACTB", "GAPDH", "TUBB")))
GHI_control <- reactive(
Analysis_function(c("ACTB", "GAPDH", "TUBB")))
DEF_control <- reactive(
Analysis_function(c("ACTB", "GAPDH", "TUBB")))
CUSTOM_control1 <- reactive( if (input$custom_checkbox1) {
Analysis_function(input$custom_controls1)
} else { NA } )
#### Analysis datatables Normal ####
control_list <- c("ABC_control", "GHI_control", "DEF_control", "CUSTOM_control1")
analysis_list <- reactive({ list(ABC_control(), GHI_control(), DEF_control(), CUSTOM_control1()) })
#generating melted data table of the induvidual analysed gene values, transposed to get in right format, and times = c(length()) to replicate titles the correct no of times
values_list <- reactive({
data.frame(Control_types2 = factor(rep(control_list, times = c(unlist(lapply(analysis_list(), length)))), levels =control_list),
values = c(unlist(lapply(analysis_list(), t))))
})
#Generating data table of the means of analysed values above
Mean_list <- reactive({
data.frame(Control_types = factor(control_list, levels =control_list),
Mean_correlation = c(unlist(lapply(analysis_list(), mean))))
})
#### Main Bar Plot Normal ####
output$celltype_bar_plot <- renderPlot({
ggplot() +
geom_point(data = values_list(),aes(x=Control_types2, y=values,size = 7, color = Control_types2), show.legend = FALSE, position=position_jitter(h=0, w=0.1), alpha = 0.7) +
geom_boxplot(data = Mean_list(), aes(Control_types, Mean_correlation), size = 0.5, colour = "black")
})
}
#### Run application ####
shinyApp(ui = ui, server = server)
I can't fully test this solution since the data you provided isn't available (so I can't run the app), but I suspect that the following should help.
First, by using ordered or factor(..., ordered = TRUE) you can tell the graph what order to put label in.
Second, in order to prevent the column from showing up on the graph you must remove all datapoints for that column INCLUDING NA.
control_list <- c("ABC_control", "GHI_control", "DEF_control", "CUSTOM_control1")
# Some data to try out
values_list <- data.frame(
Control_types2 = ordered(rep(control_list, times = 4), levels =control_list),
values = c(0.25,0.50,0.75,NA)
)
Mean_list <- data.frame(
Control_types = ordered(control_list, levels =control_list),
Mean_correlation = c(0.25,0.50,0.75,NA)
)
# Original plot code
ggplot() +
geom_point(data = values_list,aes(x=Control_types2, y=values,size = 7, color = Control_types2), show.legend = FALSE, position=position_jitter(h=0, w=0.1), alpha = 0.7) +
geom_boxplot(data = Mean_list, aes(Control_types, Mean_correlation), size = 0.5, colour = "black")
# New plot with NA values removed
ggplot() +
geom_point(data = values_list %>% filter(!is.na(values)),
aes(x=Control_types2, y=values,size = 7, color = Control_types2),
show.legend = FALSE,
position=position_jitter(h=0, w=0.1),
alpha = 0.7) +
geom_boxplot(data = Mean_list %>% filter(!is.na(Mean_correlation)),
aes(Control_types, Mean_correlation),
size = 0.5,
colour = "black")
I'm trying to incorporate three plots in shiny, all of which use the d3 library. On placing them in different tabPanels(or the same one for that matter), I see only one or two plots, and they do not react properly. One of the plots is pulled from 'pp.html' and is based on d3.v3.min.js library. Second plot is pulled from 'australian.html' and it uses d3.v4.js library. The third plot is created using scatterD3 library of R.
A minimum working example is given below:
ui.R
shinyUI(bootstrapPage(
navbarPage("You Got Served!", id = "page",
tabPanel("Overall Analysis", value = "panel1",
h2(textOutput("title")),
scatterD3Output("scatter", width = "1500", height = "700"),
br()),
tabPanel("Parallel Coordinate", value = "panel2",
fluidRow(
column(2,
uiOutput("pc", width = 700, height = 600),
br())
)),
tabPanel("Sunburst", value= "panel3",
suppressDependencies("d3.v3.min.js"),
uiOutput("gs"),
br(),
hr())
)))
server.R
shinyServer(function(input, output, session) {
session$onSessionEnded({stopApp})
output$scatter <- renderScatterD3({
dat <- mydata %>%
mutate(FirstServePercent = (w_1stIn/w_svpt) * 100, MatchDuration =
minutes, Hand = winner_hand) %>%
select(FirstServePercent, MatchDuration, Hand, Surface = surface,
Tournament = tourney_name)
s1 <- scatterD3(data = dat, y = FirstServePercent, x = MatchDuration,
col_var = Surface, symbol_var = Hand, point_size = 70, labels_size = 30,
xlab = "Match Duration (in minutes)", ylab = "First Serve %", axes_font_size
= "15px", legend_font_size = '20', point_opacity = 0.5, hover_size = 1.8,
hover_opacity = 1, transition = TRUE)
s1
})
output$gs <- renderUI({
return(htmlTemplate("australian.html"))})
output$pc <- renderUI({
return(htmlTemplate("pp.html"))})
})
I tried to find examples relating to the usage of suppressDependencies() function in R, but was not able to find any working ones. I want to know where exactly should I use that function to render the three charts correctly, with their relevant interactions. If the solution involves using a functionality other than suppressDependencies, I'll really appreciate that too.
A part of the dataset mydata looks something like this:
You can use iframes in your renderUi to avoid dependencies issues:
plot is pulled from 'australian.html' and it uses d3.v4.js library. The third plot is created using scatterD3 library of R.
output$gs <- renderUI({
tags$iframe(src='australian.html',width="100%",frameBorder="0",height="500px")
})
output$pc <- renderUI({
tags$iframe(src='pp.html',width="100%",frameBorder="0",height="500px")
})