Matthew Rogers
Matthew Rogers

Reputation: 23

In R, the total of a column to be displayed on the dashboard that match the search bar. If nothing is in the search bar, then display the full total

I'm trying to make a basic shiny dashboard for my small company which can keep track of the parts in inventory. The code will make a db and have the function to be able to add and edit entries and I would like for the box in the dashboardSidebar to display the total of the quantity column for all matches that appear that match the search entry. The search would generally be trying to look up a specific "part number" to be able to figure out how many can then be pulled and from which previous order that was for, and to know how many in total of that part is in inventory.

I tried to Frankenstein some code I have used previously.

The Error I'm currently experiencing is a message in the dashboardSidebar Error: $ operator is invalid for atomic vectors

This is what I have tried so far, I am unable to get the outcome I am expecting. I have tried to change the filter_data function to try and go down the grepl, and contains avenues and am still unable to find the error in what is being done.

this is the code.

library(DBI)
library(RSQLite)

library(shiny)
library(DT)
library(RSQLite)
library(pool)
library(shinyjs)
library(uuid)
library(dplyr)
library(shinythemes)

library(shinyWidgets)

library(stringr)
library(shinydashboard)

#Create sql lite database
pool <- dbPool(RSQLite::SQLite(), dbname = "Inventorydb.sqlite")
a
#Create sql lite df
responses_df <- data.frame(row_id             = character(),
                           part_number        = character(),
                           order_number       = character(), 
                           quantity           = as.numeric(),
                           metal_finished     = character(),
                           anodized           = character(),
                           comments           = character(),
                           date               = as.Date(character()),
                           stringsAsFactors   = FALSE)




#Create responses table in sql database
dbWriteTable(pool, "responses_df", responses_df, overwrite = FALSE, append = TRUE)

#Label mandatory fields
labelMandatory <- function(label) {
  tagList(
    label,
    span("*", class = "mandatory_star")
  )
}

appCSS <- ".mandatory_star { color: red; }"

# ui
ui <- dashboardPage(
  dashboardHeader(title = "Company X"),
  dashboardSidebar(
    width = 250,
    box(
      title = "Total Quantity",
      width = "100%",
      solidHeader = TRUE,
      verbatimTextOutput("total_quantity"),
      footer = "Total Quantity",
      status = "primary"
    )
  ),
  dashboardBody(
    fluidRow(
      actionButton("add_button", "Add", icon("plus")),
      actionButton("edit_button", "Edit", icon("edit")),
      actionButton("copy_button", "Copy", icon("copy")),
      actionButton("delete_button", "Delete", icon("trash-alt"))
    ),
    fluidRow(
      dataTableOutput("responses_table")
    )
  )
)

#
#
#
#

