R Shiny selectInput reactivity with multiple variable output - r

I'm seeking assistance with my shiny dashboard issue.
Essentially, I have a single selectInput menu, however want to be able to select multiple variables and have them all plotted on the same graph.
At the moment I can get it to plot a single selected variable on the plot.ly graph, however even when I select multiple variables, it will still only plot the first variable selected:
current single variable output
Additionally, when the app is first run, I get this error until I manually select a variable:
error received when first displayed
This is a simplified version of the code I'm working with so far:
global_indices <- read_excel("Market_Data.xlsx",
sheet = 4,
col_names = FALSE,
skip = 5)
global_indices_clean <- global_indicies[,c(1,3,7,9,13,21,23)]
colnames(global_indices_clean) <- c("Date", "Australia", "US", "UK", "Germany", "Japan", "Hong_Kong")
global_indices_2y2 <- global_indices_clean %>% filter(between(Date, now() - years(2), now()))
header <- dashboardHeader(
title = "Dashboard"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Global Indices",
tabName = "global_indices")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "global_indices",
fluidRow(
box(plotlyOutput("plot_3"), title = "Developed indices", status = "primary", width = 4, ""),
box(plotlyOutput(""), title = "", status = "primary", width = 4, ""),
box(plotlyOutput(""), title = "", status = "primary", width = 4, "")
),
fluidRow(
box(selectInput("global_indices_input", "Indices",
choices =
list("Australia" = "Australia",
"US" = "US",
"UK" = "UK",
"Germany" = "Germany",
"Japan" = "Japan",
"Hong Kong" = "Hong_Kong"),
multiple = TRUE),
width = 4)
)
)
)
)
ui <- dashboardPage(
header,
sidebar,
body
)
server <- function(input, output) {
output$plot_3 <- renderPlotly({
plot_3 <- plot_ly(
global_indices_2y2, x = global_indices_2y2$Date, y = ~get(input$global_indices_input), type="scatter", mode="lines"
)
})
}
shinyApp(ui, server)
I can't provide the dataset itself, however below is a small section of it:
> str(global_indices_2y2)
'data.frame': 478 obs. of 7 variables:
$ Date : POSIXct, format: "2018-01-29" "2018-01-30" "2018-01-31" "2018-02-01" ...
$ Australia: num 107 106 106 107 108 ...
$ US : num 113 112 112 112 110 ...
$ UK : num 104 103 102 102 101 ...
$ Germany : num 103.9 102.9 102.8 101.4 99.7 ...
$ Japan : num 116 114 113 115 114 ...
$ Hong_Kong: num 120 118 119 118 118 ...
I've read through dozens of threads on here over the last few days, however they all seem to focus on issues around multiple selectInput parameters, instead of a single selectInput requiring the ability to select and display multiple outputs.
Any help that you are able to provide would be greatly appreciated!

One approach would be to create a separate reactive to filter your data, and use the filtered data in your plot. First, I would consider converting your data to long format (e.g., using tidyverse pivot_longer). For example:
global_indices_2y2 <- data.frame(
Date = as.POSIXct(c("2018-01-29", "2018-01-30", "2018-01-31", "2018-02-01")),
Australia = c(107, 106, 106, 107),
US = c(113,112,112,112),
UK = c(104,103,102,102)
) %>%
pivot_longer(cols = -Date, names_to = "country", values_to = "index")
Then add reactive to filter based on multiple selections in your server:
mydata <- reactive({
global_indices_2y2 %>%
filter(country %in% input$global_indices_input)
})
Then plot filtered data:
output$plot_3 <- renderPlotly({
plot_3 <- plot_ly(
mydata(),
x = ~Date,
y = ~index,
name = ~country,
type="scatter",
mode="lines"
)
})

Related

How do I make an interactive radar chart in r shiny?

