I'm struggling with a plotly event listener that seems to be active after its intended moment. I have two methods for selecting date range - a sliderInput and the plotlyOutput plot. While the Shiny reactivity and plotly event_register are generally responding as intended, the plotly event_register is also firing at an undesirable moment - when the user makes a selectInput choice after having clicked the button to reset following an earlier plotlyOutput drag-range selection.
The app below reproduces the problem. Assistance much appreciated.
require(tidyverse)
require(shiny)
require(plotly)
d = as_tibble(EuStockMarkets) %>% mutate(date = Sys.Date() + (-1860:-1)) %>%
pivot_longer(-date, names_to = 'market')
ui = fluidPage(
sidebarPanel(width = 3,
h5('Persistent sparkline to show full date range'),
plotOutput("sparkline", height = '100px'),
sliderInput('date_range', 'Date range', min = min(d$date), max = max(d$date),
value = range(d$date), step = 1, timeFormat = '%d %b %y'),
actionButton('reset_date_range', 'Reset sliderInput to full range', style='height: 25px; padding: 2px 5px;'),
hr(),
selectInput('market', 'Market', choices = unique(d$market), selected = 'DAX'),
h4('Steps to reproduce the problem:'),
p('1. Drag a date range in the big (plotly) plot. This will apply to sliderInput and main plot will update as intended.'),
p('2. Click the button to reset the range.'),
p('3. Select a new market. The sliderInput will revert to the last plotly plot\'s drag range despite the reset.'),
h5('Plotly event_register response:'),
verbatimTextOutput("brushed")
),
mainPanel(width = 9, plotlyOutput('plot', height='80vh'))
)
server = function(input, output, session) {
r = reactiveValues() # my app requires a reactive data object
observeEvent(input$market, {
r$dat = d %>% filter(market == local(input$market)) # filter reactive data
# Sparkline plot
output$sparkline = renderPlot({
d %>% filter(market == input$market) %>%
qplot(date, value, label = round(value), geom = 'line', data = .) +
geom_text(data = function(x){ filter(x, value %in% range(value))}, size = 4) +
theme_void() + scale_y_continuous(expand = c(0.2, 0.2))
}, bg="transparent")
# Plotly timeline plot
output$plot = renderPlotly({
p = r$dat %>% qplot(date, value, data = ., geom = 'line') + theme_minimal()
ggplotly(p) %>% layout(dragmode = "select") %>% event_register("plotly_brushed")
})
output$brushed <- renderPrint({
e_dat = event_data("plotly_brushed")
if(length(na.omit(e_dat$x)) == 2){
sliderRange <<- as.Date(e_dat$x, origin='1970-01-01')
updateSliderInput(session, 'date_range', value = sliderRange)
sliderRange <<- NULL # test to ensure e_dat$x isn't persisting somehow
}
print(e_dat)
})
})
# update reactive r$dat if the slider used
observeEvent(input$date_range, {
r$dat = d %>% filter(market == local(input$market), date >= input$date_range[1], date <= input$date_range[2])
})
# reset date selection
observeEvent(input$reset_date_range, {
date_range = range(d$date, na.rm = TRUE)
updateSliderInput(session, 'date_range', min = date_range[1], max = date_range[2], value = date_range)
})
}
shinyApp( ui = ui, server = server)
Agh rookie error.. my output$brushed <- renderPrint({ ... }) just needs to move outside the observeEvent(input$market, ...) clause.
Related
I want to create a clickable histogram in shiny but I don't know if it is possible.
Some months ago I saw a clickable volcano plot which gives you a table of what you click.
Source: https://2-bitbio.com/2017/12/clickable-volcano-plots-in-shiny.html
The closest post that I found about creating clickable histograms is this one Click to get coordinates from multiple histogram in shiny
However, I don't want to get the coordinates. I want the rownames of the dataframe.
Having this dataframe, can I get the rownames everytime I click a bar from the histogram?
mtcars <- mtcars %>%
select("hp")
mtcars <- as.matrix(mtcars)
One example (but not clickable) in shiny:
library(shiny)
library(ggplot2)
library(scales)
library(dplyr)
ui <- fluidPage(
titlePanel("Histogram"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("hist"),
)
)
)
mtcars <- mtcars %>%
select("hp")
mtcars <- as.matrix(mtcars)
server <- function(input, output) {
output$hist <- renderPlot({
pp <- qplot(mtcars, geom = "histogram", bins = 10, xlab="values",
ylab="Frequency", main="Histogram",
fill=I("red"), col=I("black"), alpha=I(0.4))
pp + scale_x_continuous(breaks=pretty(mtcars, n=10))
})
}
shinyApp(ui = ui, server = server)
Does anyone know how to do it?
Thanks very much in advance!
Regards
This is a great question, and what makes it challenging is that the qplot/ggplot charts are static images. The below app.r is an example of how I would do it. I'd love to see other approaches.
In essence:
Create a sequence of numbers that will be used both as the breaks in your histogram and as intervals in your dataframe. I based these on user inputs, but you could hardcode them.
Assign a "bin" value to each row in the dataframe based on the interval in which the value falls.
Record the x-coordinate from the user's click event and assign that a "bin" value based on the same set of intervals.
Subset your dataframe and retain only those records where the "bin" value of the data matches the "bin" value of the x-coordinate from the user's click event.
Otherwise, if you're willing to go the d3 route, you could explore something like this posted by R Views.
#Load libraries ----------------------------------------------------
library(shiny)
library(ggplot2)
library(scales)
library(dplyr)
# Prepare data -----------------------------------------------------
df <- mtcars
df <- cbind(model = rownames(df), data.frame(df, row.names = NULL)) # setting the rownames as the first column
dm <- df$hp %>% as.matrix()
# UI function ------------------------------------------------------
ui <- fluidPage(
titlePanel("Histogram"),
sidebarLayout(
sidebarPanel(
tags$h5("I added the below text output only to demonstrate shiny's way for tracking user interaction on static plots. You can click, double-click, or click & drag (i.e. brushing). These functions are AWESOME when exploring scatterplots."),
tags$h3("Chart click and brushing"),
verbatimTextOutput("info"),
tags$h5("Now I'm applying the below UI inputs to the `vec` and `breaks` arguments in `findInterval()` and `qplot()` respectively; I'm using `findInterval()` to bin the values in the dataframe AND to bin the x-value of the user's click event input on the chart. Then we can return the dataframe rows with the same bin values as the x-value of the click input."),
sliderInput("seq_from_to"
, label = h3("Sequence 'From' and 'To'")
, min = 0
, max = 500
, value = c(50, 350)
),
sliderInput("seq_by"
, label = h3("Sequence 'By'")
, min = 25
, max = 200
, value = 50
, step = 5)
),
mainPanel(
plotOutput("hist",
click = "plot_click",
dblclick = "plot_dblclick",
hover = "plot_hover",
brush = "plot_brush"),
dataTableOutput("table")
)
)
)
# Server function --------------------------------------------------
server <- function(input, output) {
# Render Histogram Plot
output$hist <- renderPlot({
# Using the same `qplot` function but inserting the user inputs to set the breaks values in the plot
pp <- qplot(dm
, geom = "histogram"
, breaks = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by)
, xlab = "values"
, ylab = "Frequency"
, main = "Histogram"
, fill = I("red")
, col = I("black")
, alpha = I(0.4)
)
# Also using the user inputs to set the breaks values for the x-axis
pp + scale_x_continuous(breaks = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))
})
# This is purely explanatory to help show how shiny can read user interaction on qplot/ggplot objects
# It's taken from the Shiny docs here: https://shiny.rstudio.com/articles/plot-interaction.html
output$info <- renderText({
# Retain the x and y coords of the user click event data
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
# Retain the x and y range coords of click & drag (brush) data
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
# Paste this together so we can read it in the UI function for demo purposes
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
# Back to the story. Set a listener to trigger when one of the following is updated:
toListen <- reactive({list(
input$plot_click # user clicks on the plot
, input$seq_from_to # user updates the range slider
, input$seq_by # user updates the number input
)
})
# When one of those events are triggered, update the datatable output
observeEvent(toListen(), {
# Save the user click event data
click_data <- input$plot_click
print(click_data) # during your app preview, you can watch the R Console to see what click data is accessible
# Assign bin values to each row using the intervals that are set by the user input
df$bin <- findInterval(dm, vec = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))
# Similarly assign a bin value to the click event based on what interval the x values falls within
click_data$x_bin <- findInterval(click_data$x, vec = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))
# Lastly, subset the df to only those records within the same interval as the click event x-value
df_results <- subset(df, bin == click_data$x_bin)
# Select what values to view in the table
df_results <- df_results %>% select(model, hp)
# And push these back out to the UI
output$table <- renderDataTable(df_results,
options = list(
pageLength = 5
)
)
})
}
shinyApp(ui = ui, server = server)
Well, someone answered. Since I took the time to put it together, here is another potential solution.
library(shiny)
library(ggplot2)
library(scales)
library(dplyr)
library(DescTools) # added for Closest()
ui <- fluidPage(
titlePanel("Histogram"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("hist", click = 'plot_click'), # added plot_click
verbatimTextOutput("x_value"), # added queues for interactivity
verbatimTextOutput("selected_rows") # added table for bin values
)
)
)
# this can be a dataframe or matrix for qplot or ggplot
# (not sure if there was another reason you had this code?)
# mtcars <- mtcars %>%
# select("hp") # if you only want hp
# mtcars <- as.matrix(mtcars) # I suggest making row names a column
# to keep 2 columns
pp <- ggplot(mtcars) +
geom_histogram(aes(x = hp),
bins = 10,
fill = "red",
color = "black",
alpha = .4) +
labs(x = "values",
y = "Frequency",
title = "Histogram")
# extract data from plot to find where each value falls within the histogram bins
# I kept the pkg name, function in more than one library
bd <- ggplot_build(ggplot2::last_plot())$data[[1]]
# add the assigned bin number to the mtcars frame; used for filtering matches
mtcars$bins <- lapply(mtcars$hp,
function(y) {
which(bd$x == Closest(bd$x, y))
}) %>% unlist()
server <- function(input, output) {
output$hist <- renderPlot({
# moved the plot outside of server, so that global variables could be created
# pp <- qplot(mtcars[,"hp"], geom = "histogram", bins = 10, xlab="values",
# ylab = "Frequency", main = "Histogram",
# fill = I("red"), col = I("black"), alpha = I(0.4))
# scale_x_continuous(breaks=pretty(mtcars, n=10)) # can't use this
pp
})
# # Print the name of the x value # added all that's below with server()
output$x_value <- renderPrint({
if (is.null(input$plot_click$x)) return()
# find the closest bin center to show where the user clicked on the histogram
cBin <- which(bd$x == Closest(bd$x, input$plot_click$x))
paste0("You selected bin ", cBin) # print out selected value based on bin center
})
# Print the rows of the data frame which match the x value
output$selected_rows <- renderPrint({
if (is.null(input$plot_click$x)) return()
# find the closest bin center to show where the user clicked on the histogram
cBin <- which(bd$x == Closest(bd$x, input$plot_click$x))
mtcars %>% filter(bins == cBin)
# mtcars
})
}
shinyApp(ui = ui, server = server)
Just in case someone ends in this post looking a way to include brushedPoints... inspired on this post, I found a way to do it!
Code:
#Load libraries ----------------------------------------------------
library(shiny)
library(ggplot2)
library(scales)
library(dplyr)
# Prepare data -----------------------------------------------------
df <- mtcars
df <- cbind(model = rownames(df), data.frame(df, row.names = NULL)) # setting the rownames as the first column
breaks_data = pretty(mtcars$hp, n=10)
my_breaks = seq(min(breaks_data), to=max(breaks_data), by=30)
# UI function ------------------------------------------------------
ui <- fluidPage(
titlePanel("Histogram"),
sidebarLayout(
sidebarPanel(
actionButton("draw_plot", "Draw the plot")
),
mainPanel(
plotOutput("hist",
brush = brushOpts("plot_brush", resetOnNew = T, direction = "x")),
dataTableOutput("table"),
)
)
)
# Server function --------------------------------------------------
server <- function(input, output) {
observeEvent(input$plot_brush, {
info_plot <- brushedPoints(df, input$plot_brush)
output$table <- renderDataTable(info_plot)
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
df %>% ggplot(aes(hp)) +
geom_histogram(alpha=I(0.4), col = I("black"), fill = I("red"), bins=10) +
labs(x = "values",
y = "Frequency",
title = "Histogram") +
scale_x_continuous(breaks = my_breaks)
})
}
shinyApp(ui = ui, server = server)
How to do a scatterplot with hover
library(shiny)
library(tidyverse)
ui <- fluidPage(
titlePanel("hover tooltips demo"),
mainPanel(
plotOutput("plot1", hover = hoverOpts(id = "plot_hover", delay = 100, delayType = "debounce")),
uiOutput("hover_info") # , style = "pointer-events: none")
)
)
server <- function(input, output) {
output$plot1 <- renderPlot({
mtcars %>%
ggplot(aes(mpg, hp)) +
geom_point()
})
output$hover_info <- renderUI({
hover <- input$plot_hover
point <- shiny::nearPoints(mtcars,
coordinfo = hover,
xvar = 'mpg',
yvar = 'hp',
threshold = 20,
maxpoints = 1,
addDist = TRUE)
if (nrow(point) == 0) return(NULL)
style <- paste0("position:absolute; z-index:100; background-color: #3c8dbc; color: #ffffff;",
"font-weight: normal; font-size: 11pt;",
"left:", hover$coords_css$x + 5, "px;",
"top:", hover$coords_css$y + 5, "px;")
wellPanel(
style = style,
p(HTML(paste0("Some info about car: <br/>MPG ", point$mpg, "<br/>HP ", point$hp)))
)
})
}
shinyApp(ui = ui, server = server)
I am currently having issues with my R.Shiny app which I have designed. The UI has a drop down menu which selects a variable "returnvar", one of the columns in my dataframe source_file. However, upon running the code below I receive an error message stating:
Warning: Unknown or uninitialised column: 'returnvar'.
Warning: Error in : geom_line requires the following missing aesthetics: y
Does anyone know how I can reference an input into my source file? (Something to fix the error from the line source_file_filtered$returnvar) Would greatly appreciate all the help I can get for this, thanks!
App.R
# Defining UI
ui <- fluidPage(theme = shinytheme("darkly"),
navbarPage(
"App", #Title of app
tabPanel("Weekly Cumulative Returns",
sidebarPanel(
tags$h3("Input:"),
dateRangeInput("daterange", "Date range",
start = "2016-01-01",
end = "2021-04-02",
min = "2016-01-01",
max = "2021-04-02",
format = "yyyy/mm/dd",
separator = "to"),
selectInput("returnvar", "Index",
choices= names(source_file[2:(length(source_file)-1)])),
), #sidebarpanel
mainPanel(
# Output: Correlation Plot ----
plotOutput(outputId = "plot2"),
), #mainPanel
) #tabpanel
) #navbarPage
) #fluidPage
# Defining Server
server <- function(input, output) {
#plot for Weekly Cumulative Returns tab
output$plot2 <- renderPlot({
returncolumn(returnvar = input$returnvar,
daterange = input$daterange)
})
}
# Create Shiny Object
shinyApp(ui = ui, server = server)
Global.R
#choose source file to work with
file_name = file.choose()
source_file = read_csv(file_name)
source_file$Date = as.Date(source_file$Date)
#defining returncolumn as a function to return of selected variable over the selected date range in shiny
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered, mapping = aes(x=Date, y=source_file_filtered$returnvar)) + geom_line(color="blue")
print(g)
}
Without the data its hard to test, but changing source_file_filtered$returnvar to source_file_filtered[[returnvar]] should make it work.
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered,
mapping = aes(x = Date,
y = source_file_filtered[[returnvar]])) +
geom_line(color="blue")
print(g)
}
I am relatively new to R, and I'm trying to build a reactive ggplot in Shiny where the X-axis (dates) is reactive to a dateRangeInput in the UI. I've been googling everywhere, but every thing I try returns an error.
In the ggplot, the aes() calls from a dataset called datecorrected_totals, where x is the dates, and y=load are the two values that I would like to be reactive to the dateRangeInput so the ggplot will adjust the scale based on the period within the daterangeinput.
library(tidyverse)
library(shiny)
library(tidyr)
library(lubridate)
library(zoo)
data <- read_csv("--")
# Define UI ----
ui <- fluidPage(
titlePanel("--"),
sidebarLayout(
sidebarPanel(
h3("Calculator"),
dateRangeInput("dates", label = "Dates",
start = ("10-18-2018"),
end = max("05-29-2019"),
min = min("10-18-2018"),
max = max("05-29-2019"),
format = "mm-dd-yyyy"),
sliderInput("slider_a", label = "--",
min = 0,
max = 7,
value = 0),
sliderInput("slider_c", label = "--",
min = 7,
max = 42,
value = 7)
),
mainPanel(plotOutput('bar_chart'))
)
)
# Define server logic ----
server <- function(input, output, session) {
RE <- reactive({
})
output$bar_chart <- renderPlot(
ggplot(data = datecorrected_totals, aes(x = x, y = load)) +
geom_bar(stat = "identity")
)
}
# Run the app ----
shinyApp(ui = ui, server = server)
You need to filter the original dataset by the input dates. In this example data would be your original dataset.
RE <- reactive({
data %>%
filter(x>=input$dates[1] & x<=input$dates[2])
})
output$bar_chart <- renderPlot(
ggplot(data = RE(), aes(x = x, y = load)) +
geom_bar(stat = "identity")
There is no need to create a separate reactive() expression (unless required otherwise). The filter can be applied directly in renderPlot(). Thus, output$bar_chart becomes
output$bar_chart <- renderPlot(
datecorrected_totals %>%
filter(between(x, input$dates[1], input$dates[2])) %>%
ggplot(aes(x = x, y = load)) +
geom_bar(stat = "identity")
)
Below is a self-contained minimal reproducible example:
library(tidyverse)
library(lubridate)
library(shiny)
datecorrected_totals <- tibble(x = seq(as.Date("2018-10-18"), as.Date("2019-05-29"), length.out = 10L),
load = day(x))
# Define UI ----
ui <- fluidPage(
titlePanel("--"),
sidebarLayout(
sidebarPanel(
h3("Calculator"),
dateRangeInput("dates", label = "Dates",
start = mdy("10-18-2018"),
end = mdy("05-29-2019"),
min = mdy("10-18-2018"),
max = mdy("05-29-2019"),
format = "mm-dd-yyyy"),
),
mainPanel(plotOutput('bar_chart'))
)
)
# Define server logic ----
server <- function(input, output, session) {
output$bar_chart <- renderPlot(
datecorrected_totals %>%
filter(between(x, input$dates[1], input$dates[2])) %>%
ggplot(aes(x = x, y = load)) +
geom_col()
)
}
# Run the app ----
shinyApp(ui = ui, server = server)
Note that the date strings have been coerced to valid Date objects by calling mdy() to avoid error messages.
In addition, geom_bar(stat = "identity") has been replaced by geom_col().
I'm new to R shiny and trying to generate plots in the dashboard. Everything gets displayed but the plots. I do not get errors too. Could anyone say, what exactly I'm doing wrong?
I tried using different options for generating graphs like
ggplot, plotOutput. Neither works.
library(shiny)
library(lubridate)
library(ggplot2)
library(scales)
library(dplyr)
library(shinydashboard)
data <- read.csv("sample.csv", stringsAsFactors = F, header = T)
ui <- fluidPage(
dateRangeInput("daterange", "Choose the date",
start = min(data$YEAR),
end = max(data$YEAR),
min = min(data$YEAR),
max = max(data$YEAR),
separator = " - ", format = "dd/mm/yy",
startview = 'Week', language = 'Eng', weekstart = 1),
selectInput(inputId = 'Product',
label='Product',
choices=c('Product1','Product2'),
selected='Product1'),
plotOutput("barplot", height = 500))
server <- function(input, output) {
a<-reactive({
data <- read.csv("sample.csv", stringsAsFactors = F, header = T)
dataset <- subset(data, Date >= input$daterange[1] & Date <= input$daterange[2])
dataset = switch(input$Product,
"Product1" = Product1,
"Product2" = Product2)
dataset
})
output$barplot <-renderPlot({
color<- c("blue", "green")
barplot(data$PRODUCT, data$VALUE,
col = color)
})
}
shinyApp (ui = ui, server = server)
I get no errors.
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")