how to create plotly line chart in shinyapp with multiple level variable - r

Hi im trying to plot simple chart using plotly in the Shiny app. It is a line chart with Frequency variable on the X-Axis and a Metric on y-axis. i'm expecting two lines in the charts as i'm calling in a variable that has two levels in the UI. i'm getting the chart when i have one input from the groupcheckbox, but the goes blank when i select two options. i dont know what i'm doing wrong here, I'm not getting any error notifications.thanks for your inputs in advance
pasting the code with data here.
library(shiny)
library(plotly)
library(readxl)
prod<-c("BrandB", "BrandA", "BrandB", "BrandA", "BrandB", "BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA")
Freq<-c("W7","W7","W8","W8","W9","W9","W10","W10","W10","W10","W7","W7","W8","W8","W9","W9")
Metric1<-c(0.515,0.444,0.518,0.446,0.529,0.405,0.497,0.376,0.505,0.494,0.515,0.444,0.518,0.446,0.529,0.405)
Cut<-c("RBs","RBs","RBs","RBs","RBs","RBs","Total","Total","RBs","RBs","Total","Total","Total","Total","Total","Total")
DF<-data.frame(prod,Freq,Metric1,Cut)
str(DF)
DF$Brand<-as.factor(DF$prod)
DF$Wave<-factor(DF$Freq,levels=c("W7","W8","W9","W10"))
#View(DF)
ui <- fluidPage(
# useShinydashboard(),
titlePanel("Dassy"),
fluidRow(
column(3,
checkboxGroupInput(inputId = "Prod",
label = "Choose Fill For the Chart",
choices = c("BrandA" = "BrandA","BrandB" = "BrandB"),
selected = "BrandA"
)),
column(3,
selectInput(inputId = "Cut",
label = "Choose Fill For the Chart",
choices = c("Total" = "Total","RBs" = "RBs"),
selected = "Total")
),actionButton("go_button", "GO !")
),
mainPanel(
plotlyOutput("distPlot"))
)
server <- function(input, output) {
observeEvent(input$go_button,{
output$distPlot <- renderPlotly({
DF1 <- reactive({
DF%>%filter(Cut == input$Cut & prod == input$Prod)
}
)
p1<-plot_ly(DF1(),x=~Freq, y=~Metric1, color = ~prod, width=1200, height=300)%>% add_lines(line = list(shape = "spline"))
p1<-p1%>%layout(yaxis=list(tickformat ="%"))
})
#observe Event
})
}
#??plot_ly()
shinyApp(ui = ui, server = server)
With single option selected line graph generated
With two option selected blank chart gets generated

Related

I've added a date range slider to my plotly scatterplot in shiny, but how do I get the data to change according to the widget?

