如何在 Shiny 应用程序中创建数字输入小部件以将新观察结果添加到现有数据框?

问题描述 投票:0回答:2

我需要帮助来开发我正在为我的高尔夫游戏创建的闪亮应用程序。我已将包含先前距离和精度观测值的 CSV 文件加载到 Rstudio,并完成了一个脚本文件,其中通常会执行以下操作:数据预处理,然后可视化。

我现在正在努力将其转换为 app.R 文件,特别是如何创建一个小部件,在其中我可以将新的数字观察添加到当前数据帧。最终目标是在我打球(练习或实际回合)时使用该应用程序记录数据,这些数据会实时更新,以便快速了解每个俱乐部的平均距离和准确性。

这是我必须为数字输入工作的非常基本的闪亮代码:

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')
  )`

这确实创建了一个添加按钮,在更新服务器代码后确实创建了添加输入的列表,但是我希望能够调整代码以将观察结果添加到数据集中的变量。

我假设我会为每个变量创建一个添加按钮,只需要更好地了解如何做到这一点。

r shiny numeric-input
2个回答
0
投票

图中使用的数据结构尚不清楚,但这是如何在服务器中使用

eventReactive
observeEvent
获取输入或更新数据集。 您可以阅读本文以了解其中的区别

server <- function(input, output) {
  distance <- eventReactive(input$addButton, {
    input$distInput
  }, ignoreInit = T, ignoreNULL = F)
  accbias <- eventReactive(input$accBiasButton, {
    input$accslider
  })
  distbias <- eventReactive(input$DistBiasButton, {
    input$distslider
  }, ignoreNULL=F)
  
  output$plot1 <- renderPlot({
    input$distInput
    mydist <- distance()
    # plot
  })
  output$plot2 <- renderPlot({
    input$distInput      # use the inputs here
    mydist <- distance() # or the reactives 
  })
}

代码中的两个输出图具有相同的

outputId


0
投票

跟进我的问题:我已经编写了用户界面的代码,现在我仍在尝试弄清楚如何正确地对服务器进行编码,以便可以将距离和精度数字输入添加到数据框中。然后该数据框将用于创建两个视觉效果。

library(shiny)
library(gridlayout)
library(DT)
library(tidyverse)

ui <- grid_page(
  layout = c(
    "title title title",
    "h1    h2    h3   ",
    "h4    h4    h5   "
  ),
  row_sizes = c(
    "100px",
    "0.86fr",
    "1.14fr"
  ),
  col_sizes = c(
    "250px",
    "0.71fr",
    "1.29fr"
  ),
  gap_size = "1rem",
  grid_card_text(
    area = "title",
    content = "My Golf Data",
    alignment = "center",
    is_title = FALSE
  ),
  grid_card(
    area = "h2",
    title = "Distance Input",
    numericInput(
      inputId = "distInput",
      label = "Distance",
      value = 50L,
      min = 50L,
      max = 400L,
      step = 15L
    ),
    actionButton(
      inputId = "addButton",
      label = "Add",
      width = "100%"
    )
  ),
  grid_card(
    area = "h1",
    title = "Club Select",
    radioButtons(
      inputId = "clubRadiobuttons",
      label = "",
      choices = list(
        Driver = "D",
        `5Wood` = "5W",
        `4H` = "4H",
        `5I` = "5I",
        `6I` = "6I",
        `7I` = "7I",
        `8I` = "8I",
        `9I` = "9I",
        PW = "PW",
        SW = "SW"
      ),
      width = "100%"
    )
  ),
  grid_card(
    area = "h3",
    title = "Accuracy",
    sliderInput(
      inputId = "accslider",
      label = "Accuracy Bias",
      min = -1L,
      max = 1L,
      value = 0L,
      width = "98%",
      step = 1L
    ),
    actionButton(
      inputId = "accBiasButton",
      label = "Add Acc Bias",
      width = "100%"
    ),
    sliderInput(
      inputId = "distslider",
      label = "Distance Bias",
      min = -1L,
      max = 1L,
      value = 0L,
      width = "100%",
      step = 1L
    ),
    actionButton(
      inputId = "DistBiasButton",
      label = "Add Dist Bias",
      width = "100%"
    )
  ),
  grid_card(
    area = "h5",
    title = "Average Club Distance",
    plotOutput(
      outputId = "plot",
      width = "100%",
      height = "400px"
    )
  ),
  grid_card(
    area = "h4",
    title = "Accuracy Average",
    plotOutput(
     outputId = "plot",
     width = "100%",
     height = "400px"
    )
  )
)

server <- function(input, output) {

}

shinyApp(ui, server)
© www.soinside.com 2019 - 2024. All rights reserved.