server <- function(input, output, session) {
  
  
  #load responses_df and make reactive to inputs
  responses_df <- reactive({
    
    #make reactive to
    input$submit
    input$submit_edit
    input$copy_button
    input$delete_button
    
    dbReadTable(pool, "responses_df")
    
  })
  
  #List of mandatory fields for submission
  fieldsMandatory <- c("part_number", "order_number", "quantity", "metal_finished", "anodized")
  
  #define which input fields are mandatory
  observe({
    
    mandatoryFilled <-
      vapply(fieldsMandatory,
             function(x) {
               !is.null(input[[x]]) && input[[x]] != ""
             },
             logical(1))
    mandatoryFilled <- all(mandatoryFilled)
    
    shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
  })
  
  #Form for data entry
  entry_form <- function(button_id){
    
    showModal(
      modalDialog(
        div(id=("entry_form"),
            tags$head(tags$style(".modal-dialog{ width:500px}")),
            tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible}"))),
            fluidPage(
              fluidRow(
                textInput("part_number",
                          labelMandatory("Part Number"),
                          placeholder = "Enter Text...",
                          width = '456px')),
              fluidRow(
                textInput("order_number",
                          labelMandatory("Order Number"),
                          placeholder = "Enter Text...",
                          width = '456px')),
              selectInput("quantity", labelMandatory("Quantity Removed"), multiple = FALSE, choices = as.numeric(1:500)),
              splitLayout(
                cellWidths = c("226px", "226px"),
                cellArgs = list(style = "vertical-align: top"),
                selectInput("metal_finished", labelMandatory("Metal Finished?"), multiple = FALSE, choices = c("",
                                                                                                               "Yes",
                                                                                                               "No")),
                selectInput("anodized", labelMandatory("Anodized?"), multiple = FALSE, choices = c("",
                                                                                                   "Yes",
                                                                                                   "No")),
              ),
              
              textAreaInput("comments",
                            labelMandatory("Comments"),
                            placeholder = "Enter comments here...",
                            height = 200,
                            width = "456px"),
              helpText(labelMandatory(""),
                       paste("Mandatory field.")),
              actionButton(button_id, "Submit")
            ),
            easyClose = TRUE
        )
      )
    )
    
  }
  
  #
  fieldsAll <- c("part_number", "order_number", "quantity", "metal_finished", "anodized", "comments")
  
  #save form data into data_frame format
  formData <- reactive({
    
    formData <- data.frame(row_id              = UUIDgenerate(),
                           part_number         = input$part_number,
                           order_number        = input$order_number,
                           quantity            = input$quantity,
                           metal_finished      = input$metal_finished,
                           anodized            = input$anodized,
                           comments            = input$comments,
                           date                = as.character(format(Sys.Date(), format="%D")),
                           stringsAsFactors    = FALSE)
    return(formData)
    
  })
  
  #Add data
  appendData <- function(data){
    quary <- sqlAppendTable(pool, "responses_df", data, row.names = FALSE)
    dbExecute(pool, quary)
  }
  
  observeEvent(input$add_button, priority = 20,{
    
    entry_form("submit")
    
  })
  
  observeEvent(input$submit, priority = 20,{
    
    appendData(formData())
    shinyjs::reset("entry_form")
    removeModal()
    
  })
  
  #delete data
  deleteData <- reactive({
    
    SQL_df <- dbReadTable(pool, "responses_df")
    row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"]
    
    quary <- lapply(row_selection, function(nr){
      
      dbExecute(pool, sprintf('DELETE FROM "responses_df" WHERE "row_id" == ("%s")', nr))
    })
  })
  
  observeEvent(input$delete_button, priority = 20,{
    
    showModal(
      
      if(length(input$responses_table_rows_selected)>=1 ){
        modalDialog(
          title = "Are you sure?",
          #deleteData()                                                       #remove hash tag to give permission to delete data
        )
      })
    
    showModal(
      
      if(length(input$responses_table_rows_selected) < 1 ){
        modalDialog(
          title = "Warning",
          paste("Please select row(s)." ),easyClose = TRUE
        )
      })
  })
  
  #copy data
  unique_id <- function(data){
    replicate(nrow(data), UUIDgenerate())
  }
  
  copyData <- reactive({
    
    SQL_df <- dbReadTable(pool, "responses_df")
    row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"]
    SQL_df <- SQL_df %>% filter(row_id %in% row_selection)
    SQL_df$row_id <- unique_id(SQL_df)
    
    quary <- sqlAppendTable(pool, "responses_df", SQL_df, row.names = FALSE)
    dbExecute(pool, quary)
    
  })
  
  observeEvent(input$copy_button, priority = 20,{
    
    if(length(input$responses_table_rows_selected)>=1 ){
      copyData()
    }
    
    showModal(
      
      if(length(input$responses_table_rows_selected) < 1 ){
        modalDialog(
          title = "Warning",
          paste("Please select row(s)." ),easyClose = TRUE
        )
      })
    
  })
  
  #edit data
  observeEvent(input$edit_button, priority = 20,{
    
    SQL_df <- dbReadTable(pool, "responses_df")
    
    showModal(
      if(length(input$responses_table_rows_selected) > 1 ){
        modalDialog(
          title = "Warning",
          paste("Please select only one row." ),easyClose = TRUE)
      } else if(length(input$responses_table_rows_selected) < 1){
        modalDialog(
          title = "Warning",
          paste("Please select a row." ),easyClose = TRUE)
      })
    
    if(length(input$responses_table_rows_selected) == 1 ){
      
      entry_form("submit_edit")
      
      updateTextInput(session, "part_number", selected      = SQL_df[input$responses_table_rows_selected, "part_number"])
      updateTextInput(session, "order_number", selected     = SQL_df[input$responses_table_rows_selected, "order_number"])
      updateSelectInput(session, "quantity", selected       = SQL_df[input$responses_table_rows_selected, "quantity"])
      updateSelectInput(session, "metal_finished", value    = SQL_df[input$responses_table_rows_selected, "metal_finished"])
      updateSelectInput(session, "anodized", selected       = SQL_df[input$responses_table_rows_selected, "anodized"])
      updateTextAreaInput(session, "comments", value        = SQL_df[input$responses_table_rows_selected, "comments"])
      
    }
    
  })
  
  observeEvent(input$submit_edit, priority = 20, {
    
    SQL_df <- dbReadTable(pool, "responses_df")
    row_selection <- SQL_df[input$responses_table_row_last_clicked, "row_id"]
    dbExecute(pool, sprintf('UPDATE "responses_df" SET "part_number" = ?, "order_number" = ?, "quantity" = ?, "metal_finished" = ?, "anodized" = ?,
                            "comments" = ? WHERE "row_id" = ("%s")', row_selection),
              param = list(input$part_number,
                           input$order_number,
                           input$quantity,
                           input$metal_finished,
                           input$anodized,
                           input$comments))
    removeModal()
    
  })
  
  
  filtered_data <- reactive({
    data <- responses_df()
    
    # Apply filters based on search input and other conditions
    if (!is.null(input$responses_table_search$value)) {
      data <- data %>%
        filter(str_detect(order_number, input$responses_table_search$value))
    }
    
    # ... (other filtering conditions)
    
    return(data)
  })
  output$total_quantity <- renderText({
    total_filtered_quantity <- sum(filtered_data()$quantity, na.rm = TRUE)
    paste("Total Quantity: ", total_filtered_quantity)
  })
  
  
  
  
  output$responses_table <- DT::renderDataTable({
    table <- responses_df() %>% select(-row_id)
    names(table) <- c("Part Number", "Order Number", "Quantity", "Metal Finished", "Anodized", "Comments", "Date")
    
    
    datatable(
      table,
      rownames = FALSE,
      extensions = 'Buttons',
      options = list(
        dom = 'Bfrtip',
        buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
        searching = TRUE,
        lengthChange = TRUE,
        searchCols = list(NULL, NULL, NULL, NULL, NULL, NULL)  # Initialize search values for each column
      )
    )
  })
  
  
}

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

Upvotes: 1

Views: 33

Answers (0)

Related Questions