R блестящее приложение для сравнения двух хронологий

Question

Я предоставляю здесь исполняемое простое блестящее приложение R для построения двух линий на основе имен столбцов.

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)

Я хотел бы добавить две функции, которые позволили бы мне перемещать построенные линии в два способы:

1. Добавив окно, в котором я могу напрямую добавить последний год для кривой (в идеале, текущий последний год будет введен автоматически)
2. Добавив две дополнительные кнопки ( + и -), и, нажимая на них, я перемещаю каждую строку на один год

Пожалуйста, см. изображение ниже:

Любое предложение высоко ценится

Answer 1

Я перечитал ваше описание, может быть, это может быть полезно, хотя я не совсем уверен, что это то, что вы имеете в виду.

Вы можете добавить два виджета textInput, а затем добавить фильтры к вашим данным, чтобы данные, отображаемые для A и B, имеют годы меньше этих значений.

Кроме того, у вас может быть reactiveValues, который включает смещения для A и B, которые увеличиваются / уменьшаются при нажатии кнопок. Эти смещения изменят столбец года по отфильтрованным данным для A и / или 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)
  })

})

Редактировать :

На основании приведенного ниже комментария OP, скажем, вы делаете Не знаю имен столбцов, но всегда есть 2 столбца для работы, вы можете сделать следующее. При фильтрации можно использовать вектор имен столбцов col_names.

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))
})

Можно динамически генерировать более 2 наборов входных данных (например, используя 3: A, B и C) но это было бы немного сложнее.