如何在Shiny应用中创建数值输入组件扩展高尔夫数据框

问题概述 #

我正在开发一款高尔夫运动的Shiny应用，已导入包含击球距离、精度历史数据的CSV文件，完成了数据预处理与可视化脚本。现在需要实现实时添加新击球数据到现有数据框的功能，记录练习/正式回合的数据，并能快速查看各球杆的平均距离与精度。目前已写出基础数值输入代码，也找到过添加数据到列表的按钮实现方式，但需要将新输入值关联到数据集的指定变量（球杆、距离、精度），实现数据集的持续扩展。

现有代码 #

基础Shiny代码 #

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
 titlePanel("Numeric Add Test"),
  column(3, 
        numericInput("num", 
                  h3("Numeric input"), 
                  value = 1,
                  min = 50,
                  max = 400,
                  step = 25))
)


# Define server logic required to draw a histogram
server <- function(input, output) {

}

# Run the application 
shinyApp(ui = ui, server = server)

预处理与可视化脚本 #

######### Golf Data Practice for App #############
## Read in Data set and address the column names starting with a number
Golfdata <- data.frame(read_csv("Shiny Apps/Golf Dataset .csv"))
Golfdata <- as.data.frame(Golfdata)

#Drop the last two columns for only clubs. Then create shot bias DF as well.
Clubs <- Golfdata %>% select(-c(11,12))
ShotBias <- Golfdata %>% select(c(11,12))



#Visualize the Average club distance
##Convert the club df by summarizing each variable by its average, 
## then use the gather() to convert to long instead of wide to finally
## prepare the df for visualizing. 

ClubAverage <- Clubs %>% summarise_all(mean) %>% gather(ClubAverage) %>%
  mutate_if(is.numeric, round, digits = 0)

library(ggplot2)
value <- ClubAverage$value

ggplot(ClubAverage) +
 aes(x = fct_reorder(ClubAverage, value, .desc = TRUE), y = value, label = value, 
     color = ClubAverage) +
 geom_col( show.legend = FALSE, fill = "white") +
 geom_text(nudge_y = 10, color = "black", size=4, fontface = "bold") +
 labs(x = "Club", 
 y = "Yards", title = "Average Club Distance") +
theme(panel.background = element_rect(fill="forestgreen"),
      panel.grid.major.x = element_blank(), 
      panel.grid.major = element_line(color = "yellow"),
      panel.grid.minor = element_line(color = "yellow1")) +
 theme(plot.title = element_text(size = 24L, 
 face = "bold", hjust = 0.5), axis.title.y = element_text(size = 18L, face = "bold"), axis.title.x =             
 element_text(size = 18L, 
 face = "bold"))

## Visualize the Average Accuracy ##
## This time, summarize the columns by their mean, 
## but keep as wide -- no gather() function needed.

AverageShotBias <- ShotBias %>% summarise_all(mean)

ggplot(AverageShotBias) +
 aes(x = Accuracy.Bias, y = Distance.Bias) +
 geom_point(shape = "circle filled", 
 size = 18L, fill = "yellow") +
 labs(x = "Accuracy", y = "Distance", title = "Average Shot Bias") +
 theme(panel.background = element_rect(fill="forestgreen")) +
 theme(plot.title = element_text(size = 24L, face = "bold", hjust = 0.5), axis.title.y =      
element_text(size = 14L, 
 face = "bold"), axis.title.x = element_text(size = 14L, face = "bold")) +
 xlim(-1, 1) +
 ylim(-1, 1) +
  geom_hline(yintercept = 0, size=1) +
  geom_vline(xintercept = 0, size=1)

找到的添加按钮代码片段 #

,actionButton('add','add')
    ,verbatimTextOutput('list')
  )

解决方案：完整可运行的app.R #

以下是整合了数据添加功能与实时可视化的完整代码：

library(shiny)
library(tidyverse)

# 初始化数据：读取历史CSV并整理格式
# 注意：替换为你的CSV文件路径
Golfdata <- read_csv("Shiny Apps/Golf Dataset .csv") %>% as.data.frame()
# 将宽格式的球杆数据转换为长格式，方便后续添加新数据
# 假设历史数据中前10列是不同球杆的距离，最后两列是Accuracy.Bias和Distance.Bias
# 这里需要根据你的实际列名调整，确保转换后的数据包含club、distance、accuracy_bias、distance_bias
long_golf_data <- Golfdata %>%
  pivot_longer(cols = 1:10, names_to = "club", values_to = "distance") %>%
  mutate(accuracy_bias = Accuracy.Bias, distance_bias = Distance.Bias) %>%
  select(club, distance, accuracy_bias, distance_bias) %>%
  drop_na() # 去除缺失值