I'm pretty new to r and shiny and I am currently working on my first personal project. My project is about Pokemon and I am currently having trouble creating an interactive radar chart. I have tried looking at other questions about on this website about r and radar charts but couldn't really find the right answer since the dataset was usually in a different format, and the answers didn't provide a way to do it interactively.
What I'm trying to achieve: Create an interactive radar chart where the user can select a Pokemon and the radar chart will display that Pokemon's base stats (hp, attack, defense, etc.)
dataset:
name hp defense attack sp_attack sp_defense speed
1 Bulbasaur 45 49 49 65 65 45
2 Ivysaur 60 63 62 80 80 60
3 Venusaur 80 123 100 122 120 80
4 Charmander 39 43 52 60 50 65
5 Charmeleon 58 58 64 80 65 80
6 Charizard 78 78 104 159 115 100
...
ui.R:
library(shiny)
library(plotly)
ui <- navbarPage(title = "Pokemon Research",
tabPanel(title = "Types and Stats",
sidebarPanel(
selectInput(inputId = "diff_stat",
label = "Different Types and their Base Statistics",
choices = c("hp", "attack", "defense", "special_attack",
"special_defense", "speed", "total"))
),
mainPanel(plotlyOutput("type"))),
tabPanel(title = "Pokemon Statistics",
sidebarPanel(
selectInput(inputId = "indv",
label = "Pokemon",
choices = data$name
),
#IDK WHAT TO PUT HERE FOR THE MAINPANEL
)))
server.R:
library("shiny")
library("ggplot2")
data <- read.csv("../data/pokemon.csv", stringsAsFactors = FALSE)
type_data <- data %>%
select(name, type1, hp, defense, attack, sp_attack, sp_defense, speed) %>%
group_by(type1) %>%
summarise(hp = mean(hp),
attack = mean(attack),
defense = mean(defense),
special_attack = mean(sp_attack),
special_defense = mean(sp_defense),
speed = mean(speed),
total = mean(attack + defense + hp + sp_attack + sp_defense + speed))
indv_data <- data %>%
select(name, hp, defense, attack, sp_attack, sp_defense, speed)
server <- function(input, output) {
output$type <- renderPlotly({
ggplot(data = type_data, mapping = aes_string(x = "type1", y = input$diff_stat)) +
geom_line(group = 1) +
geom_point() +
labs(x = "Types",
y = "Base Stat (avg)")
})
output$radar <- renderPlot({
#WHAT DO I PUT HERE TO MAKE THE RADAR CHART
})
}
Any help is greatly appreciated!
This can help. I only included the code for the radar chart.
library(tidyverse)
library(shiny)
library(plotly)
pokemons <-
read_table('
name hp defense attack sp_attack sp_defense speed
Bulbasaur 45 49 49 65 65 45
Ivysaur 60 63 62 80 80 60
Venusaur 80 123 100 122 120 80
Charmander 39 43 52 60 50 65
Charmeleon 58 58 64 80 65 80
Charizard 78 78 104 159 115 100')
ui <- navbarPage(title = "Pokemon Research",
tabPanel(title = "Pokemon Statistics",
sidebarPanel(
selectInput(inputId = "indv",
label = "Pokemon",
choices = pokemons$name,
selected = 'Bulbasaur')
),
mainPanel(
plotlyOutput('radar') #the radar plot
)
))
server <- function(input, output, session) {
output$radar <- renderPlotly({
pkmn <- filter(pokemons, name == input$indv)
r <- map_dbl(pkmn[, 2:6], ~.x)
nms <- names(r)
#code to plot the radar
fig <- plot_ly(
type = 'scatterpolar',
r = r,
theta = nms,
fill = 'toself',
mode = 'markers'
)
fig <- fig %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,max(r))
)
),
showlegend = F
)
})
}
shinyApp(ui, server)

Update deckgl map in R shiny when clicked on bar

