Error when deselecting choices in checkboxGroup

[SumitDhar]

Hello,
This is my first attempt at building something Shiny. I am starting with a data file (.csv) that looks like this (but longer).

**
time(S), ax1, ay1, az1, gx1, gy1, gz1, ax2, ay2, az2, gx2, gy2, gz2, ax3, ay3, az3, gx3, gy3, gz3
00.000, 2424, -15208, -9844, -1439, 829, -1917, 1856, -14508, 6328, -943, 793, -6389, -14032, -3608, -8680, 517, 886, -2231
00.008, 2492, -14864, -9680, -1241, 733, -2148, 1924, -14396, 6408, -999, 820, -6450, -13844, -3712, -8628, 545, 720, -2346
00.018, 2304, -14436, -9132, -934, 595, -2114, 1952, -14660, 6396, -1089, 884, -6383, -13528, -3400, -8572, 287, 164, -2026
00.029, 1604, -13300, -8252, -9, 205, -1557, 2032, -14876, 6428, -1007, 818, -6338, -13176, -3316, -8244, -21, -860, -1225
00.039, 2268, -13668, -9388, 742, 222, -954, 2068, -14728, 6428, -981, 888, -6260, -13404, -3484, -8540, -99, -855, -1001
00.047, 2516, -13868, -9404, 811, 316, -697, 2088, -14672, 6328, -965, 871, -6254, -13488, -3532, -8652, -339, -828, -961
00.055, 2476, -13232, -9476, 690, 117, -322, 1952, -14632, 6208, -943, 816, -6261, -13080, -4016, -9012, -189, -738, -100
00.063, 2508, -13176, -9904, 521, 148, 203, 1960, -14556, 6300, -886, 826, -6211, -1596, 2744, -8816, -3195, 652, -6709
**

I am trying to --
a. Read in the .csv file (works)
b. Convert from wide to long and parse some variable names (works)
c. Populate a drop down menu (works)
d. Populate checkbox labels (works)
e. Plot data (works)
f. Change the plot and faceting variables from the drop down menu (works)
g. Deselect some of the traces in each panel (does not work)

The default is to have all checkboxes selected and all factors of the variable plotted by color. When I uncheck any of the checkboxes, I get the following error message.

"Aesthetics must be either length 1 or the same as the data (19200): x and y"

The number (19200) is dependent on the number of rows in the data frame and how many checkboxes are checked.

And finally, here is my code:

library(shiny)
library(tidyverse)
library(magrittr)

Define UI for application that draws two scatter plots

ui <- fluidPage(

Application title

titlePanel(" "),
tags$br(),
tags$hr(),

# Sidebar
sidebarLayout(
  sidebarPanel(
    fileInput("file_input","Select Data File to Import",accept=".TXT"),
    selectInput("color", "Compare", choices = c("Axes", "Sensors")),
    checkboxGroupInput("traces", "Plot Traces:", choices=c(), inline=TRUE),
    sliderInput("time2",
                "Time:",
                min = 0,
                max = 20,
                value = c(0, 20)),
  ),
  # Show a plot of the generated distribution
  mainPanel(
    plotOutput("accelPlot")
  )
)

)

Define server logic required to draw both plots

server <- function(input, output, session) {

convert wide to long and make variable names sensitive.

data_file <- reactive({
req(input$file_input)

  file_spec <- input$file_input
  st <- read.csv(file_spec$datapath)
  stLong <- st %>% gather(sensor, reading, ax1:gz3)
  stLong <- stLong %>% mutate(time.S. = sub(":", ".", time.S.)) %>% 
  mutate(sensor = sub("a", "acceleration_", sensor)) %>% 
  mutate(sensor = sub("g", "rotation_", sensor)) %>% 
  mutate(sensor = sub("(^.*)([123])$", "\\1_\\2", sensor)) %>% 
  separate(sensor, c("measure", "axis", "sensor"), sep = "_") %>% 
  mutate(sensor = case_when(sensor == 1 ~ "waist",
                              sensor == 2 ~ "heel",
                              sensor == 3 ~ "knee"))
  
  stLong %<>% mutate(time.S. = as.numeric(time.S.)) # make time numeric
  return(stLong)

})

#update checkbox
observe({
req(data_file()) #make sure upload exists
stLong <- data_file()
if(input$color == "Axes"){
box.opts = levels(as.factor(stLong[["axis"]]))
} else {
box.opts = levels(as.factor(stLong[["sensor"]]))
}
updateCheckboxGroupInput(session, "traces",
choices = box.opts, selected = box.opts, inline = TRUE )
})

output$accelPlot <- renderPlot({
req(data_file())
stLong <- data_file()
t <- stLong[["time.S."]]
r <- stLong[["reading"]]

traces <- input$traces


if(input$color == "Axes"){
  
  ggplot(stLong %>% filter(axis %in% traces), 
         aes(t, r, color=axis)) +
  geom_line(lwd = 1, alpha = 0.5) +
  geom_point(size = 1.25, alpha = 0.5) +
  labs(x = "Time (sec)", y = "Acceleration/Rotation", color="", title = "") +
  facet_grid(sensor ~ measure) +
  xlim(input$time2[1],input$time2[2]) +
  theme_light()
  } else {
    
    ggplot(stLong %>%  filter(sensor %in% traces),
           aes(t, r, color=sensor)) +
    geom_line(lwd = 1, alpha = 0.5) +
      geom_point(size = 1.25, alpha = 0.5) +
      labs(x = "Time (sec)", y = "Acceleration/Rotation", color="", title = "") +
      facet_grid(axis ~ measure) +
      xlim(input$time2[1],input$time2[2]) +
      theme_light()
  }

})

}

Run the application

shinyApp(ui = ui, server = server)

Thanks much in advance.
Best,
Sumit

[pieterjanvc]

Hi,

Welcome to the RStudio community!

I really appreciate you took the time of making a reproducible example, that really made things faster

Your error lies in this part of your code

t <- stLong[["time.S."]]
r <- stLong[["reading"]]
traces <- input$traces
...
ggplot(stLong %>% filter(axis %in% traces), 
             aes(t, r, color=axis)) + ...

You hardcode the values for t and r first, but then you subset the stLong data based on the axis. This leads to different length vectors when traces are not xyz. To solve this, you simply remove those two variables and replace the names in the ggplot

ggplot(stLong %>% filter(axis %in% traces), 
             aes(time.S., reading, color=axis))

Now things should work as expected

Also, you get one error at the start of your app, or when none of the xyz checkboxes are selected, because the ggplot will fail with no data. To fix this, you can add the following line to the start of the renderPlot function

output$accelPlot <- renderPlot({
    req(data_file())
    if(length(input$traces) == 0) return(NULL)
    ....   

This way there will be no plot shown (and no error) when there is no axis selected.

Hope this helps,
PJ

[SumitDhar]

Perfect and thanks. I had the expected "duh!" response once I saw your explanation. Thank you for your help. It's works flawlessly now.