ui <- fluidPage(
  titlePanel("高尔夫击球数据记录与分析"),
  fluidRow(
    # 左侧：数据输入区域
    column(4,
           h3("添加新击球数据"),
           selectInput("club_input", "选择球杆", choices = unique(long_golf_data$club)),
           numericInput("distance_input", "击球距离（码）", value = 100, min = 50, max = 400, step = 1),
           numericInput("accuracy_input", "精度偏差", value = 0, min = -1, max = 1, step = 0.05),
           numericInput("distance_bias_input", "距离偏差", value = 0, min = -1, max = 1, step = 0.05),
           actionButton("add_btn", "添加数据", class = "btn-primary"),
           hr(),
           h4("当前数据预览"),
           tableOutput("data_preview")
    ),
    # 右侧：可视化区域
    column(8,
           tabsetPanel(
             tabPanel("平均击球距离", plotOutput("distance_plot")),
             tabPanel("平均偏差", plotOutput("bias_plot"))
           )
    )
  )
)

server <- function(input, output, session) {
  # 使用reactiveVal存储可动态更新的数据框
  current_data <- reactiveVal(long_golf_data)
  
  # 处理添加数据的逻辑
  observeEvent(input$add_btn, {
    # 创建新数据行
    new_row <- tibble(
      club = input$club_input,
      distance = input$distance_input,
      accuracy_bias = input$accuracy_input,
      distance_bias = input$distance_bias_input
    )
    # 将新行追加到现有数据
    current_data(rbind(current_data(), new_row))
    # 清空输入框（可选）
    updateNumericInput(session, "distance_input", value = 100)
    updateNumericInput(session, "accuracy_input", value = 0)
    updateNumericInput(session, "distance_bias_input", value = 0)
  })
  
  # 输出数据预览
  output$data_preview <- renderTable({
    tail(current_data(), 10) # 显示最近10条数据
  })
  
  # 生成平均距离图表
  output$distance_plot <- renderPlot({
    club_avg <- current_data() %>%
      group_by(club) %>%
      summarise(average_distance = round(mean(distance), 0)) %>%
      ungroup()
    
    ggplot(club_avg) +
      aes(x = fct_reorder(club, average_distance, .desc = TRUE), y = average_distance, label = average_distance) +
      geom_col(show.legend = FALSE, fill = "white") +
      geom_text(nudge_y = 10, color = "black", size = 4, fontface = "bold") +
      labs(x = "球杆", y = "码数", title = "各球杆平均击球距离") +
      theme(panel.background = element_rect(fill = "forestgreen"),
            panel.grid.major.x = element_blank(),
            panel.grid.major = element_line(color = "yellow"),
            panel.grid.minor = element_line(color = "yellow1"),
            plot.title = element_text(size = 24, face = "bold", hjust = 0.5),
            axis.title.y = element_text(size = 18, face = "bold"),
            axis.title.x = element_text(size = 18, face = "bold"))
  })
  
  # 生成平均偏差图表
  output$bias_plot <- renderPlot({
    bias_avg <- current_data() %>%
      summarise(
        avg_accuracy = mean(accuracy_bias),
        avg_distance_bias = mean(distance_bias)
      )
    
    ggplot(bias_avg) +
      aes(x = avg_accuracy, y = avg_distance_bias) +
      geom_point(shape = "circle filled", size = 18, fill = "yellow") +
      labs(x = "精度偏差", y = "距离偏差", title = "平均击球偏差") +
      theme(panel.background = element_rect(fill = "forestgreen"),
            plot.title = element_text(size = 24, face = "bold", hjust = 0.5),
            axis.title.y = element_text(size = 14, face = "bold"),
            axis.title.x = element_text(size = 14, face = "bold")) +
      xlim(-1, 1) +
      ylim(-1, 1) +
      geom_hline(yintercept = 0, size = 1) +
      geom_vline(xintercept = 0, size = 1)
  })
}

shinyApp(ui = ui, server = server)

关键代码解释 #

• 动态数据存储：使用reactiveVal创建current_data，用来存储可实时更新的数据框，这是Shiny中实现数据动态修改的核心方式。
• 数据添加逻辑：通过observeEvent监听添加按钮的点击事件，将用户输入的新数据行追加到现有数据中，并更新current_data。
• 实时可视化：将原本的静态可视化代码放到renderPlot中，依赖current_data()，这样每次数据更新时，图表会自动重新渲染。
• UI优化：新增球杆选择下拉框（基于历史数据的球杆类型）、精度和距离偏差输入框，让数据输入更贴合实际需求。

内容的提问来源于stack exchange，提问作者Steve