Error in `geom_histogram()`:
! Problem while computing stat.
ℹ Error occurred in the 1st layer.
Caused by error in `setup_params()`:
! `stat_bin()` requires a continuous x aesthetic.
✖ the x aesthetic is discrete.
ℹ Perhaps you want `stat="count"`?
2.2 Strategy 1: Use tidy pronouns
Tidyverse functions that feature tidy evaluation support the .data and .env pronouns
The .data pronoun is a representation of the original data which can be used in a masked environment
Sometimes, masked expressions can simply be constructed as strings
One example are formulas (e.g. in lm(y ~ x1 + x2))
The as.formula function can create formula objects manually
linreg <-function(df, y, x) { fm <-paste(y, "~", paste(x, collapse =" + ")) fm <-as.formula(fm)lm(fm, data = df)}linreg(ess, y ="trust_eu", x =c("age", "left_right"))
2.4 Strategy 3: Change names
In case of poorly implemented data masking, no tools are available to inject variables
One strategy to overcome such situations could be to simply change the object names
Render the leaflet map once. Note that the render function does not take any dependencies and is thus only run once.
2
Add a marker every time the map is clicked somewhere. Note that the marker is added not to a new map, but to a proxy of the map that is already rendered.
3
Remove a marker that is clicked. Note how the observer is only triggered when a marker is clicked, i.e. when input$map_marker_click is triggered.
8 Exercise session
8.1 Plotly
Exercise 1.1
Taking the ESS app (full code below), add an output canvas to the UI and a render function to the server function such that the new tab is able to display an interactive plotly widget.
Complete code for the ESS app
library(tidyverse)library(shiny)library(plotly)library(sf)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[yvar]], y = .data[[xvar]], group = .data[[yvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic() plotly::ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinals pal <-colorNumeric("YlOrRd", domain =NULL)# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })}shinyApp(ui = ui, server = server)
Solution 1.2
In the UI, add a new tabPanel() to the tabsetPanel().
In the server function, add renderPlotly and assign it to the output object.
output$hist <-renderPlotly({})
Complete code (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### New tab ----tabPanel(title ="Histogram",plotlyOutput("hist", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) }) output$hist <-renderPlotly({ })}shinyApp(ui = ui, server = server)
Exercise 1.2
In section 3, we implemented a bivariate plot of the ESS data. For this exercise, create a plotly histogram of one of the trust variables. The idea is to get a quick overview of the statistical distribution of a trust variable.
You can do this either through plotly’s own grammar (plot_ly()) or by converting a ggplot (ggplotly()). In the solutions, I will be using plotly though.
Note that, due to a bug in plotly, the labels of the ESS dataset have to be removed from the dataset. This can be done either by casting as.numeric on a variable or by zapping labels with haven::zap_labels().
Solution 1.2
The following solution implements a histogram of the trust_parliament variable.
ess <-readRDS("data/ess_trust.rds")plot_ly(ess, x =~as.numeric(trust_parliament)) %>%add_histogram()
Exercise 1.3
Customize the plotly plot according to the following requests:
Change the axis titles to something useful
Decrease the opacity to 70%
Remove the modebar
Increase the gap between histogram bars to 20%.
Change the bar color to green
Plotly can be very confusing and using Google and other utensils is explicitly welcome!
Tip
Recall that plotly can be customized using the layout, style, and config functions.
To find out about options specific to a plotly histogram, call plotly::schema() and navigate to traces -> histogram.
Solution 1.3
plot_ly(ess) %>%add_histogram(x =~as.numeric(trust_parliament)) %>%# everything that changes the overall theming goes herelayout(xaxis =list(title ="Trust in the national parliament"),yaxis =list(title ="Observations"),bargap =0.2 ) %>%# everything that changes the data- and plot-specific theming goes herestyle(opacity =0.7, marker =list(color ="green")) %>%# everything that changes the interactivity goes hereconfig(displayModeBar =FALSE)
Exercise 1.4
Implement the plot from exercise 1.3 in the Shiny app. Instead of plotting a single static variable, link the histogram to the input selector for the dependent variable (input$xvar) such that choosing a different trust variable updates the histogram.
Solution 1.4
output$hist <-renderPlotly({plot_ly(filtered()) %>%add_histogram(x =as.numeric(ess[input$xvar])) %>%# everything that changes the overall theming goes herelayout(xaxis =list(title ="Trust in the national parliament"),yaxis =list(title ="Observations"),bargap =0.2 ) %>%# everything that changes the data- and plot-specific theming goes herestyle(opacity =0.7, marker =list(color ="green")) %>%# everything that changes the interactivity goes hereconfig(displayModeBar =FALSE)})
Complete code (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### New tab ----tabPanel(title ="Histogram",plotlyOutput("hist", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) }) output$hist <-renderPlotly({plot_ly(filtered()) %>%add_histogram(x =as.numeric(ess[[input$xvar]])) %>%# everything that changes the overall theming goes herelayout(xaxis =list(title = input$xvar),yaxis =list(title ="Observations"),bargap =0.2 ) %>%# everything that changes the data- and plot-specific theming goes herestyle(opacity =0.7, marker =list(color ="green")) %>%# everything that changes the interactivity goes hereconfig(displayModeBar =FALSE) })}shinyApp(ui = ui, server = server)
8.2 Leaflet
Exercise 2.1
Taking the ESS app (full code below), add a new tab to the app. Add an output canvas to the UI and a render function to the server function such that the new tab is able to display an interactive map.
Complete code for the ESS app
library(tidyverse)library(shiny)library(plotly)library(sf)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[yvar]], y = .data[[xvar]], group = .data[[yvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic() plotly::ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinals pal <-colorNumeric("YlOrRd", domain =NULL)# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })}shinyApp(ui = ui, server = server)
Solution 2.1
In the UI, add a new tabPanel() to the tabsetPanel().
In the server function, add renderLeaflet and assign it to the output object.
output$hist <-renderLeaflet({})
Complete code (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### New tab ----tabPanel(title ="Histogram",leafletOutput("hist", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) }) output$hist <-renderLeaflet({ })}shinyApp(ui = ui, server = server)
Exercise 2.2
In section 4, we added an interactive map showing the average of the ESS dataset across Europe. For this exercise, create an interactive map that maps one of the trust variables using a binned scale. Add a basemap, polygons, a legend, and set the default view on Southeastern Europe.
Gathering all information for creating a Leaflet map can be a struggle, so using Google and other utensils is explicitly welcome.
Solution 2.2
colorBin creates a binned palette function to use in Leaflet. The domain argument must be passed, else the legend will be empty
addTiles adds an OpenStreetMap basemap
setView zooms in to a specific location
addPolygons adds polygon data to the map
The fillColor argument takes a vector of colors which can be created using the pal palette function
In section 4, we added labels that appear when hovering over a polygon. In this exercise, add labels that appear when clicking on the GESIS marker from the last exercise. The label should read “This is GESIS in Mannheim, DE” (incl. formatting).
Implement the leafelt map from exercise 2.2 to 2.4 in the Shiny app. Instead of plotting a single static variable, link the histogram to the input selector for the dependent variable (input$xvar) such that choosing a different trust variable updates the histogram.
Solution for exercise 2.5 (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### New tab ----tabPanel(title ="GESIS map",leafletOutput("gmap", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })# plot gesis map output$gmap <-renderLeaflet({ xvar <- input$xvar pal <-colorBin("YlOrRd", domain = ess_geo[[xvar]]) popup <-HTML("This is <strong>GESIS</strong> in Mannheim, DE")leaflet(ess_geo) %>%addProviderTiles("Stadia.StamenTerrain") %>%setView(13, 45, 5) %>%addPolygons(fillColor =pal(ess_geo[[xvar]]),color ="black",opacity =1,weight =1,fillOpacity =0.6 ) %>%addLegend(pal = pal,values = ess_geo[[xvar]],position ="bottomright",opacity =1 ) %>%addCircleMarkers(lng =8.46,lat =49.48,color ="blue",fillOpacity =1,opacity =1,radius =3,popup = popup ) })}shinyApp(ui = ui, server = server)
8.3 Proxies and plot events
Exercise 3.1
Taking the body of a server function below, how can you modify a proxy of the plot output every time the input is updated? Add a reactive expression that accesses the plot proxy on each input update.
output$map <-renderPlotly({ var <- input$variableplot_ly(x = ess[[var]]) %>%add_histogram()})
Tip
A proxy typically resides in an observer.
How can you ensure that the observer triggers when the input is updated?
Solution 3.1
output$map <-renderPlotly({ var <- input$variableplot_ly(x = ess[[var]]) %>%add_histogram()})observe({plotlyProxy("plot")}) %>%bindEvent(input$variable)
Exercise 3.2
Taking the code below, implement a proxy of the Leaflet map, that is, whenever the map is updated update the map proxy (leafletProxy()) instead of re-rendering the map. What are the advantages of updating the map using a proxy?
Note that you need to isolate input$xvar in renderLeaflet(). This step is necessary in order to render the leaflet map exactly once. You can isolate an input by typing isolate(input$xvar). Isolation severs an input from the reactive graph.
Code for exercise 3.2
library(dplyr)library(tidyr)library(shiny)library(leaflet)library(haven)ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ), ),## Main panel ----mainPanel(leafletOutput("map", height =600)) ))# Server ----server <-function(input, output, session) {# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create a palette for numerics and ordinals pal <-colorNumeric("YlOrRd", domain =NULL)# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ) ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })}shinyApp(ui = ui, server = server)
Tip
The workflow to update the map using a proxy is the following:
Render the map once using renderLeaflet()
Everytime the map is updated (by changing input$xvar), trigger an observer
The observer changes leafletProxy("map")
Using the proxy, clear all polygons and add the updated polygons
You can clear the existing polygons and the legend using the leaflet::clearShapes() and leaflet::clearControls() functions.
Solution 3.2
A solution for exercise 3.1 is presented in the collapsed code chunk below. A proxy is implemented by first rendering the map once through renderLeaflet and then triggering an observer each time the map is updated. The observer contains a call to leafletProxy which updates the map in place instead of re-rendering.
Although the proxy does not serve any important purpose in this case, there are two key advantages which can be observed in the result:
The map becomes much snappier, that means the updates are shown much faster than before
The map view does not reset when the map updates. You can preserve the pan position and zoom level
These advantages might be irrelevant in this scenario, but can come in handy in more specific use cases.
Solution for exercise 3.2 (important line are highlighted)
library(dplyr)library(tidyr)library(shiny)library(leaflet)library(haven)ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ), ),## Main panel ----mainPanel(leafletOutput("map", height =600)) ))# Server ----server <-function(input, output, session) {# render map ---- output$map <-renderLeaflet({ var <-isolate(input$xvar) ess_geo <- ess_geo[c("country", var)]# create a palette for numerics and ordinals pal <-colorNumeric("YlOrRd", domain =NULL)# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ) ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })# map proxyobserve({ var <- input$xvar ess_geo <- ess_geo[c("country", var)] pal <-colorNumeric("YlOrRd", domain =NULL)leafletProxy("map") %>%clearShapes() %>%clearControls() %>%addPolygons(data = ess_geo,fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ) ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) }) %>%bindEvent(input$xvar)}shinyApp(ui = ui, server = server)
Exercise 3.3
Taking the code from exercise 3.1, add a proxy that adds small blue dots when clicking anywhere on one of the polygons.
Tip
The proxy should be triggered if and only if a polygon is clicked. How can this plot event be accessed? Revisit section 6.2 if you are lost.
Solution for exercise 3.3 (important line are highlighted)
library(dplyr)library(tidyr)library(shiny)library(leaflet)library(haven)ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ), ),## Main panel ----mainPanel(leafletOutput("map", height =600)) ))# Server ----server <-function(input, output, session) {# render map ---- output$map <-renderLeaflet({ var <-isolate(input$xvar) ess_geo <- ess_geo[c("country", var)]# create a palette for numerics and ordinals pal <-colorNumeric("YlOrRd", domain =NULL)# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ) ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })# map proxyobserve({ var <- input$xvar ess_geo <- ess_geo[c("country", var)] pal <-colorNumeric("YlOrRd", domain =NULL)leafletProxy("map") %>%clearShapes() %>%clearControls() %>%addPolygons(data = ess_geo,fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ) ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) }) %>%bindEvent(input$xvar)observe({ coords <- input$map_shape_clickleafletProxy("map") %>%addCircleMarkers(lng = coords$lng,lat = coords$lat,radius =1,color ="blue",fillColor ="blue",opacity =1,fillOpacity =1 ) }) %>%bindEvent(input$map_shape_click)}shinyApp(ui = ui, server = server)
Exercise 3.4
So far, we have only talked about plot events in Leaflet. Taking the code below, implement an observer that prints the current plot coordinates every time a user hovers over the plot elements. Use plotly’s event_data() function. What kinds of information are displayed?
To easily print arbitrary R output to a Shiny app, you can use verbatimTextOutput() in the UI and renderPrint() in the server function.
Or you can just print to the console using print().
Solution 3.4
A solution for exercise 3.4 is presented in the collapsed code chunk below. The event contains information on something called “curve number”, point number, and x-y coordinates inside the plot.
Thinking back to the list of Javascript libraries for interactive plotting in section 2.1, pick one R interface that appeals to you the most. Study its documentation and vignettes to get a basic understanding of the interface.
Exercise 4.2
Add a new tab to the app. Replicate the violin plots from section 3 as boxplots using an R interface of your choice.
Note that not all plotting libraries support violin and boxplots to the same degree.
Example solution 4.2
An example solution with the highcharter package:
Complete code (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)library(highcharter)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### Highcharts tab ----tabPanel(title ="Highcharts",highchartOutput("highcharts", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })# render highcharts output$highcharts <-renderHighchart({ xvar <- input$xvar yvar <- input$yvar ess <-filtered() %>%zap_labels() %>%na.omit() %>%select(all_of(c(xvar, yvar))) %>%setNames(c("x", "y"))highchart() %>%hc_add_series_list(data_to_boxplot( ess, x, y,color ="black",fillColor ="#ADD8E6",showInLegend =FALSE,name = xvar )) %>%hc_yAxis(min =0, max =max(ess$y, na.rm =TRUE),title =list(text = yvar) ) %>%hc_xAxis(type ="category", title =list(text = xvar)) %>%hc_legend(enabled =FALSE) })}shinyApp(ui = ui, server = server)
An example solution with the apexcharter package:
Complete code (important lines are highlighted)
library(dplyr)library(tidyr)library(shiny)library(plotly)library(leaflet)library(haven)library(apexcharter)ess <-readRDS("ess_trust.rds")ess_geo <-readRDS("ess_trust_geo.rds")# UI ----ui <-fluidPage(titlePanel("European Social Survey - round 10"),## Sidebar ----sidebarLayout(sidebarPanel(### select dependent variableselectInput("xvar",label ="Select a dependent variable",choices =c("Trust in country's parliament"="trust_parliament","Trust in the legal system"="trust_legal","Trust in the police"="trust_police","Trust in politicians"="trust_politicians","Trust in political parties"="trust_parties","Trust in the European Parliament"="trust_eu","Trust in the United Nations"="trust_un" ) ),### select a variable ----selectInput("yvar",label ="Select an independent variable",choices =c("Placement on the left-right scale"="left_right","Age"="age","Feeling about household's income"="income_feeling","How often do you use the internet?"="internet_use","How happy are you?"="happiness" ) ),### select a country ----selectizeInput("countries",label ="Filter by country",choices =unique(ess$country),selected ="FR",multiple =TRUE ),### filter values ----sliderInput("range",label ="Set a value range",min =min(ess$trust_parliament, na.rm =TRUE),max =max(ess$trust_parliament, na.rm =TRUE),value =range(ess$trust_parliament, na.rm =TRUE),step =1 ) ),## Main panel ----mainPanel(tabsetPanel(type ="tabs",### Table tab ----tabPanel(title ="Table",div(style ="height: 600px; overflow-y: auto;",tableOutput("table") ) ),### Plot tab ----tabPanel(title ="Plot",plotlyOutput("plot", height =600) ),### Map tab ----tabPanel(title ="Map",leafletOutput("map", height =600) ),### Highcharts tab ----tabPanel(title ="Highcharts",apexchartOutput("highcharts", height =600) ) ) ) ))# Server ----server <-function(input, output, session) {# update slider ----observe({ var <-na.omit(ess[[input$xvar]]) is_ordered <-is.ordered(var) var <-as.numeric(var)updateSliderInput(inputId ="range",min =min(var),max =max(var),value =range(var),step =if (is_ordered) 1 ) }) %>%bindEvent(input$xvar)# filter data ---- filtered <-reactive({req(input$countries, cancelOutput =TRUE) xvar <- input$xvar yvar <- input$yvar range <- input$range# select country ess <- ess[ess$country %in% input$countries, ]# select variable ess <- ess[c("idno", "country", xvar, yvar)]# apply range ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ] ess })# render table ---- output$table <-renderTable({filtered() }, height =400)# render plot ---- output$plot <-renderPlotly({ xvar <- input$xvar yvar <- input$yvar plot_data <-filtered() %>%drop_na() %>%mutate(across(where(is.numeric), .fns = as.ordered)) p <-ggplot(plot_data) +aes(x = .data[[xvar]], y = .data[[yvar]], group = .data[[xvar]]) +geom_violin(fill ="lightblue", show.legend =FALSE) +theme_classic()ggplotly(p) })# render map ---- output$map <-renderLeaflet({ var <- input$xvar ess_geo <- ess_geo[c("country", var)]# create labels with a bold title and a body labels <-sprintf("<strong>%s</strong><br>%s", ess_geo$country, ess_geo[[var]] ) labels <-lapply(labels, HTML)# create a palette for numerics and ordinalsif (is.ordered(ess_geo[[var]])) { pal <-colorFactor("YlOrRd", domain =NULL) } else { pal <-colorNumeric("YlOrRd", domain =NULL) }# construct leaflet canvasleaflet(ess_geo) %>%# add base mapaddTiles() %>%# add choroplethsaddPolygons(fillColor =pal(ess_geo[[var]]),weight =2,opacity =1,color ="white",fillOpacity =0.7,# highlight polygons on hoverhighlightOptions =highlightOptions(weight =2,color ="#666",fillOpacity =0.7,bringToFront =TRUE ),label = labels ) %>%# add a legendaddLegend(position ="bottomleft",pal = pal,values = ess_geo[[var]],opacity =0.7,title = var ) })# render highcharts output$highcharts <-renderApexchart({ xvar <- input$xvar yvar <- input$yvarapex(filtered(), aes(.data[["trust_eu"]], .data[["left_right"]]), "boxplot") %>%ax_plotOptions(boxPlot =boxplot_opts(color.upper ="#ADD8E6", color.lower ="#ADD8E6")) %>%ax_stroke(colors =list("black")) %>%ax_labs(x ="eu_trust", y ="left_right") })}shinyApp(ui = ui, server = server)
