如何使闪亮的情节React复选框数据选择

yshpjwxd  于 2023-09-27  发布在  React
关注(0)|答案(1)|浏览(123)

这是我第一个闪亮的代码。我已经把它简化成一个更像reprex的例子,并带有测试数据。这并不简单,因为它可以,但我试图保持一些结构的程序。我正在尝试使绘图响应文件选择复选框。例如,如果未选中Trial_4,则其数据将从所有三个图中消失,重新选择它将重新出现。

library(shiny)                 # Server/App
library(shinyWidgets)          # Custom controls
library(tidyverse)             # For ggplot and dataframe manipulations

# Function to generate checkbox group UI
generateCheckboxGroupUI <- function(id, choices, names, selected, label) {
  checkbox_group <- 
    checkboxGroupButtons(
      inputId = id,
      label = label, 
      choiceValues = choices,
      choiceNames = names,
      selected = selected,
      status = "primary",
      direction = "vertical",
      checkIcon = list(
        yes = icon("ok", 
                   lib = "glyphicon"),
        no = icon("remove",
                  lib = "glyphicon")),
      size = 'sm'
    )
}

# Plot function
# Data frames must contain standard variables trial, time, and 3 columns of 
# data, pass column to plot in index = c(1,2,3)
CreatePlot <- function(df, index) {

  ylab <- names(df)[index + 2]
  df <- df %>% select(c(1, 2, data = index + 2))
  
  plot <- ggplot(df, aes(x = time, y = data, col = trial)) +
    geom_line(linewidth = 1) +
    labs(x = "Time (s)", y = ylab) +
    theme_minimal()
}

# ---- User Interface ----

ui <- fluidPage(
  sidebarLayout(
    # Nothing in sidebar for this example
    sidebarPanel(),
      
    # Main panel displays controls and plots
    mainPanel(
      # 1. Title
      fluidRow(
        column(12, align = 'center', h3("Reactive Plots"))
      ),
      
      # 2. File controls
      fluidRow(
        # File labels
        column(4),
        column(3, style = "display: flex;text-align: left; align-items: flex-start;",
               wellPanel(uiOutput("file_names")), style = "text-align: left;"),
        #column(1),
        # File selection check boxes
        column(1, style = "display: flex; justify-content: center; align-items: flex-start;",
               wellPanel(uiOutput("UseFile"))),
        column(4)
      ),
      
    ), # mainPanel
  ), # sidebarLayout

  
  # New section below sidebar layout to use full width for plots
  # 3. Left side plot windows
  fluidRow(
    column(4, plotOutput("left_plot")),
    column(4, plotOutput("middle_plot")),
    column(4, plotOutput("right_plot"))
  )
  
) # fluidPage

#### ---- Server ---- ####
server <- function(input, output) {
  
  #############
  # Test Data: 4 files with time, X, Y, Z Data of equal lengths
  # Data inside server to replicate actual program
  # In actual program file chooser loads data files
  
  file_name_labels <- c("File_1", "File_2", "File_3", "File_4")
  num_files <- 4
  t <- seq(0,10,0.1)
  shift <- 0.25
  
  F1 <- tibble(
    trial = as.factor(1),
    time = t,
    X = sin(t),
    Y = cos(t),
    Z = sin(t) + cos(t)
  )
  
  F2 <- tibble(
    trial = as.factor(2),
    time = t,
    X = sin(t + shift),
    Y = cos(t + shift),
    Z = sin(t + shift) + cos(t + shift)
  )

  F3 <- tibble(
    trial = as.factor(3),
    time = t,
    X = sin(t - shift),
    Y = cos(t - shift),
    Z = sin(t - shift) + cos(t - shift)
  )
  
  F4 <- tibble(
    trial = as.factor(4),
    time = t,
    X = sin(-t),
    Y = cos(-t),
    Z = sin(-t) + cos(-t)
  )
  
  # Now bind together
  plot_data <- bind_rows(F1, F2, F3, F4)

  ########
  
  # Define reactive values for checkbox states
  # Being reactive when these values change, checkboxes are updated
  checkbox_states <- reactiveValues(
    UseFile = NULL,
  )
  
  # File names
  # Create file name labels in UI
  output$file_names <- renderUI({
  
    file_names <- lapply(file_name_labels, function(name) {
      # Adjust h-level here to get size right
      h4(name)
    })
    
    tagList(
      # Add margin at the top to align with checkboxes and radio buttons
      tags$div(style = "margin-top: 12px;"),
      fluidRow(file_names)
    )
    
  })
  
  
  # Initialize checkbox states, use all initially
  checkbox_states$UseFile <- rep(TRUE, num_files)
  # choices are given dummy values: c('A', 'B', 'C', ...)
  checkbox_choices <- LETTERS[1:num_files]
  # names are set to blank in a vector of same size as choices
  checkbox_names <- rep("", num_files)
  # Plot File options
  output$UseFile <- renderUI({
    checkbox_group <- generateCheckboxGroupUI(
      id = "UseFile", 
      choices = checkbox_choices,
      names = checkbox_names,
      selected = LETTERS[which(checkbox_states$UseFile)],
      label = "Files")
    
    checkbox_group
  })

  # Create the three plots
  output$left_plot <- renderPlot({
    plot <- CreatePlot(df = plot_data, index = 1)
    plot
  })
  
  output$middle_plot <- renderPlot({
    plot <- CreatePlot(df = plot_data, index = 2)
    plot
  })
  
  output$right_plot <- renderPlot({
    plot <- CreatePlot(df = plot_data, index = 3)
    plot
  })
  
} # Server

shinyApp(ui = ui, server = server)
i86rm4rw