I am trying to have the selectinput widget "Years - Slide" change the data used by the graph to the specific date range shown. I was able to connect the axis options in the ui code to the server code since the graph changes, but I do not know how to do the same to the date range widget.
I am trying to use a selectInput widget instead of a date input widget since I only have the year to work with.
Would anyone know how to resolve this?
I was expecting to see the graph according to the changes in the widget, but that is not working.
functional code without selectinput in the server code
library(gapminder)
gm <- gapminder
library(shiny)
library(plotly)
library(tibble)
library(tidyverse)
library(tidyr)
library(readr)
library(dplyr)
library(ggplot2)
# set working directory
setwd("~/BDSWD")
# Define UI ----
ui <- fluidPage(
column(3,offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel('Graphs'),
mainPanel(
plotlyOutput('plot')
),
sidebarPanel(
#variable selection for x-axis
selectInput(inputId ='xvrbl', #The input slot that will be used to access the value.
label = 'X-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'lifeExp'
),
#variable selection for y-axis
selectInput(inputId ='yvrbl', #The input slot that will be used to access the value.
label = 'Y-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'gdpPercap'
),
#date range - slider
sliderInput(inputId = "time",
label = "Years - Slide",
min = min(gm$year),
max = max(gm$year),
step = 5,
value = c(min(gm$year),max(gm$year))),
)
)
server <- function(input, output) {
x <- reactive({
pull(gm[,input$xvrbl])
})
y <- reactive({
pull(gm[,input$yvrbl]) #pull used to turn tibble into vctr bc plotly only takes vctrs
})
output$plot <- renderPlotly(
plot1 <- plot_ly(
x = x(),
y = y(),
type = 'scatter',
mode = 'markers',
color = gm$continent,
data <- subset(gm,
continent %in% input$continents &
year >= input$years[1] & year <= input$years[2])
)
)
}
# Run the app
shinyApp(ui = ui, server = server)
code with my attempt to connect selectInput to the server code (not working)
Unfortunately you code was not working. As first step I added a reactive to create the filtered dataset based on the user input. Second step was to add the selectInput to select the year to be plotted.
library(gapminder)
library(shiny)
library(plotly)
library(tidyverse)
gm <- gapminder
# Define UI ----
ui <- fluidPage(
column(3, offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel("Graphs"),
mainPanel(
plotlyOutput("plot")
),
sidebarPanel(
# variable selection for x-axis
selectInput(
inputId = "xvrbl", # The input slot that will be used to access the value.
label = "X-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "lifeExp"
),
# variable selection for y-axis
selectInput(
inputId = "yvrbl", # The input slot that will be used to access the value.
label = "Y-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "gdpPercap"
),
# date range - slider
selectInput(
inputId = "time",
label = "Years - Slide",
choices = unique(gm$year),
selected = max(gm$year)
)
)
)
server <- function(input, output) {
x <- reactive({
dat()[[input$xvrbl]]
})
y <- reactive({
dat()[[input$yvrbl]]
})
dat <- reactive({
subset(gm, year %in% input$time)
})
output$plot <- renderPlotly({
plot_ly(
x = x(),
y = y(),
type = "scatter",
mode = "markers",
color = dat()$continent
)
})
}
# Run the app
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:5182

How to grey out traces not selected in a parallel coordinate plot using the ‘parcoords’ package in R Shiny?

I am using the R library ‘parcoords’ to create an interactive parallel coordinates plot. By default, when no selection along any axis is made, the plot shows all traces. When some range is selected across an axis only the traces within the selection window are visible and all other traces disappear. I was wondering if there is a way for the other traces to be just greyed out but still visible on the plot similarly to the parallel coordinate plot using the plotly package?
Thank you!
library(shiny)
library(parcoords)
library(d3r)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
),
mainPanel(
parcoordsOutput("par_plot")
)
)
)
server <- function(input, output) {
output$par_plot<- renderParcoords({
data(mtcars)
parcoords(mtcars, rownames = TRUE, brushMode = "1d-axes-multy", reorderable = FALSE,
color = list(
colorBy = "mpg",
colorScale = "scaleOrdinal",
colorScheme = "schemeCategory10"
),
withD3 = TRUE)
})
}
shinyApp(ui = ui, server = server)
I have managed to figure out something very similar which also works for me i.e. instead of grey out the traces that are not selected, make them more transparent so that they don't stand out compared to the selected ones. This is achieved by using the parcoords parameter 'alphaOnBrushed'. I set it to 0.15 and the plot looks exactly the way I want it in terms of emphasising the brushed traces.
library(shiny)
library(parcoords)
library(d3r)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
),
mainPanel(
parcoordsOutput("par_plot")
)
)
)
server <- function(input, output) {
output$par_plot<- renderParcoords({
data(mtcars)
parcoords(mtcars, rownames = TRUE, brushMode = "1d-axes-multy", reorderable = FALSE,
alphaOnBrushed = 0.15,
color = list(
colorBy = "mpg",
colorScale = "scaleOrdinal",
colorScheme = "schemeCategory10"
),
withD3 = TRUE)
})
}
shinyApp(ui = ui, server = server)

Choosefile widget: "Error in FUN: object 'Type' not found"