Trying to make a shiny app with these properties.
Default view is aggregate layer. There will be number of columns/bars. On click of a column, the view is updated to show the non-aggregated version of data.
It is something like to know which bar is getting clicked and filtering the data with respect to it.
I have written the below code, which does the aggregate layer. However not sure how to get the "clicked_on_this_bar" details. Here if we get, user clicked on bar of "Area A", then we can just filter orig_df with area A and update the view. How to proceed in this ?
rm( list = ls() )
library( shiny ) ; library( shinydashboard ) ; library( dplyr ) ; library( deckgl )
ui <- basicPage( deckglOutput( 'map', height = '800px' ) )
server <- function(input, output) {
aggregate_df = data.frame( 'area' = LETTERS[1:2], 'count' = 110:111, median_lon = c( 3.39, 3.41 ),
median_lat = c( 49.7, 49.4 ), color = c("#0080FF", "#FF0080") )
orig_df = data.frame( 'area' = rep( c( 'A', 'B' ), c( 3, 2 ) ), count = 10:14, lon = c( 3.45, 3.39, 3.19, 3.41, 3.92 ),
lat = c( 48, 49.7, 52, 49.4, 51.5 ), color = c("#0080FF", "#FF0080", "#FF3030", "#00EE00", '#FF7F24') )
output$map = renderDeckgl({
deckgl( zoom = 7, pitch = 35, latitude = 48.29507, longitude = 4.0731520 ) %>%
add_column_layer(
data = aggregate_df,
getPosition = ~median_lon + median_lat,
getElevation = ~count,
getFillColor = ~color,
getTooltip = "Area: {{area}}, Count: {{count}}",
elevationScale = 100
) %>% add_basemap()
})
# observeEvent({
#
# deckgl_proxy( 'map' ) %>%
#
# add_column_layer(
# data = orig_df %>% filter( area == click[['A']] ),
# getPosition = ~lon + lat,
# getElevation = ~count,
# getFillColor = ~color,
# getTooltip = "Area: {{area}}, Count: {{count}}",
# elevationScale = 50
# ) %>% update_deckgl(it = "works")
#
# })
}
shinyApp(ui, server)
You were almost there. What you have to do, is to listen to the input$map_onclick reactive, which, beside other infos, returns an object slot with the relevant info. This object is generated as soon as you click on any of your bars and here's the structure of the reactive:
List of 1
$ map_onclick:List of 3
..$ lng : num 3.4
..$ lat : num 49.4
..$ object:List of 5
.. ..$ area : chr "B"
.. ..$ count : int 111
.. ..$ median_lon: num 3.41
.. ..$ median_lat: num 49.4
.. ..$ color : chr "#FF0080"
With this piece of information it is rather straight forward to adapt your code (I never worked with deckgl though, so I simply used your commented code - adapt if needed)
observeEvent(input$map_onclick, {
deckgl_proxy( 'map' ) %>%
add_column_layer(
data = orig_df %>% filter( area == input$map_onclick$object[["area"]] ),
getPosition = ~lon + lat,
getElevation = ~count,
getFillColor = ~color,
getTooltip = "Area: {{area}}, Count: {{count}}",
elevationScale = 50
) %>% update_deckgl(it = "works")
})
What remains to be done I guess is to add some logic to get from the detailed map, but you could easily add a flag to the data from which you can derive at which layer (aggregated or original) you are and based on that run a different logic.

How do you specify variables when rending a formattable table in shiny?

I'm trying to create and render an interactive formattable table in a shiny app.
Here is a sample dataframe:
tcharts <- data.frame(pgm = c(1,2,3,4,5,6,7,8),
horse = c("Cigar", "Funny Cide", "Animal Kingdom", "Blame", "Zenyatta", "New Years Day", "Northern Dancer", "Beautiful Pleasure"),
groundloss = c(55,70,85,42,90,45,53,50),
distanceRun = c(5050,5070,5085,5045,5090,5045,5053,5050),
ttl = c(50,70,85,42,90,45,53,50),
fps = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finishTime = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finish = c(4,7,1,2,5,6,3,8),
BL = c(0,1,2,6,2,9,6,8),
rnum = c(1,1,1,1,1,1,1,1),
sixteenth = c(330,330,330,330,330,330,330)
)
Working version
This version of the code, when list() is empty (use all variables in dataframe) produces a table as expected.
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
))
})
Error Version:
With this version, I get an ERROR: object pgm not found
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
pgm,
Horse
))
})
The error message leads me to believe I'm not specifying the variable correctly, but I'm not sure how to do it. I'v looked at several formattable / shiny SO questions and responses, but have not come up with the correct sytax.

Changing values in the chart in Shiny

