用于比较两个年代的Shiny应用程序

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的过滤数据中更改Year列。

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

})