I am building a shiny app that would allow me to select a data file using a widget "choose file" and "select file" as well as plotting a bar graph using geom_bar object of the library ggplot2. The plot consists of a bar graph representing the revenue ("Revenue") per type of operation ("Type") and has a different colour of the bar for each type.
When I run the app I get the following error : Error in FUN: object 'Type' not found.
I have changed aes by aes_string but it doesn't change anything. I have also tried to add inherit.aes = FALSE in the geom_bar object. I made sure the data I use is saved as data frame.
library(shiny)
library(ggplot2)
library(dplyr)
#user interface
ui <- fluidPage(
headerPanel(title = "Shiny File Upload"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = "file",
label = "Upload the file",
multiple = TRUE),
checkboxInput(inputId = "header", label = "Header"),
radioButtons("sep","Seperator", choices = c(Comma=",", Period = ".", Semicolon = ";")),
# Select variable for y-axis
selectInput(inputId = "y",
label = "Revenue:",
choices = "Revenue",
selected = ""),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = "Type",
selected = ""),
# Select variable for color
selectInput(inputId = "z",
label = "Color by:",
choices = "Type",
selected = "")
),
# Outputs
mainPanel(
uiOutput("input_file"),
plotOutput(outputId = "Barplot")
)
)
)
# Define server function required to create the scatterplot
server <- function(input, output) {
#Dispays the content of the input$file dataframe
output$filedf <- renderTable({
if(is.null(input$file)){return()}
input$file
})
output$filedf2 <- renderTable({
if(is.null(input$file)){return()}
input$file$datapath
})
#Side bar select input widget coming through render UI()
output$selectfile <- renderUI({
if(is.null(input$file)){return()}
list(hr(),
helpText("Select the files for which you need to see data and summary stats"),
selectInput("Select", "Select", choices=input$file$name)
)
})
# Create the scatterplot object the plotOutput function is expecting
output$Barplot <- renderPlot({
ggplot(data = input$file, aes_string(x = input$x , y = input$y, fill = input$x)) + geom_bar( stat ="identity") + coord_flip()
})
}
shinyApp(ui = ui, server = server)
I expect to have a bar plot with revenues bar for the 14 type of operation, with bar color differing depending on the observation.
I expect to be able to select the data I want and get this bar plot for this dataset.

How to render a line plot that changes based on my inputs and shows a color line for each line

I created this shiny app and now I would like to add a line plot to the app.
The data is in a .csv file
I am able to generate data in a table format and I want to include a line plot that is reactive to my inputs.
shelter <- read.csv("shelter.csv",stringsAsFactors=FALSE)
Shelter,Year,Cat,Dog,Rabbit,Other
Pitt,2013,31,22,19,23
Pitt,2014,23,54,65,15
Pitt,2015,56,62,28,24
Pitt,2016,65,23,33,32
Pitt,2017,49,74,36,18
Phila,2013,11,32,26,35
Phila,2014,66,65,145,27
Phila,2015,69,64,121,18
Phila,2016,84,81,195,9
Phila,2017,79,35,96,7
Allen,2013,161,36,26,11
Allen,2014,24,97,84,21
Allen,2015,101,74,24,19
Allen,2016,254,74,112,3
Allen,2017,95,63,247,22
Harris,2013,78,60,168,17
Harris,2014,29,85,39,16
Harris,2015,201,75,245,7
Harris,2016,27,55,88,9
Harris,2017,65,46,71,11
Read,2013,94,95,68,20
Read,2014,98,91,94,19
Read,2015,125,73,203,21
Read,2016,87,101,119,5
Read,2017,148,98,149,6
York,2013,56,73,65,14
York,2014,61,74,95,7
York,2015,99,89,84,2
York,2016,121,120,84,11
York,2017,67,68,85,2
#Code:
library(shiny)
ui <- fluidPage(
titlePanel('Animal Shelter Data:'),
sidebarLayout(
sidebarPanel(
selectInput("Shelter", label = h4("Select a Shelter:"),choices =shelter$Shelter),
checkboxGroupInput("Category", label = h4("Category"),
choices = list("Cat" , "Dog" , "Rabbit", "Other"),
selected = list("Cat" , "Dog" , "Rabbit", "Other")),
checkboxGroupInput("Year", label = h4("Select Year(s)"),
choices = unique(shelter$Year),
selected = list('2013', '2014', '2015', '2016','2017'))
),
mainPanel(
tableOutput("shelterdata"),
plotOutput("lineplot")
)
)
)
server <- function(input, output) {
output$shelterdata <- renderTable({
shelterfilter <- subset(shelter[shelter$Shelter == input$Shelter & shelter$Year %in% input$Year,])
shelterfilter[c('Shelter', 'Year', input$Category)]
})
}
shinyApp(ui = ui, server = server)
I would like to render a line plot that changes based on my input$Shelter, input$Category, input$Year and shows a color line for each animal:
x-axis = Year
y-axis = number of animals
This answer requires the tidyr, magrittr and ggplot2 packages. This code can be placed inside the server function.
output$lineplot <- shiny::renderPlot({
shelterfilter <- subset(shelter[shelter$Shelter == input$Shelter & shelter$Year %in% input$Year,]) %>%
tidyr::gather(key = "Animal",value = "Animal.Qty",-Shelter,-Year)
ggplot(data = shelterfilter,aes(x = Year,y=Animal.Qty,color=Animal)) +
geom_line()
})