I have a simple shiny application and I don't know why the values on the chart change when I choose multiple items from a list. Below my example and images with bad charts.
ui
library(shiny)
library(plotly)
shinyUI(fluidPage(
titlePanel("App test"),
sidebarPanel(
h3(" "),
selectizeInput("name",
label = "Code",
choices = unique(data$Product),
multiple = T,
options = list(maxItems = 5, placeholder = 'Select a code'),
selected = "46")
),
mainPanel(
plotOutput("trendPlot")
)
)
)
server
shinyServer(function(input, output, session) {
output$trendPlot <- renderPlot({
df_trend <- data[data$Product == input$name, ]
ggplot(df_trend) +
geom_line(aes(x = Month, y = Value, group = Product, colour = Product)) +
theme(legend.position = "bottom")
})
})
Head my data:
> head(data)
# A tibble: 6 x 3
Product Month Value
<chr> <chr> <dbl>
1 46 Jan 188
2 46 Feb 277
3 46 Mar 317
4 46 Apr 367
5 46 May 329
6 46 Jun 318
The data set above only includes '46' for Product so cannot reproduce. However, I suspect the problem is how you are filtering data, allowing for multiple inputs with selectizeInput.
Right now you filter data:
df_trend <- data[data$Product == input$name, ]
Which is fine if input$name is a single value. However, with multiple inputs (e.g., 46 and 92), then input$name contains those two values, and you need a different kind of comparison.
To subset your data based on multi-value matching (like matching a vector), try instead:
df_trend <- data[data$Product %in% input$name, ]

Subsetting data in shiny server.R file

I am trying to get a simple Shiny app to work (this would be the start of something bigger). My problem is that subsetting data in the sever.R part of the app does not seem to work at all for me.
The error message is:
Error in eval(expr, envir, enclos) : object 'localA3' not found
Here's my server.R file:
# server.R
library(ggmap)
library(scales)
library(grid)
localA <- read.csv("local7.csv", header=TRUE)
shinyServer(
function(input, output) {
output$map <- renderPlot({
sub <- switch(input$sub,
"a" = "a",
"b" = "b",
"c" = "c")
opt <- switch(input$opt,
"data" = "data",
"obs" = "obs")
localx = reactive({
x <- subset(localA, factor==paste(sub))
return(x)
})
localA3 <- localx()
testmapA <- qmap("England", zoom = 6, color = "bw", legend = "topleft")
testmapA +
geom_point(aes(x = lon, y = lat, colour = localA3$opt, size = localA3$opt), data = localA3)
})
}
)
...and this is my UI.R file:
# UI.R
shinyUI(fluidPage(
titlePanel("A Shiny Example"),
sidebarLayout(
sidebarPanel(
helpText("Create maps with random data for UK local authorities."),
selectInput("sub",
label = "Choose a category to display",
choices = c("a", "b", "c"),
selected = "a"),
selectInput("opt",
label = "Choose a variable to display",
choices = c("data", "obs"),
selected = "data"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(plotOutput("map"))
)
))
For whatever reason R tells me that it can't find the object 'localA3'. I have tried to program the subsetting part of the code in many different ways now - from reactive expressions over functions to simple R-code. What works outside of Shiny doesn't work in the server.R program.
Can anyone give me any hints on what I might be doing wrong?
The first ten entries of my base dataset 'local7.csv' are as follows:
lon lat data obs factor
1 -0.1277583 51.5073509 87.828234 20.49259318 a
2 0.1293497 51.5464828 68.79663358 98.0480588 a
3 -0.1997 51.6444 24.35460542 76.77994522 b
4 0.154327 51.439933 71.51349632 28.05491455 a
5 -0.2710568 51.5672808 91.31933313 69.15576621 c
6 0.013156 51.406025 57.98920169 56.12171479 a
7 -0.1588255 51.5517059 45.68928313 29.73514486 a
8 -0.098234 51.376165 29.47027315 96.1460748 b
9 -0.3415002 51.5250257 36.46005588 76.66948508 c
10 -0.0837 51.6516 43.57721438 50.65123884 c
You need to change your aes call to aes_string and make all elements strings so you are consistent with geom_point. Before you are using both objects and strings. The following small change at the end of you uiR works for me.
testmapA +
geom_point(aes_string(x = "lon", y = "lat", colour = input$opt, size = input$opt), data = localA3)

Resources