Reputation: 23
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