i86rm4rw1#

也许你在找这个

library(shiny)                 # Server/App
library(shinyWidgets)          # Custom controls
library(tidyverse)             # For ggplot and dataframe manipulations

# Function to generate checkbox group UI
generateCheckboxGroupUI <- function(id, choices, names, selected, label) {
  checkbox_group <- 
    checkboxGroupButtons(
      inputId = id,
      label = label, 
      choiceValues = choices,
      choiceNames = names,
      selected = selected,
      status = "primary",
      direction = "vertical",
      checkIcon = list(
        yes = icon("ok", 
                   lib = "glyphicon"),
        no = icon("remove",
                  lib = "glyphicon")),
      size = 'sm'
    )
}

# Plot function
# Data frames must contain standard variables trial, time, and 3 columns of 
# data, pass column to plot in index = c(1,2,3)
CreatePlot <- function(df, index) {
  
  ylab <- names(df)[index + 2]
  df <- df %>% select(c(1, 2, data = index + 2))
  
  plot <- ggplot(df, aes(x = time, y = data, col = trial)) +
    geom_line(linewidth = 1) +
    labs(x = "Time (s)", y = ylab) +
    theme_minimal()
}

# ---- User Interface ----

ui <- fluidPage(
  sidebarLayout(
    # Nothing in sidebar for this example
    sidebarPanel(),
    
    # Main panel displays controls and plots
    mainPanel(
      # 1. Title
      fluidRow(
        column(12, align = 'center', h3("Reactive Plots"))
      ),
      
      # 2. File controls
      fluidRow(
        # File labels
        column(4),
        column(3, style = "display: flex;text-align: left; align-items: flex-start;",
               wellPanel(uiOutput("file_names")), style = "text-align: left;"),
        #column(1),
        # File selection check boxes
        column(1, style = "display: flex; justify-content: center; align-items: flex-start;",
               wellPanel(uiOutput("UseFile"))),
        column(4)
      ),
      
    ), # mainPanel
  ), # sidebarLayout
  
  
  # New section below sidebar layout to use full width for plots
  # 3. Left side plot windows
  fluidRow(
    column(4, plotOutput("left_plot")),
    column(4, plotOutput("middle_plot")),
    column(4, plotOutput("right_plot"))
  )
  
) # fluidPage

#### ---- Server ---- ####
server <- function(input, output) {
  
  #############
  # Test Data: 4 files with time, X, Y, Z Data of equal lengths
  # Data inside server to replicate actual program
  # In actual program file chooser loads data files
  
  file_name_labels <- c("File_1", "File_2", "File_3", "File_4")
  num_files <- 4
  t <- seq(0,10,0.1)
  shift <- 0.25
  
  F1 <- tibble(
    trial = as.factor(1),
    time = t,
    X = sin(t),
    Y = cos(t),
    Z = sin(t) + cos(t)
  )
  
  F2 <- tibble(
    trial = as.factor(2),
    time = t,
    X = sin(t + shift),
    Y = cos(t + shift),
    Z = sin(t + shift) + cos(t + shift)
  )
  
  F3 <- tibble(
    trial = as.factor(3),
    time = t,
    X = sin(t - shift),
    Y = cos(t - shift),
    Z = sin(t - shift) + cos(t - shift)
  )
  
  F4 <- tibble(
    trial = as.factor(4),
    time = t,
    X = sin(-t),
    Y = cos(-t),
    Z = sin(-t) + cos(-t)
  )
  
  # Now bind together
  plot_data <- bind_rows(F1, F2, F3, F4)
  
  ########
  
  # Define reactive values for checkbox states
  # Being reactive when these values change, checkboxes are updated
  checkbox_states <- reactiveValues(
    UseFile = NULL,
  )
  
  # File names
  # Create file name labels in UI
  output$file_names <- renderUI({
    
    file_names <- lapply(file_name_labels, function(name) {
      # Adjust h-level here to get size right
      h4(name)
    })
    
    tagList(
      # Add margin at the top to align with checkboxes and radio buttons
      tags$div(style = "margin-top: 12px;"),
      fluidRow(file_names)
    )
    
  })
           
  
  # Initialize checkbox states, use all initially
  checkbox_states$UseFile <- rep(TRUE, num_files)
  # choices are given dummy values: c('A', 'B', 'C', ...)
  checkbox_choices <- c(1:4) # LETTERS[1:num_files]
  # names are set to blank in a vector of same size as choices
  checkbox_names <- rep("", num_files)
  # Plot File options
  output$UseFile <- renderUI({
    checkbox_group <- generateCheckboxGroupUI(
      id = "UseFile", 
      choices = checkbox_choices,
      names = checkbox_names,
      selected = checkbox_choices[which(checkbox_states$UseFile)],
      label = "Files")
    
    checkbox_group
  })
  
  plot_df <- reactive({
    if (is.null(input$UseFile)) { 
      df <- NULL
    }else {
      df <- plot_data %>% filter(trial %in% input$UseFile)
    }
    df
  })
  
  # Create the three plots
  output$left_plot <- renderPlot({
    if (is.null(input$UseFile)) return(NULL)
    plot <- CreatePlot(df = plot_df(), index = 1)
    plot
  })
  
  output$middle_plot <- renderPlot({
    if (is.null(input$UseFile)) return(NULL)
    plot <- CreatePlot(df = plot_df(), index = 2)
    plot
  })
  
  output$right_plot <- renderPlot({
    if (is.null(input$UseFile)) return(NULL)
    plot <- CreatePlot(df = plot_df(), index = 3)
    plot
  })
  
} # Server

shinyApp(ui = ui, server = server)

相关问题