Shiny and rCharts/Polycharts with both X- and Y-axis choice input - r

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)})

Related

Plotly working when using ggplot() but not when using plot_ly() on shiny server

I am having an issue with using Plotly on my shiny server. I have a clustering app where I bring in a data file and you are able to perform two variable and three variable clustering. The first tab is the two variable clustering. I use ggplot() to create the plot and then using Plotly's ggplotly() function to make it a plotly object to enable interactivity. This renders fine on the app's page.
The issue here is when plotting the three variable clustering. Instead of ggplot() and then ggploty(), I use Plotly's function plot_ly(). This allows me to pass an x, y, and z variable. It works like a charm on my local machine, but when on the shiny server I get this error Error: An error has occurred. Check your logs or contact the app author for clarification. I open my logs and do a hard refresh of the app, no logs are showing. My package versions are the same for both my shiny server and my local machine. The error is not every telling here and I have tried to google around but I am getting no where.
Here is the code:
server.R
## Needed Lib's
library(shiny)
library(ggplot2)
library(plotly)
library(DT)
library(cluster)
## Initiate the severer
shinyServer(
function(input, output, session) {
## Display the text that describes why to use this app/method for grouping
output$text <- renderText({
## Let the user know which tab they have selected
{paste0("You are viewing the \"", input$ClusterChoice, "\"")}
})
## Display the text that describes why to use this app/method for grouping
output$why_text <- renderText({
## Let the user know which tab they have selected
"This is why"
})
# Variable #1
output$varselect1 <- renderUI({
selectInput("var1", label = "Select first variable for clustering:",
choices = names(dataset()), selected = names(dataset())[1])
})
# Variable #2
output$varselect2 <- renderUI({
selectInput("var2", label = "Select second variable for clustering:",
choices = names(dataset()), selected = names(dataset())[2])
})
## Clustering with third variable
# Variable #1
output$varselect3 <- renderUI({
selectInput("var3", label = "Select third variable for clustering (only works in Multiple Variable Tiering Tab):",
choices = names(dataset()), selected = names(dataset())[3])
})
## Read in the data
dataset <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(NULL)
}
else {read.csv(infile$datapath)}
})
## Compute the K means algo
compute_kmeans <- reactive({
# Choose between simple K means or a more complex K means with third variable
if (input$ClusterChoice == 'Two Variable Tiering') {
data <- subset(dataset(), select = c(input$var1, input$var2))
# Scale the data. Using "standardized" here. This will center and then scale the data
#data <- scale(data, center = TRUE)
# Change some columns names
colnames(data) <- c('x', 'y')
data <- na.omit(data)
# Set the seed
set.seed(111)
# Cluster
Kclust <- kmeans(data, input$k)
# Save results to a list
kmean.result <- list(kmean.result = data.frame(data, cluster = as.factor(Kclust$cluster)))
return(kmean.result)
}
# K means with third variable
else { (input$ClusterChoice == 'Multiple Variable Tiering')
three_var_data <- subset(dataset(), select = c(input$var1, input$var2, input$var3))
# Scale the data. Using "standardized" here. This will center and then scale the data
#three_var_data <- scale(three_var_data, center = TRUE)
three_var_data <- na.omit(three_var_data)
# Set the seed
set.seed(111)
# Cluster
Kclust <- kmeans(three_var_data, input$k)
kmean.result <- list(kmean.result = data.frame(three_var_data, cluster = as.factor(Kclust$cluster)))
return(kmean.result)
}
})
## Create a dataframe of the K means & K means with third variable results
kmeans_results <- reactive({
# For only two variables
if (input$ClusterChoice == 'Two Variable Tiering') {
# Call the method that computes the k means
data <- compute_kmeans()
# Save the results into a df
results <- data$kmean.result
results_df <- data.frame(results)
colnames(results_df) <- c(input$var1, input$var2, 'Grouping')
return(results_df)
}
# For more than two variables
else { (input$ClusterChoice == 'Multiple Variable Tiering')
# Call the method that computes the k means with third variable
three_var_data <- compute_kmeans()
# Save the results into a df
three_var_results <- three_var_data$kmean.result
three_var_results_df <- data.frame(three_var_results)
colnames(three_var_results_df) <- c(input$var1,
input$var2,
input$var3,
'Grouping')
return(three_var_results_df)
}
})
## Results of each K means & K means with third variable
master_results <- reactive({
# Call the method that stores the raw input data
data <- dataset()
# For only two variables
if(input$ClusterChoice == 'Two Variable Tiering') {
# Call the method that stores the K means results
kmean_results <- kmeans_results()
# Merge the K means results with the raw input data
results <- merge(kmean_results, data)
results <- results[!duplicated(results), ]
return(results)
}
# For more than two variables
else { (input$ClusterChoice == 'Multiple Variable Tiering')
# Call the method that stores the K means with third variable results
kmean_three_var_results <- kmeans_results()
# Merge the K means with third variable results with the raw input data
three_var_resutls <- merge(kmean_three_var_results, data)
three_var_resutls <- three_var_resutls[!duplicated(three_var_resutls), ]
return(three_var_resutls)
}
})
## Plot the K means results
output$plot <- renderPlotly({
graphics.off()
pdf(NULL)
# For only two variables
if (input$ClusterChoice == 'Two Variable Tiering') {
# Call the K means results method
results <- master_results()
# Change the x & y variables so we can call it in the tool-tip
x_axis <- results[[input$var1]]
y_axis <- results[[input$var2]]
# Plot
plot <- ggplot(data = results,
aes(x = x_axis,
y = y_axis,
color = Grouping,
name = Markets)) +
geom_point(size = 2) +
ggtitle("Grouping Results") +
labs(x = input$var1, y = input$var2)
# Use Plotly for interactivity
plotly_plot <- ggplotly(plot)
return(plotly_plot)
}
# For more than two variables
else if (input$ClusterChoice == 'Multiple Variable Tiering')
# Call the K means and third variable
three_var_resutls <- master_results()
# Change x, y, & z variables so we can call it in the tool-tip
x_axis <- three_var_resutls[[input$var1]]
y_axis <- three_var_resutls[[input$var2]]
z_axis <- three_var_resutls[[input$var3]]
# Plot (using Plotly for interactivity)
three_var_plot <- plot_ly(three_var_resutls,
x = x_axis,
y = y_axis,
z = z_axis,
color = factor(three_var_resutls$Grouping),
text = ~paste('Markets:', three_var_resutls$Markets,
'<br>Grouping:', three_var_resutls$Grouping)) %>%
add_markers() %>%
layout(title = 'Grouping Results',
scene = list(xaxis = list(title = input$var1),
yaxis = list(title = input$var2),
zaxis = list(title = input$var3)))
return(three_var_plot)
})
## Render the K means and K means with third variable results to a data table
output$cluster_table <- DT::renderDataTable({
# For only two variables
if (input$ClusterChoice == 'Two Variable Tiering') {
# Call results method
results <- master_results()
# Render data table
datatable(results,
# Get rid of row indexes
rownames = FALSE,
# Enable downloading options
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv", "excel", "pdf"),
text = "Download")),
lengthMenu = list(c(10, 20, -1),
c(10, 20, "All")),
pageLength = 10))
}
else if (input$ClusterChoice == 'Multiple Variable Tiering') {
# Call results method
results_three_var <- master_results()
# Render data table
datatable(results_three_var,
# Get rid of row indexes
rownames = FALSE,
# Enable downloading options
extensions = 'Buttons',
options = list(
dom = "Blfrtip",
buttons =
list("copy", list(
extend = "collection",
buttons = c("csv", "excel", "pdf"),
text = "Download")),
lengthMenu = list(c(10, 20, -1),
c(10, 20, "All")),
pageLength = 10))
}
})
}
)
ui.r
## Needed Lib's
library(shiny)
library(plotly)
## Start the UI renderer
shinyUI(
pageWithSidebar(
## The TITLE!
headerPanel("Grouping Data Together"),
## This is where the up-loader and drop downs live
sidebarPanel(
fileInput('datafile',
'Choose CSV file',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
uiOutput("varselect1"),
uiOutput("varselect2"),
uiOutput("varselect3"),
numericInput('k', 'Number of clusters', value = 3, min = 1, step = 1)),
## The main panel where all the shit happens
mainPanel(
textOutput("text"),
tabsetPanel(id = 'ClusterChoice',
tabPanel("Two Variable Tiering", value = 'Two Variable Tiering'),
tabPanel("Multiple Variable Tiering", value = 'Multiple Variable Tiering'),
tabPanel("Why Do It This Way?", value = "Why Do It This Way?")
),
## Description of this app
h2("Description"),
p("This tool's main functionality is to quickly put your data into groups. The file that is being uploaded
should only be the data that you want to group together. For example, if you have data that is broken out
by Markets (DMA) and you want to group those Markets into similar groupings you should upload all data
that you think is important to those groupings. Then via the drop downs you can select the 2 or 3 variables
you think best represents the groupings."),
## The tabs
h2("The Different Tabs"),
p("Tab #1: This tab is only when you want to use 2 variables in your data to create the groupings."),
p("Tab #2: This tab is only when you want to use 3 variables in your data to create the groupings."),
## Instructions for using this app
h2("Instructions"),
p("Please follow these instructions to create your groupings."),
p("1. Upload a data file (.csv) that will be used for making your groups.
The first row in the .csv file should be the column headers of the data.
The first column in the .csv file should be where your data starts.
THERE SHOULD BE NO 'BUFFERS' AROUND YOUR DATA FILE, i.e. empty rows and columns."),
p("2. Pick the variables you want to create the groupings off of via the drop-downs"),
p("3. Indicate the desired number of groups via the last drop-down."),
## The plot instructions
h2("Visualizing Your Grouped Data"),
p("You can download the plot as a .png file by hovering over the plot and selecting the
camera icon in the upper right hand side of the plot."),
# Plotly function that links the UI to the Server
plotlyOutput('plot', height = 700),
## The grouping data table instructions
h2("The Groupings"),
p("Instructions for downloading data:"),
p("1. To download the data use the drop-down below, labeled 'Show entries', to show 'All' entries."),
p("2. Click the 'Download' button and then select the type of file (PDF, excel, csv)."),
p("3. (Optional) You can copy the data that is shown to your clipboard is paste it into an excel/csv document."),
# JS DataTable function that links the UI to the Server
DT::dataTableOutput("cluster_table"))
)
)

Disable No data to display message

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 use the NULL Value as a variable call in R Shiny

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)
})

Plot the Plotly Graph Dynamically in the Shiny App in R

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:

How do I create a reactive plot using ggplot in Shiny application

I have spent several hours trying to figure out how to generate a bar plot using ggplot2 for a shiny app I want to create. The ui works fine, however; the server function generates an empty plot.
The issue is with renderPlot function. I believe I must not be passing the reactive values properly to the aes_string arguments in ggplot.
C2 is a filtered dataset. The goal is to build a simple app in which the user selects a two variables, a dataset is filtered based upon those variables. The subsetted dataset is passed to ggplot data argument.
library(shiny)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "Demog",label = "Factor:",choices = c("HH Income" = "Income",
"Age Group" = "Age",
"US Region" = "Region") , selected = "Age"),
selectInput(inputId = "Car",label = "VW Model:",choices = c("BEETLE" = "BEETLE",
"CC" = "CC",
"EOS" = "EOS",
"GOLF" = "GOLF",
"GTI" ="GOLF SPORTSWAGEN GTI",
"JETTA" = "JETTA",
"PASSAT" = "PASSAT",
"TIGUAN" = "TIGUAN",
"TOUAREG" = "TOUAREG") , selected = "BEETLE"),
radioButtons(inputId = "Metric",label ="Measurement Type",choices =
c("Conquest Volume Index" = "TotCmpConqVol_IDX","C/D Ratio" = "TotCmpCDRatio_IDX"), selected = "TotCmpConqVol_IDX" )
)
),
mainPanel(
tags$h1("The Bar Charts"),
tags$h2("The metrics"),
plotOutput("P1")
)
)
server <- function(input, output){
library(ggplot2)
CONQDF <- read.csv("C:/Users/Reginald/Desktop/CONQ_VW/CONQUEST2.csv")
C2 <- reactive(subset(CONQDF,input$Demog %in% levels(input$Demog)[1] & CONQDF$VW_Model == input$Car))
output$P1 <- renderPlot({
ggplot(C2(),aes_string(x="CompMake", y=input$Metric))+ geom_bar(stat = "identity")
})
}
shinyApp(ui,server)
The ui works fine, however; the server function generates an empty
plot.
This is most likely due to the fact that the function subset returns an empty dataset. In order to debug the code, first, I would print out in the console this part:
C2 <- reactive(subset(CONQDF,input$Demog %in% levels(input$Demog)[1] & CONQDF$VW_Model == input$Car))
I believe that this part is wrong because input$Demog is just a character string and not a factor. That's why levels(input$Demog) = NULL and input$Demog %in% levels(input$Demog) = FALSE. Hence, as a result, you get an empty dataset.
To check this:
output$P1 <- renderPlot({
print(C2()) # print it out to the console.
ggplot(C2(),aes_string(x="CompMake", y=input$Metric))+ geom_bar(stat = "identity")
})
If this is the case, you only need to re-think subsetting part.
It looks like your C2 function can't see CONQDF (hence the blank plot). You can add () after CONQDF in your C2 call to run that read.csv every time, but you're probably better off moving the read.csv outside your server function altogether.
So move this line
CONQDF <- read.csv("C:/Users/Reginald/Desktop/CONQ_VW/CONQUEST2.csv")
to the top of your script, just below library(dplyr). This will make shiny read that file when the page first loads, instead of every time the input is updated, and will also place the resulting dataframe into the global environment, which will mean your C2 <- call will be able to see it.
I can't easily reproduce your app, so I can't test my answer. Please let me know whether or not it helps.

Resources