这是我第一个闪亮的代码。我已经把它简化成一个更像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)
1条答案
按热度按时间i86rm4rw1#
也许你在找这个