I want to draw a Plotly graph in the Shiny App in R. I want the the functionality in such a way that I want to plot a certain number of points (say 20) in a loop.
This is my code for the Server.R :-
xAxis = vector("numeric", as.numeric(input$Generations))
yAxis = vector("numeric", as.numeric(input$Generations))
graphDF = data.frame(cbind(xAxis, yAxis))
for(i in 1 : 5)
{ output$GA = renderPlotly({
print(graphDF) # Testing
graphDF$yAxis[i] = i
graphDF$xAxis[i] = i
print(graphDF) # Testing
# Plotly functionality
p <- plot_ly(graphDF, x = graphDF$xAxis, y = graphDF$yAxis)
})
}
Any help would be most appreciated.
Kind Regards
This was more complicated than it looked. It looks like you want to iterate and create a series of plotly graphs, changing the data values as you go along.
Because the Generations slider re-initializes the vector to a new length,
and each iteration changes the state of the data being plotted, you can't just cascade reactive functions. Storing the state in a reactiveValues is a good way to handle this.
The major changes were as follows:
Added a reactiveValues to store xAxis and yAxis
Added an observeEvent to reinitialize those values when its value change
Added an "Iteration range" slider to drive the iteration (easier than a reactive timer). Note that it has an animate parameter that (probably) creates a reactive timer on its own.
Modified the plotly call to make it more conventional and avoid warnings.
The code:
library(shiny)
library(plotly)
u <- fluidPage(
titlePanel("Iterations of a plotly graph"),
sidebarLayout(
sidebarPanel(
sliderInput("Generations","Number of Generations:",
min = 1, max = 50, value = 20),
sliderInput("iter", "Iteration range:",
value = 1, min = 1, max = 1000, step = 1,
animate=animationOptions(interval=800, loop=T)),
p("To start click on the blue arrowhead")
),
mainPanel(
plotlyOutput("GA")
)
))
s <- shinyServer(function(input,output){
rv <- reactiveValues(xAxis=NULL,yAxis=NULL)
observeEvent(input$Generations,{
rv$xAxis=vector("numeric", as.numeric(input$Generations))
rv$yAxis=vector("numeric", as.numeric(input$Generations))
})
output$GA = renderPlotly({
rv$yAxis[input$iter] <- input$iter
rv$xAxis[input$iter] <- input$iter
gdf <- data.frame(xAxis=rv$xAxis, yAxis=rv$yAxis)
plot_ly(gdf, x = ~xAxis, y = ~yAxis, type="scatter",mode="markers")
})
})
shinyApp(u,s)
Because it is dynamic, you have to run it to see how it really works, but here is a screen shot after several iterations:
Related
I'm trying to make my first shiny app, in which a number of values are taken in, a number of calculations are performed (which depend on both values in the input and those in the server function), and then the outputs plotted. However, I can either no plot at all in the output (as in the sample below), or can just get the 1:1 line and not my data to show up. I'm not entirely sure where to begin troubleshooting, but I think I have problems with both making the calculations and feeding them into the plot function here. If you have any pointers it would be greatly appreciated.
Here is a simplified version of my app:
library(shiny)
require(ggplot2)
ui<-fluidPage(
sidebarLayout(
sidebarPanel(
titlePanel("mytitle"),
sliderInput(inputId= "min", label="minratio", value=0, min=0, max=0.499),
sliderInput(inputId= "max", label="maxratio", value=1, min=0.5, max=1)
),
mainPanel(
textOutput("valoutput"),
plotOutput("distPlot",width="100%"))
)
)
server<-function(input, output){
BS = function(x) {
mini=x[1]; maxi=x[2]
ratio <-seq(from=mini,to=maxi, by=0.01)
total<-30*ratio+3
res = c(ratio,total)
}
data<-reactive({as.data.frame("mini"=as.numeric(input$min), "maxi"=as.numeric(input$max))})
output$valoutput <- renderText({BS(data())[1]})
output$distplot <- renderPlot({
d1=BS(data())[1]
d2=BS(data())[2]
ggplot()+geom_abline(intercept = 0, slope=1, colour="grey50")+geom_point(aes(x=d1, y=d2))
}, height = 350, width = 600)
}
shinyApp(ui=ui, server=server)
Thanks so much!
Your BS function is not correct. Change it with this one (with as.numeric). Otherwise x[1]/x[2] will be data.frames and will throw an error in seq(). Alternatively you could also use double brackets, like x[[1]].
BS = function(x) {
mini=x[1]; maxi=x[2]
ratio <-seq(from=as.numeric(mini),to=as.numeric(maxi), by=0.01)
total<-30*ratio+3
res = c(ratio,total)
}
and in your ui your plot output name is not correct. It should be distplot not distPlot.
And you dont need to call as.data.frame, just data.frame does the right job, as you want to create a data.frame and not convert an object.
data <- reactive({
data.frame("mini"=as.numeric(input$min),
"maxi"=as.numeric(input$max))
})
I have a chart in Shiny generated with the HighCharter package. I would like to surpress the "No data to display" message which is shown when the series to be plotted is empty. In my case, the actual content of the plot is shown as a plotLines (variable age below). However, in order for HighCharter to display the plotLines, it needs data. This is the reason, why I add the line (remove that line to see what I mean):
%>% hc_series(list(data=c(), visible=FALSE, id="dummy"))
Can this be done?
Here is a sample using reprex(venue="r"): I would like that the background gradient and the plotLines are showed but the message "No data to display" should be hidden.
library(shiny)
library(highcharter)
#> Highcharts (www.highcharts.com) is a Highsoft software product which is
#> not free for commercial and Governmental use
# layout
ui <- fluidPage(highchartOutput("highchart_slider", height = "200px"))
server <- function(input, output) {
# This value comes from the backend and is variable. It is in [-100, 100]
age <- 20
output$highchart_slider <- renderHighchart({
hcSlider <- highchart() %>%
hc_chart(renderTo= "container",
defaultSeriesType = 'bar',
plotBackgroundColor=list(
linearGradient = list(x1=0, x2=1, y1=0, y2=0),
stops=list(list(0, '#bf0000'),list(0.45, '#e1e218'),
list(0.55, '#e1e218'),list(1, 'darkgreen')))) %>%
hc_yAxis(tickInterval=100, min=-100, max=100,
plotLines=list(list(
label = list(text = "title", align = 'center', verticalAlign = 'top'),
color = "black", width = 4, value = age, y = -2))
) %>%
hc_series(list(data=c(), visible=FALSE, id="dummy"))
# display plot
hcSlider
})
}
# start the app
shinyApp(ui = ui, server = server)
#' <!--html_preserve-->
#' Shiny applications not supported in static R Markdown documents
#' <!--/html_preserve-->
Your question has no reproducible example, but as I understand, you want to prevent a plot to be plotted, whenever no data is available?
I would advice looking into req()
https://shiny.rstudio.com/articles/req.html
If you want a plot to be only plotted when let's say data is available,
do:
output$plot <- renderPlot({
req(data)
...
})
req will not only stop the plot when the data is NULL or FALSE, but also when the user has no data selected
How do I pass NULL as a Variable Value in RSHINY?
In phyloseq, there is a plot called plot_net.
The most basic plot_net plot code looks like this:
data(enterotype)
#Eliminate samples with no entereotype denomination
enterotype = subset_samples(enterotype, !is.na(Enterotype))
plot_net(enterotype, maxdist = 0.1, point_label = NULL)
I am trying to create an RShiny app which allows a user to alter this graphic.
point_label has several different options (ex: "SecTech", "SampleID", NULL).
I already have all of the other values for this label, I am just not sure how to add NULL.
Here is what I did:
This might not run since it isn't in a shiny app but I included it as an example to illustrate the issue.
library(shiny)
library(phyloseq)
# Data: This data contains info about nodes and edges on Phyloseq data.
data(enterotype)
#Eliminate samples with no entereotype denomination. Make it a lesson to
always catalogue data correctly from the start.
enterotype = subset_samples(enterotype, !is.na(Enterotype))
# a is the collection of variable names for point_label
a <- sample_variables(enterotype)
theme_set(theme_bw())
# Define UI for application that draws a network plot
shinyUI(fluidPage(
# Application title
titlePanel("Network Plots"),
sidebarLayout(
sidebarPanel(
selectInput("labelBy",
"Select the point label category",
***choices = c(a, "NA" = NULL),***
selected = "NA")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("netPlot")#,
#plotOutput("networkPlot")
)
)
))
shinyServer(function(input, output) {
output$netPlot <- renderPlot({
plot_net(enterotype, maxdist = .1, point_label = input$labelBy)
})
})
shinyApp(ui = ui, server = server)
This line is my question:
choices = c(a, "NA" = NULL)
How do I add NULL to my list of choices. No matter how I tried it, NULL was always taken as a zero value and it does not appear as an option.
If I write NULL as "NULL', the phyloseq function plot_net doesn't take it.
It only takes the value point_label = NULL for no value.
I think that it is possible to create an if... else loop where if a user clicks NULL on a checkboxInput then the plot will be generated by a second line of code specifying that the value in point_label is NULL, but that can be really cumbersome if there are several variables with a possible NULL Value.
There probably is some obvious trick like placing a $ or % in front of the NULL value but I couldn't find it. If anyone could help it would be great!
I don't think there is a way to use NULL in selectInput. Here's an alternative which you almost worked out - Use "None" (or any other replacement value) in selectInput and switch it with NULL while plotting. This way you don't have to write multiple if...else.
# update on UI side
selectInput("labelBy",
"Select the point label category",
choices = c("None", a),
selected = "None")
# update on server side
output$netPlot <- renderPlot({
point_labels <- switch(input$labelBy, "None" = NULL, input$labelBy)
plot_net(enterotype, maxdist = .1, point_label = point_labels)
})
The aim of this exercise is to allow users to compare two different models based on their inputs. To do this, I have created an action button that asks users to specify their base model, and a reset button that takes the dataset back to before the baseline was added. The "base" logical determines whether the user wishes to include the base or not.
Once the add baseline actionbutton is clicked, the current state of the data.frame is saved and grouping variable is renamed with "baseline" added before it (using paste). Users can select a different model which renders in comparison to this static base.
For some reason, I cannot get the observe event to change the dataset. The observe event creates the baseline dataset fine (tested with print() ), however, the if() function does not alter "data" and therefore stops the base added to the ggplot. The code is written like this for two reasons. 1) by including the if() function after the observe event, any further changes to data only changes "data", it then gets added to the unchanged baseline data. 2) Also allows for the creation of the reset button which simply resets the data.frame to before the rbinding took place.
This small issue has infuriated me and I cannot see where I am going wrong. Cheers in advance for any help people can provide. There are simplier ways to do this (open to suggestions), however, the iris data is only an example of the function, and the actual version is more complex.
library("ggplot2")
if (interactive()) {
ui <- fluidPage(
selectInput("rows", label = h3("Choose your species"),
choices = list("setosa", "versicolor", "virginica")
),
actionButton("base", "Create baseline"),
actionButton("reset", "Reset baseline"),
plotOutput(outputId = "plot")
) # close fluid page
server <- function(input, output) {
output$plot <- renderPlot({ # create plot
base <- "no" # create baseline indicator which we can change once the observeevent below is changed
data <- iris
data <- iris[which(data$Species == input$rows),] # Get datasubset based on user input
observeEvent(input$base, { # If base is Pressed, run code below:
baseline <- data # Make Baseline Data by duplicating the users' specification
baseline$Species <- paste("Baseline",
data$Species, sep = "_") # Rename the grouping variable to add Baseline B4 it
base <- "yes" # Change our indicator of whether a baseline had been made to yes
}) # Close observe Event
observeEvent(input$reset, {
base <- "no" # This is placed before the rbind so that if we want to reset it will stop the merging of the two dataframes before it happens.
})
if (base == "yes") {
data <- rbind(data, baseline) # Run once the observe event has changed baseline to yes.This is kept seperatel that way any subsequent changes to data will not effect
# the final data. This command will simple add the base onto the changed "data" before plotting
}
observeEvent(input$reset, {
base <- "no"
})
ggplot(data, aes(x=Petal.Width, y = as.numeric(Sepal.Width), colour = Species)) + # variable = each dataset selected, value = respective values for that model
labs(x="Hypothetical X", y="Hypothetical X") +
geom_line()
}) # Close Render Plot
} # Close Serve Function
shinyApp(ui, server)
}
EXAMPLE TWO WITH REACTIVE OBJECT
library(shiny)
library(ggplot2)
library("tidyr")
library("dplyr")
library("data.table")
# Lets make a fake dataset called "Data". Has 4 variable options and
the Ages each data point relates to.
Ages <- 1:750
Variable1 <- rnorm(n=750, sd = 2, mean = 0)
Variable2 <- rnorm(n=750, sd = 1, mean = 2)
Variable3 <- rnorm(n=750, sd = 8, mean = 6)
Variable4 <- rnorm(n=750, sd = 3, mean = 3)
Data <- as.data.frame(cbind(Ages, Variable1, Variable2, Variable3,
Variable4) )
### UI
ui <- fluidPage(
checkboxGroupInput(inputId = "columns",
label = h4("Which Variables would you like in your
model?"), # Input Checkbox
choices = c("Variable1", "Variable2", "Variable3",
"Variable4")),
plotOutput(outputId = "plot"),
# Lets have our plot
actionButton("base", "Create baseline"),
# Baseline action
actionButton("reset", "Reset baseline") # Reset Action
) # Close UI
server <- function(input, output) {
output$plot <- renderPlot({
validate(need(!is.null(input$columns), 'Please tick a box to show a
plot.')) # Place a please choose columns for null input
data <- gather(select(Data, "Ages", input$columns), variable, value, -
Ages) ## Just doing a little data manipulation to change from wide to
long form. This allows for calculations down the track and easier
plotting
# Now we can modify the data in some way, for example adding 1. Will
eventually add lots of model modifications here.
data$value <- data$value + 1
rVals <- reactiveValues() # Now we create the reactive
values object
rVals[['data']] <- data # Making a reactive values
function. Place Data as "data".
observeEvent(input$base,{
baseline <- data
baseline$variable <- paste("Baseline",
baseline$variable, sep = "_")
# Rename Variables to Baseline preamble
rVals[['baseline']] <- baseline
# Put the new data into the reactive object under "baseline"
})
observeEvent(input$reset,{ # Reset button will wipe the
data
rVals[['baseline']] <- NULL
})
if(!is.null(rVals[['baseline']])) # if a baseline has been .
created, then
{rVals[['final']] <- bind_rows(rVals[['data']], rVals[['baseline']])
# Here we can simply bind the two datasets together if Baseline exists
} else {rVals[['final']] <- rVals[['data']]}
# Otherwise we can use keep it as it is
## Make our Plot !
ggplot(rVals[['final']], aes(x=Ages, y = as.numeric(value), colour =
variable)) + # variable = each dataset selected, value = respective
values for that model
labs(x="Age", y="value") +
geom_line()
}) ## Close the render plot
} ## Close the server
shinyApp(ui, server)
You have observer inside reactive expression, i have seen this causing problems on number of occasions when i was correcting shiny code. Create reactive expression (your plot function) and observers only to specify which is the baseline value of species (character string) then feed this to filtering data inside the plot function:
library(shiny)
library(ggplot2)
ui <- fluidPage(
selectInput("rows", label = h3("Choose your species"),
choices = list("setosa", "versicolor", "virginica")
),
actionButton("base", "Create baseline"),
actionButton("reset", "Reset baseline"),
plotOutput(outputId = "plot")
) # close fluid page
server <- function(input, output) {
rVals = reactiveValues()
rVals[['data']] = iris
rVals[['baseline']] = NULL
output$plot <- renderPlot({
# here we duplicate table to manipulate it before rendering
# the reason for duplicate is that you dont want to affect your
# base data as it may be used elsewhere
# note that due to R's copy-on-write this may be expensive operation and
# have impact on app performance
# in all cases using data.table package is recommended to mitigate
# some of the CoW implications
render.data = rVals[['data']][rVals[['data']][['Species']] %in% c(rVals[['baseline']],input$rows),]
# here manipulate render.data
# and then continue with plot
ggplot(data=render.data,
aes(x=Petal.Width, y = as.numeric(Sepal.Width), colour = Species,group=Species)
) +
labs(x="Hypothetical X", y="Hypothetical X") +
geom_line()
})
observeEvent(input$base,{
rVals[['baseline']]=input$rows
})
observeEvent(input$reset,{
rVals[['baseline']]=NULL
})
}
shinyApp(ui, server)
I have a problem where I import a large data set, then generate some selection input from that data set, and then want to be able to have a plot where I can freely choose my x- and y-axis from the data set.
I keep crashing the browser, with my current code - I believe it has something todo with rCharts trying to generate the polychart, with variables not yet available - my custom input has to load first. I've tried both using reactive parts and isolating the output, and other stuff - either I am not doing it correctly, or its not the right way - either way it isn't working.
I am rather new to shiny, R and especially rCharts, but I got my graphs working with only one input - Problem arises when trying to make the multiple selectable.
I have the three following UIs that gives input to the renderCharts, which I show below:
output$TestSelection <- renderUI({
selectInput("TestSel", "Test Variable", ls(df, pattern = ".*?_meas|.*?_calc"))
})
output$customx <- renderUI({
selectInput("xcustom", "Custom Graph - X", ls(df), selected = input$TestSel)
})
output$customy <- renderUI({
selectInput("ycustom", "Custom Graph - Y", ls(df), selected = input$TestSel)
})
And the renderChart2 code:
output$customplot <- renderChart2({
if(is.null(input$xcustom)|is.null(input$ycustom))
return(rCharts$new())
#Removing all unneccessary data from dataframe,
dataPlot <- df[,c("DUT", input$ycustom, input$xcustom)]
custom_chart <- rPlot(x = input$xcustom,y = input$ycustom,
data = dataPlot,
type = "point",
tooltip = "#!function(item){return item.DUT}!#",
sample = FALSE)
#Adjusting width to fit the current screen
custom_chart$set(width = session$clientData$output_plot2_width , title = paste(input$ycustom, " vs. ", input$ycustom, sep =""))
#Setting the correct axis
axisincrease = abs((max(dataPlot[,input$xcustom])-min(dataPlot[,input$xcustom]))*0.05)
custom_chart$guides(
x = list(
min = pretty(dataPlot[,input$xcustom])[1]-axisincrease,
max = tail(pretty(dataPlot[,input$xcustom]),1)+axisincrease,
numticks = length(dataPlot[,input$xcustom])
),
y = list(
min = pretty( dataPlot[, input$ycustom] ) [1],
max = tail( pretty( dataPlot[, input$ycustom] ), 1 )
)
)
return(custom_chart)})