Related
I am trying to create two corresponding selectInput lists. To do so I made two uiOutput in ui attached to renderUI in server. The renderUIs are linked to reactiveValues which should change according to input$* values.
And it does work until one point. The selection list is shrinking and can't go back to default (while in my opinion it should, based on second line of observeEvent).
I have a feeling that no matter what the input$* values are never null so the is.null() won't work.
I will apprecieate any help in this topic.
if (interactive()) {
library(dplyr)
library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(tidyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput('hair_filter'),
uiOutput('species_filter')
),
mainPanel( tableOutput('hairs'),
tableOutput('species'),
textOutput('text'),
textOutput('text2'),
tableOutput('hairfiltertable'),
tableOutput('speciesfiltertable')
)
))
server <- function(input, output, session){
starwars_full <- starwars %>%
as.data.frame() %>%
tibble::rownames_to_column(var = 'ID') %>%
transform(ID=as.numeric(ID), height=as.numeric(height), mass=as.numeric(mass), birth_year=as.numeric(birth_year)) %>%
group_by(ID, name, height,mass,hair_color, skin_color, eye_color, birth_year,sex,homeworld,species, films, vehicles, starships) %>%
summarise('cnt_films'=lengths(films),'cnt_vehicles'=lengths(vehicles),'cnt_ships'=lengths(starships))
#creating list of hair colors based on selected species
rv3 <- reactiveValues(hair_list = starwars_full %>%
separate_rows(hair_color,sep=", ") %>%
arrange(hair_color) %>%
as.data.frame() %>%
select(hair_color,species, name) %>%
distinct()
)
observeEvent(input$selected_from_dropdown_species,{
if(isTruthy(input$selected_from_dropdown_species))
{
rv3$hair_list <- starwars_full %>%
separate_rows(hair_color,sep=", ") %>%
arrange(hair_color) %>%
as.data.frame() %>%
select(hair_color,species, name) %>%
distinct() %>%
filter(species %in% input$selected_from_dropdown_species)
rv6$selected_species <- input$selected_from_dropdown_species
}
else
{
rv3$hair_list <- starwars_full %>%
separate_rows(hair_color,sep=", ") %>%
arrange(hair_color) %>%
as.data.frame() %>%
select(hair_color,species, name) %>%
distinct()
rv6$selected_species <- NULL
}
})
#creating species list, based on selected hair colors
rv4 <- reactiveValues(specie_list = starwars_full %>%
separate_rows(species,sep=", ") %>%
arrange(species) %>% as.data.frame() %>%
select(hair_color,species, name) %>%
distinct()
)
observeEvent(input$selected_from_dropdown_color,{
if(isTruthy(input$selected_from_dropdown_color))
{
rv4$specie_list <- starwars_full %>%
separate_rows(species,sep=", ") %>%
arrange(species) %>% as.data.frame() %>%
select(hair_color,species, name) %>%
distinct() %>%
filter(hair_color %in% input$selected_from_dropdown_color)
rv5$selected_colors <- input$selected_from_dropdown_color
}
else
{
rv4$specie_list <- starwars_full %>%
separate_rows(species,sep=", ") %>%
arrange(species) %>% as.data.frame() %>%
select(hair_color,species, name) %>%
distinct()
rv5$selected_colors <- NULL
}
})
rv5 <- reactiveValues(selected_colors = NULL)
rv6 <- reactiveValues(selected_species = NULL)
#selecinput of hair color
output$hair_filter = renderUI({
selectInput("selected_from_dropdown_color",
label ="Hair colors:",
choices=rv3$hair_list$hair_color,
multiple=TRUE,
selected=isolate(rv5$selected_colors))
})
#selectinput for species
output$species_filter = renderUI({
selectInput("selected_from_dropdown_species",
label ="Species",
choices=rv4$specie_list$species,
multiple=TRUE,
selected=isolate(rv6$selected_species))
})
output$hairs = renderTable({input$selected_from_dropdown_color})
output$species = renderTable({input$selected_from_dropdown_species})
output$text = renderPrint({print(input$selected_from_dropdown_color)})
output$text2 = renderPrint({print(input$selected_from_dropdown_species)})
output$hairfiltertable = renderTable({rv3$hair_list})
output$speciesfiltertable = renderTable({rv4$specie_list})
}
shinyApp(ui,server)
}
Edit:
We can use selectizeGroup from shinyWidgets to achieve the desired behaviour.
library(tidyverse)
library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(tidyr)
library(shinyWidgets)
starwars_full <- starwars %>%
as.data.frame() %>%
rownames_to_column(var = "ID") %>%
transform(ID = as.numeric(ID), height = as.numeric(height), mass = as.numeric(mass), birth_year = as.numeric(birth_year)) %>%
group_by(ID, name, height, mass, hair_color, skin_color, eye_color, birth_year, sex, homeworld, species, films, vehicles, starships) %>%
summarise("cnt_films" = lengths(films), "cnt_vehicles" = lengths(vehicles), "cnt_ships" = lengths(starships))
starwars_species_hair <- starwars_full %>%
separate_rows(hair_color, sep = ", ") %>%
separate_rows(species, sep = ", ") %>%
select(hair_color, species, name)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeGroupUI(
id = "my-filters",
params = list(
hair_color = list(inputId = "hair_color", title = "Hair color:"),
species = list(inputId = "species", title = "Species:")
)
)
),
mainPanel(DTOutput("resulting_table"))
)
)
server <- function(input, output, session) {
res_mod <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = starwars_species_hair,
vars = c("hair_color", "species")
)
output$resulting_table <- renderDT({
req(res_mod)
datatable(res_mod())
})
}
shinyApp(ui, server)
We can access selected values inside a reactive/observer by:
observe({
input[["my-filters-hair_color"]]
input[["my-filters-species"]]
)}
I am dynamically generating fluidrows for a uiOutput because the user selection will determine how many rows there are. For each row, I have 3 columns - two are text and the third is a plot.
I've got the text working, but I"m struggling to figure out how to get the plot in there.
In the reprex below it's the same plot, but in my actual example I will need to use a table other than the one passed into map(), but filter it based on one of the .x values.
library(tidyverse)
ui <- fluidPage(
uiOutput("row_mt")
)
server <- function(input, output) {
output$row_mt <- renderUI({
mt_list <- mtcars %>%
rownames_to_column(var = "model") %>%
rowwise() %>%
group_split() %>%
map(~{
tagList(fluidRow(
column(4,
.x$model),
column(4,
.x$mpg),
column(4,
mtcars %>%
filter(cyl == .x$cyl) %>%
ggplot(aes(x = mpg, y = cyl)) + geom_point())
),
br()
)
})
tagList(mt_list)
})
}
shinyApp(ui, server)
You should try to create the plot with renderPlot, and then display it in the renderUI with a plotOutput.
Try this
server <- function(input, output) {
output$myplot <- renderPlot({
mtcars %>%
rownames_to_column(var = "model") %>%
rowwise() %>%
group_split() %>%
map(~{
mtcars %>%
filter(cyl == .x$cyl) %>%
ggplot(aes(x = mpg, y = cyl)) + geom_point()
})
})
output$row_mt <- renderUI({
mt_list <- mtcars %>%
rownames_to_column(var = "model") %>%
rowwise() %>%
group_split() %>%
map(~{
tagList(fluidRow(
column(4,
.x$model),
column(4,
.x$mpg),
column(4,
plotOutput("myplot", height=100, width=100))
),
br()
)
})
tagList(mt_list)
})
}
In the example below, I am trying to produce a box and plot for each group within a dataset, using lapply within a renderUI function. However, some of these groups require an additional filter as they have sub-groupings.
This means creating a selectInput inside the box for those groups only and having the corresponding chart reference that selectInput only.
Here's the reproducible example... my problem is in the lapply loop creating a selectInput with the inputID of paste("selector_",i) and then immediately referencing this in the data to be output inside the corresponding box with input$(what goes here?)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(nycflights13)
library(DT)
data <- planes %>%
select(manufacturer, type, model, year, seats) %>%
unique() %>%
filter(!is.na(year)) %>%
mutate(year = as.character(year))
ui <- dashboardPage(
dashboardHeader(title = "Testing"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(12, selectInput("type","Type", choices = unique(data$type)),
uiOutput("mytabs"))
)
)
)
server <- function(input, output) {
data_filtered <- reactive({
req(input$type)
data %>%
filter(type == input$type)
})
mfrs <- reactive({
data_filtered() %>%
select(manufacturer) %>%
unique() %>%
pull()
})
output$mytabs = renderUI({
fluidRow(
lapply(mfrs(), function(i) {
dt <- data_filtered() %>%
filter(manufacturer == i) %>%
arrange(year) %>%
select(model, year, seats)
models <- dt %>%
filter(!is.na(model)) %>%
select(model) %>%
unique() %>%
pull()
if(length(models) > 1) {
box(id = paste0('card', i), title = paste(i),
selectInput(inputId = paste0("selector_",i), "Question",
choices = models, selected = models[1]),
DT::datatable(dt[dt$qntext == input$the_one_above],
width = "100%", rownames = F,
options = list(
columnDefs = list(list(width = '40px', targets = "_all"))
))
)
} else {
box(id = paste0('card', i), title = paste(i),
DT::datatable(dt,
width = "100%", rownames = F,
options = list(
columnDefs = list(list(width = '40px', targets = "_all"))
))
)
}
})
)
})
}
shinyApp(ui, server)
As I am not sure what qns means, I have assigned qns to be models. Try this code:
data <- planes %>%
select(manufacturer, type, model, year, seats) %>%
unique() %>%
filter(!is.na(year)) %>%
mutate(year = as.character(year))
ui <- dashboardPage(
dashboardHeader(title = "Testing"),
dashboardSidebar(uiOutput("myqns")),
dashboardBody(
fluidRow(
column(12, selectInput("type","Type", choices = unique(data$type)), uiOutput("mytabs"))
)
)
)
server <- function(input, output) {
data_filtered <- reactive({
req(input$type)
data %>%
filter(type == input$type)
})
mfrs <- reactive({
req(data_filtered())
data_filtered() %>%
select(manufacturer) %>%
unique() %>%
pull()
})
output$myqns <- renderUI({
req(mfrs())
lapply(1:length(mfrs()), function(i) {
dt <- data_filtered() %>%
filter(manufacturer == mfrs()[i]) %>%
arrange(year) %>%
select(model, year, seats)
models <- dt %>%
filter(!is.na(model)) %>%
select(model) %>%
unique() %>%
pull()
qns <- models
selectInput(inputId = paste0("selector_",i), paste("Question",i), choices = as.list(qns), selected = 1)
})
})
output$mytabs = renderUI({
req(mfrs())
fluidRow(
lapply(1:length(mfrs()), function(i) {
req(input[[paste0("selector_",i)]])
dt <- data_filtered() %>%
filter(manufacturer == mfrs()[i]) %>%
arrange(year) %>%
select(model, year, seats)
models <- dt %>%
filter(!is.na(model)) %>%
select(model) %>%
unique() %>%
pull()
qns <- models
if(length(models) > 1) {
box(id = paste0('card', i), title = paste(mfrs()[i]),
# selectInput(inputId = paste0("selector_",i), "Question",
# choices = qns, selected = qns[1]),
DT::datatable(dt[dt$model == input[[paste0("selector_",i)]], ],
width = "100%", rownames = F,
options = list(
columnDefs = list(list(width = '40px', targets = "_all"))
))
)
} else {
box(id = paste0('card', i), title = paste(mfrs()[i]),
DT::datatable(dt,
width = "100%", rownames = F,
options = list(
columnDefs = list(list(width = '40px', targets = "_all"))
))
)
}
})
)
})
}
shinyApp(ui, server)
Answered by the awesome Paul Campbell... using modules.
library(shinydashboard)
library(tidyverse)
library(highcharter)
library(nycflights13)
# Modules ===============================================
# UI and server module for box with chart
box_chart_UI <- function(id, title) {
ns <- NS(id)
box(
title = title, height = 550,
highcharter::highchartOutput(ns("chart"))
)
}
box_chart <- function(input, output, session, df) {
output$chart <- renderHighchart({
validate(need(nrow(df) > 0, "No data"))
hchart(df, "column", hcaes(year, seats))
})
}
# UI and server module for box with chart and filter
box_chart_filter_UI <- function(id, title, filters, filter_lab = "Model") {
ns <- NS(id)
box(
title = title, height = 550,
selectInput(inputId = ns("selector"), label = filter_lab, choices = filters),
highchartOutput(ns("chart"))
)
}
box_chart_filter <- function(input, output, session, df) {
output$chart <- renderHighchart({
req(input$selector)
df_chart <- df %>% filter(model == input$selector)
validate(need(nrow(df_chart) > 0, "No data"))
hchart(df_chart, "column", hcaes(year, seats))
})
}
# Main App ===============================================
# load app data
data <- planes %>%
select(manufacturer, type, model, year, seats) %>%
unique() %>%
filter(!is.na(year)) %>%
mutate(year = as.character(year))
ui <- dashboardPage(
dashboardHeader(title = "Testing"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(
width = 12,
selectInput("type", "Type", choices = unique(data$type))
)
),
uiOutput("mytabs")
)
)
server <- function(input, output, session) {
data_filtered <- reactive({
req(input$type)
data %>% filter(type == input$type)
})
mfrs <- reactive({
data_filtered() %>%
distinct(manufacturer) %>%
pull()
})
# first load all the UI module functions
output$mytabs <- renderUI({
fluidRow(
lapply(1:length(mfrs()), function(i) {
models <- data_filtered() %>%
filter(manufacturer == mfrs()[i], !is.na(model)) %>%
distinct(model) %>%
pull() %>%
sort()
# depending on how many models, load the correct UI module
if (length(models) > 1) {
box_chart_filter_UI(id = i, title = mfrs()[i], filters = models)
} else {
box_chart_UI(id = i, title = mfrs()[i])
}
})
)
})
# now separately load the module server functions
# need to do this inside an observe due to reactive objects
observe({
lapply(1:length(mfrs()), function(i) {
dt <- data_filtered() %>%
filter(manufacturer == mfrs()[i]) %>%
arrange(year) %>%
select(model, year, seats)
models <- dt %>%
filter(!is.na(model)) %>%
distinct(model) %>%
pull() %>%
sort()
# depending on how many models, load the correct server module
if (length(models) > 1) {
callModule(box_chart_filter, id = i, df = dt)
} else {
callModule(box_chart, id = i, df = dt)
}
})
})
}
shinyApp(ui, server)
In the example below, I have an interactive shiny ggvis choropleth with pop up label for income in each state. Users can switch data from drop down list.
My question is how to make the tooltip function interactive. The pop up label still displays the information of the original data set, even though user switches to the second data set. I tried to put it into reactive function and several other ways, but they all doesn't work. In the example below, I just use df1 in tooltip function to let you run and have a look at this app.
Thanks for your help!
Here is sample data
mapdata1<-data.frame(
state=c("alabama","alaska","arizona","arkansas","california","colorado","connecticut","delaware","florida","georgia","hawaii","idaho","illinois","indiana","iowa","kansas","kentucky","louisiana","maine","maryland","massachusetts","michigan", "minnesota","mississippi","missouri","montana","nebraska","nevada","new hampshire","new jersey","new mexico","new york","north carolina","north dakota","ohio","oklahoma", "oregon","pennsylvania","rhode island","south carolina","south dakota","tennessee","texas","utah","vermont","virginia","washington","west virginia","wisconsin","wyoming"),
income=runif(50,min=100,max=9000))
mapdata2<-data.frame(
state=c("alabama","alaska","arizona","arkansas","california","colorado","connecticut","delaware","florida","georgia","hawaii","idaho","illinois","indiana","iowa","kansas","kentucky","louisiana","maine","maryland","massachusetts","michigan", "minnesota","mississippi","missouri","montana","nebraska","nevada","new hampshire","new jersey","new mexico","new york","north carolina","north dakota","ohio","oklahoma", "oregon","pennsylvania","rhode island","south carolina","south dakota","tennessee","texas","utah","vermont","virginia","washington","west virginia","wisconsin","wyoming"),
income=runif(50,min=50,max=14000))
Server code
library(rgdal)
library(ggplot2)
library(ggvis)
tf <- tempfile()
td <- tempdir()
download.file(url,tf, mode="wb")
unzip(tf, exdir=td)
usa <- readOGR(dsn=td, layer="cb_2014_us_state_20m")
shp <- usa[(!usa$STUSPS %in% c("AK","HI")),]
df<- fortify(shp)
df<- merge(df,cbind(id=rownames(shp#data),shp#data),by="id")
df$state <- tolower(df$NAME)
df1<- merge(df,mapdata1,by="state")
df1<- df1[order(df1$order),]
df2<- merge(df,mapdata2,by="state")
df2<- df2[order(df2$order),]
shinyServer(
function(input,output){
dataInput<-reactive({
switch(input$segment,
"K 1"=df1,
"K 2"=df2)
})
###tooltip function
values = function(x){
if(is.null(x)) return(NULL)
row = head(df1[df1$group == unique(x$group), ], 1)
paste0("State: ", row$state,"<br />",
"Income: ", row$income, "<br />")
}
###choropleth
vis<-reactive({
data<-dataInput()
data %>%
group_by(group) %>%
ggvis(~long, ~lat) %>%
hide_axis("x") %>%
hide_axis("y")%>%
add_tooltip(values,"hover")%>%
layer_paths(fill= ~income)
})
vis %>% bind_shiny("visplot")
}
)
ui code
library(shiny)
library(ggvis)
shinyUI(fluidPage(
fluidRow(
column(3,
wellPanel(
selectInput("segment",
"Choose segment:",
choices = c("K 1",
"K 2")
)
)
),
column(9,
ggvisOutput("visplot")
)
)
))
UPDATED:
This is what I tried. I also use values() in add_tooltip instead of values. But it doesn't work.
###tooltip function
values<-reactive({
data<-dataInput()
if(is.null(x)) return(NULL)
row = head(data[data$group == unique(x$group), ], 1)
paste0("State: ", row$state,"<br />",
"Income: ", row$income, "<br />")
})
Here is a simpler mtcars example with a group-level tooltip like yours with layer_paths and grouping. Both the graph and tooltip info change when a different dataset is selected.
ui
library(ggvis)
library(shiny)
shinyUI(fluidPage(
titlePanel("Plotting slopes"),
sidebarLayout(
sidebarPanel(
selectInput("segment", label = "Choose segment", choices = c("K 1", "K 2"))),
mainPanel(ggvisOutput("plot"))
)
))
server:
library(shiny)
library(ggvis)
mtcars$cyl = factor(mtcars$cyl)
df1 = subset(mtcars, am == 0)
df2 = subset(mtcars, am == 1)
shinyServer(function(input, output) {
dataInput = reactive({
switch(input$segment,
"K 1" = df1,
"K 2" = df2)
})
values = function(x){
if(is.null(x)) return(NULL)
dat = dataInput()
row = dat[dat$cyl %in% unique(x$cyl), ]
paste0("Ave Weight: ", mean(row$wt),"<br />",
"Ave Carb: ", mean(row$carb), "<br />")
}
vis1 = reactive({
dat = dataInput()
dat %>%
group_by(cyl) %>%
ggvis(~mpg, ~wt) %>%
layer_paths(stroke = ~cyl, strokeOpacity := 0.3,
strokeWidth := 5) %>%
add_tooltip(values, "hover")
})
vis1 %>% bind_shiny("plot")
})
I have a strange problem in Shiny. My shiny app has one ggvis plot with layer_points() and several options to manipulate the plot . When I run my app sometimes everything works good even if I change all options, but sometimes ( I suppose there is no specific rule) plot disappers. Plot comes back when I change one of options but it is not cool.
I study this issue but I do not really know whether it is a solution for my problem.
When the plot disappears my Shiny app looks like:
This my code:
ui.R
library(ggvis)
library(markdown)
library(shiny)
library(dplyr)
library(magrittr)
shinyUI(
fluidPage(
h3("Title"),
fluidRow(
column(3,
wellPanel(
radioButtons("radio",h5("Select"),choices=list("All values","Selected values"),
selected="All values"),
conditionalPanel(
condition = "input.radio != 'All values'",
checkboxGroupInput("checkGroup",label = "",
choices,
selected = c("AT1","AT2"))
),
hr(),
radioButtons("dataset", label = h5("Drilldown"),
choices = list("2 Level" = "df1", "3 Level" = "df2")
),
hr(),
h5("Choice"),
selectInput("xvar", h6(""),
axis_vars_x,
selected = "value"),
selectInput("yvar", h6(""),
axis_vars_y,
selected = "number2"),
hr(),
uiOutput("slider")
)
),
column(9,
ggvisOutput("plot")
)
)
)
)
server.R
library(shiny)
shinyServer(function(input, output,session) {
datasetInput <- reactive({
switch(input$dataset,
df2 = df2,
df1 = df1)
})
axis_vara_y <- reactive({
switch(input$yvar,
number = 2,
number2 = 3)
})
output$slider <- renderUI({
sliderInput("inslider",h5(""), min = round(min(datasetInput()[,axis_vara_y()]),0)-1,
max = round(max(datasetInput()[,axis_vara_y()]),0)+1,
value = c(round(min(datasetInput()[,axis_vara_y()]),0)-1,
round(max(datasetInput()[,axis_vara_y()]),0)+1),
step = 0.5)
})
data <- reactive({
filteredData <- datasetInput()
axisData <- axis_vara_y()
if(!is.null(input$inslider)){
if(input$radio == "All values"){
filteredData <- filteredData %>%
filter(filteredData[,axisData] >= input$inslider[1],
filteredData[,axisData] <= input$inslider[2])
}
else {
filteredData <- filteredData %>%
filter(value %in% input$checkGroup,
filteredData[,axisData] >= input$inslider[1],
filteredData[,axisData] <= input$inslider[2])
}
}
return(filteredData)
})
data_point <- reactive({
data() %>%
mutate(id = row_number())
})
xvar <- reactive(as.symbol(input$xvar))
yvar <- reactive(as.symbol(input$yvar))
dotpoint_vis <- reactive({
xvar_name <- names(axis_vars_x)[axis_vars_x == input$xvar]
yvar_name <- names(axis_vars_y)[axis_vars_y == input$yvar]
data_point_detail <- data_point()
plot <- data_point_detail %>%
ggvis(x = xvar(),y = yvar()) %>%
layer_points(size := 120,fill = ~value) %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 750, height = 500, renderer = "canvas")
})
dotpoint_vis %>% bind_shiny("plot")
})
global.R
choices <- list("Value1" = "AT1", "Value2" = "AT2",
"Value3" = "AT3", "Value4" = "AT4",
"Value5" = "AT5", "Value6" = "RT1",
"Value7" = "AT6", "Value8" = "AT7",
"Value9" = "AT8", "Value10" = "AT9",
"Value11" = "AT10", "Value12" = "RT2")
levele <- c("AT1","AT2","AT3","AT4","AT5","RT1","AT6","AT7","AT8","AT9","AT10","RT2")
df1 <- data.frame(value = levele,number = seq(2,46,4), number2 = seq(2,24,2),order = 1:12)
df2 <- data.frame(value = levele,number = rep(4:15), number2 = rep(4:9,each = 2),order = 1:12)
df1$value <- factor(df1$value, levels = levele)
df2$value <- factor(df2$value, levels = levele)
axis_vars_y <- c("number","number2")
axis_vars_x <- c("value", "order","number","number2")
update
I also do not know what happened with animation in ggvis.
The problem was difficult to reproduce at first, but I found I can reproduce it by clicking back and forth between All Values and Selected Values. The graph disappears or reappears after some number of switches between the two radio buttons, but it varies seemingly randomly -- sometimes it takes 4 clicks to make the graph disappear or reappear and other times it takes 2 clicks or some other number of clicks.
There must be a bug in bind_shiny() or ggvisOutput(), because the following changes do create a graphic that does not seem to disappear:
In ui.R, make this change:
# ggvisOutput("plot")
plotOutput('plot')
In server.R, make this change:
plot(data_point_detail[ , c(input$xvar, input$yvar)], xlab=xvar_name, ylab=yvar_name)
# plot <- data_point_detail %>%
# ggvis(x = xvar(),y = yvar()) %>%
# layer_points(size := 120,fill = ~value) %>%
# add_axis("x", title = xvar_name) %>%
# add_axis("y", title = yvar_name) %>%
# set_options(width = 750, height = 500, renderer = "canvas")
# plot
and
output$plot <- renderPlot(dotpoint_vis())
# dotpoint_vis %>% bind_shiny("plot")