How to create a numericinput widget in Shiny app to add new observations to existing data frame?

Question

sorry if this is repetitive and so simple it is annoying, but I am new to Shiny.

I need help with a shiny app I am trying to create for my golf game. I have loaded a CSV file with previous distance and accuracy observations to Rstudio and completed a script file with what will generally be done: data preprocessing and then visualizations.

I am now struggling with converting that to the app.R file, specifically, how to create a widget where I can add new numeric observations to the current data frame. The end goal is to use the app to log data as I play (practice or an actual round), which updates in real time for quick insight into the average distance and accuracy for each club.

Here is the very basic shiny code I have got to work for the numeric input:

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

I have found ways to include an 'add' button to a list, but what I am hoping to do is have the new numeric input be added to the specified variable (club, distance, accuracy) in the referenced dataset. This action would change the existing data, but add to it and grow the dataset over time.

Not sure if this helps for context at all, but below is the script file for preprocessing and visuals I described above:

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

Something I have found regarding the add button is the code here:

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

This does create an add button, which after updating the server code does create a list of added inputs, however I would like to be able to adjust the code for adding the observation to the variables in the data set.

I assume I would create an add button for each variable, just need to understand better how to do that.

Answer 1

The structure of your data used in the plot is not clear, but this is how to get the inputs or update dataset using eventReactive or observeEvent in the server. you can read this to learn the difference

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

the two output plots in your code have the same outputId

Answer 2

Follow UP to my Question: I have written the code for the ui, now I am still trying to figure out how to code the server properly so the distance and accuracy numeric inputs can be added to a data frame. That data frame will then be used to create the two visuals.

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)