Dynamic filters and reactive plot in Shiny

Issues between inputs and plot output
Hi,
I'm testing out a basic ShinyApp where I can generate a plot of commercial services broken down by geography and service type.
The idea is I want the user to use three drop-down menu inputs, each dependent upon the previous selection, to subset the data, which then gets output in a ggplot.
However, I'm having issues connecting the inputs to the plot output (see below). The inputs are working fine and reactive when selected, but I can't work out how to link that to the plot, I get the feeling I'm not using the right data source (but have no idea how to ensure it is). Furthermore, I'm not familiar with how I would go about adding a third filter (for "service") seeing as I don't know how to link my data source in the first place.
Sorry this is probably simple, but some help would be really appreciated.
UI
#Data
Test <- dataframe(
Geography1 = c("Region","Local Authority","County"...),
Geography2 = c("North West","Aldershot","Cheshire"...),
Service = c("Shop","Cafe","Library"...),
Overall_rating = c("Awesome","Good","Fantatstic"...),
Locations = c(4000, 1300, 1700...)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
Server
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
output$geography2 = renderUI({
datasub <- Test[Test$Geography1 == input$geog1, "Name"]
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub),
selected = unique(datasub)[1])
})
output$service = renderUI({
datasub2 <- unique(datasub)
selectInput(inputId = "service",
label = "Service type:",
choices = unique(...),
selected = unique(...)[1])
})
output$plot = renderPlot({
ggplot(datasub2(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
It's hard to tell how the provided data is supposed to be filtered in the app but this code will at least run and be interactive. Hopefully from there you can figure out how to adjust the dataset.
As BigDataScientist said one fault is that you're not using a reactive dataset.
#Data
Test <- data.frame(
Geography1 = c("Region","Local Authority","County"),
Geography2 = c("North West","Aldershot","Cheshire"),
Service = c("Shop","Cafe","Library"),
Overall_rating = c("Awesome","Good","Fantatstic"),
Locations = c(4000, 1300, 1700)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
datasub <- reactive({
Test[Test$Geography1 == input$geog1,]
})
output$geography2 = renderUI({
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub()[,"Geography2"]),
selected = unique(datasub()[,"Geography2"])[1])
})
datasub2 <- reactive({
datasub()[Test$Geography2 == input$geog2, ]
})
output$service = renderUI({
selectInput(inputId = "service",
label = "Service type:",
choices = unique(datasub2()[,"Service"]),
selected = unique(datasub2()[,"Service"])[1])
})
datasub3 <- reactive({
datasub()[Test$Service == input$service, ]
})
output$plot = renderPlot({
ggplot(datasub3(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)

Resources