R Shiny application for comparing two chronologies - r

Question

I am providing here an executable simple R shiny application to plot two lines based on column names.
library(shiny)
library(reshape2)
library(ggplot2)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("moreControls")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Cross dating", plotOutput("plot1"))
)
)
)
))
server <- shinyServer(function(input, output) {
datasetInput <- data.frame(chrono_A = rnorm(16,0),chrono_B = rnorm(16,0))
row.names(datasetInput) <- c(seq(2000, 2015))
col_names <- colnames(datasetInput)
output$moreControls <- renderUI({
checkboxGroupInput("variable", "Filter Options", col_names)
})
# Plot data
output$plot1 <- renderPlot({
datasetInput_short <- mutate(datasetInput, year = as.numeric(row.names(datasetInput)))
datasetInput_short <- melt(datasetInput_short, id = c("year"))
datasetInput_short <- dplyr::filter(datasetInput_short, variable %in% input$variable)
ggplot(datasetInput_short, aes(x = year, y = value, group = variable, col = variable)) +
geom_line() + theme_bw() + ylim(-3, 3)
})
})
shinyApp(ui = ui, server = server)
I would like to add two features, which would allow me to move the plotted lines in two ways:
By adding a window where I can directly add the final year for the curve (ideally, the current final year would be entered automatically)
By adding two additional buttons (+ and -), and by clicking them I move each line by one year
Please, see the image below:
Any suggestion is highly appreciated.

Answer 1

I reread your description, maybe this might be helpful, though not entirely sure this is what you have in mind.
You can add two textInput widgets and then add filters to your data so that the data displayed for A and B have years less than these values.
In addition, you can have reactiveValues that include an offsets for A and B that increase/decrease when the buttons are pressed. These offsets will change the year column from the filtered data for A and/or B.
server <- shinyServer(function(input, output) {
datasetInput <- data.frame(chrono_A = rnorm(16,0),chrono_B = rnorm(16,0))
row.names(datasetInput) <- c(seq(2000, 2015))
col_names <- colnames(datasetInput)
rv <- reactiveValues(offset_A = 0, offset_B = 0)
observeEvent(input$but_plus_A, {
rv$offset_A <- rv$offset_A + 1
})
observeEvent(input$but_minus_A, {
rv$offset_A <- rv$offset_A - 1
})
observeEvent(input$but_plus_B, {
rv$offset_B <- rv$offset_B + 1
})
observeEvent(input$but_minus_B, {
rv$offset_B <- rv$offset_B - 1
})
datasetInput_short <- reactive({
datasetInput %>%
mutate(year = as.numeric(row.names(.))) %>%
pivot_longer(cols = starts_with("chrono_"), names_to = "variable", values_to = "value") %>%
dplyr::filter(variable %in% input$variable,
(variable == "chrono_A" & year < input$sel_A) | (variable == "chrono_B" & year < input$sel_B)) %>%
mutate(year = if_else(variable == "chrono_A", year + rv$offset_A, year),
year = if_else(variable == "chrono_B", year + rv$offset_B, year))
})
output$moreControls <- renderUI({
list(
checkboxGroupInput("variable", "Filter Options", col_names),
textInput("sel_A", "Year A", 2015),
actionButton("but_plus_A", "", icon = icon("plus")),
actionButton("but_minus_A", "", icon = icon("minus")),
textInput("sel_B", "Year B", 2015),
actionButton("but_plus_B", "", icon = icon("plus")),
actionButton("but_minus_B", "", icon = icon("minus"))
)
})
# Plot data
output$plot1 <- renderPlot({
ggplot(datasetInput_short(), aes(x = year, y = value, group = variable, col = variable)) +
geom_line() + theme_bw() + ylim(-3, 3)
})
})
Edit:
Based on OP comment below, say you do not know the column names, but there are always 2 columns to work with, you can do the following. You can use the column names vector col_names when filtering.
datasetInput_short <- reactive({
datasetInput %>%
mutate(year = as.numeric(row.names(.))) %>%
pivot_longer(cols = all_of(col_names), names_to = "variable", values_to = "value") %>%
dplyr::filter(variable %in% input$variable,
(variable == col_names[1] & year < input$sel_A) | (variable == col_names[2] & year < input$sel_B)) %>%
mutate(year = if_else(variable == col_names[1], year + rv$offset_A, year),
year = if_else(variable == col_names[2], year + rv$offset_B, year))
})
It is possible to dynamically generate more than 2 sets of inputs (for example, using 3: A, B, and C) but that would be a bit more complex.