I'm trying to replace 2 columns in the existing shinyapp,but I received this error Warning: Error in $<-.data.frame: replacement has 1 row, data has 0, even though I didn't change anything in the dataset. I've just opened the dataset and did nothing, then saved that file and import that file in the shiny dashboard, but I received this error, I didn't know why!
this is the code to import the csv file, it has 2 options to choose the dataset, one is via local drive and another one is via Database, but I chose local drive.
observeEvent(input$remote_or_local, {
output$data_source_body_ui <- renderUI({
if (input$remote_or_local %% 2 != 0) {
ui <- fluidRow(
column(
12,
fileInput(
"data_source_input_file",
"Upload your file or drag and drop it here",
accept = ".csv"
)
),
column(
12, HTML(
paste0(
"Make sure that the first 9 columns contain these values in the same order<br>
<b>", dataColumnNamesString, "</b><br>",
"And the 'Date Time' Column is of this format '29-12-2019 18:52:27' (date-month-year hour:min:sec)"
)
)
)
)
} else {
config_table <<- selectDbQuery("SELECT * FROM config")
config_machine_options <- unique(config_table$Machine)
ui <- tags$div(
fluidRow(
column(3, pickerInput("config_machine", "Machine", config_machine_options, config_machine_options[1])),
column(3, pickerInput("config_customer", "Customer", "", "")),
column(3, pickerInput("config_family", "Family", "", "")),
column(3, pickerInput("config_model", "Model", "", ""))
),
tags$div(
id = 'admin_authentication_div',
fluidRow(
style = "margin-top: 20vh",
column(3, ""),
column(3, passwordInput('admin_password', '', placeholder = 'Enter admin password', width = "100%")),
column(1, actionButton('login_button', 'Login', style = buttonStyle)),
column(2, style = "margin-top: 23px", actionLink('password_change_button', 'Change password')),
column(3, "")
)
),
shinyjs::hidden(
tags$div(
id = 'admin_div',
fluidRow(
column(12, DTOutput("admin_editable_table"))
)
)
)
)
}
return(ui)
})
})
observeEvent(input$password_change_button, {
showModal(
modalDialog(
title = NULL, easyClose = TRUE, footer = NULL,
fluidRow(
align = "center",
column(12, passwordInput("password_reset_old_password", "Enter the Old Password")),
column(12, passwordInput("password_reset_new_password_1", "Enter a New Password")),
column(12, passwordInput("password_reset_new_password_2", "Confirm a New Password")),
column(12, actionButton("update_new_admin_password", "Update Password", style = buttonStyle))
)
)
)
})
observeEvent(input$update_new_admin_password, {
actual_admin_password <- selectDbQuery("SELECT * FROM config_table_master WHERE table_name = 'admin_password'")
if (digest(input$password_reset_old_password) != actual_admin_password$column_name) {
popUpWindow("The old password you entered is incorrect")
return()
}
if (input$password_reset_new_password_1 != input$password_reset_new_password_2) {{
popUpWindow("The new passwords do not match, please try again")
return()
}}
updateAdminPassword(digest(input$password_reset_new_password_1))
popUpWindow("The admin password has been changed")
})
observeEvent(c(input$config_machine, input$remote_or_local), {
if(!is.null(input$config_machine)){
config_table_filtered <- config_table %>% filter(Machine == input$config_machine)
config_customer_options <- unique(config_table_filtered$CUSTOMER)
updatePickerInput(session, "config_customer", choices = config_customer_options, selected = config_customer_options[1])
}
})
observeEvent(input$config_customer, {
if(!is.null(input$config_customer)){
config_table_filtered <- config_table %>% filter(Machine == input$config_machine) %>%
filter(CUSTOMER == input$config_customer)
config_family_options <- unique(config_table_filtered$FAMILY)
updatePickerInput(session, "config_family", choices = config_family_options, selected = config_family_options[1])
}
})
observeEvent(input$config_family, {
if(!is.null(input$config_family)){
config_table_filtered <- config_table %>% filter(Machine == input$config_machine) %>%
filter(CUSTOMER == input$config_customer) %>% filter(FAMILY == input$config_family)
config_model_options <- unique(config_table_filtered$MODEL)
updatePickerInput(session, "config_model", choices = config_model_options, selected = config_model_options[1])
}
})
observeEvent(input$config_model, {
if(!is.null(input$config_model)){
config_table_filtered <- config_table %>% filter(Machine == input$config_machine) %>%
filter(CUSTOMER == input$config_customer) %>% filter(FAMILY == input$config_family) %>%
filter(MODEL == input$config_model)
if (nrow(config_table_filtered) != 0) {
currentTableName <<- config_table_filtered$TABLE_NAME[1]
print(paste0("Fetching data from ", config_table_filtered$TABLE_NAME[1]))
lsl_usl_data <<- selectDbQuery("SELECT * FROM config_table_master WHERE table_name = ?", list(currentTableName))
mainData <<- tryCatch({
selectDbQuery(paste0("SELECT * FROM `", config_table_filtered$TABLE_NAME[1], "`")) %>% formatRemoteData()
}, error = function(err) {
popUpWindow("The data is not of the proper format, please select some other option.")
return(data.frame())
})
if (nrow(mainData) == 0) {
popUpWindow("The date format is not of the proper format, please select some other option.")
return()
}
minDate <<- as.Date(min(mainData$Date_Time), tz = "")
maxDate <<- as.Date(max(mainData$Date_Time), tz = "")
familyOptions <<- unique(mainData$Family)
custOptions <<- unique(mainData$Cust)
modelOptions <<- unique(mainData$Model)
resultOptions <<- unique(mainData$Result)
operatorOptions <<- unique(mainData$Opr)
machineOptions <<- unique(mainData$Machine)
hasDbConnection <<- TRUE
plots__trigger$trigger()
}
observeEvent(input$login_button, {
# req(input$admin_password)
req(input$config_machine)
req(input$config_customer)
req(input$config_family)
req(input$config_model)
lsl_usl_data <<- selectDbQuery("SELECT * FROM config_table_master WHERE table_name = ?", list(currentTableName))
actual_admin_password <- selectDbQuery("SELECT * FROM config_table_master WHERE table_name = 'admin_password'")
if (digest(input$admin_password) == actual_admin_password$column_name) {
lsl_usl_data_display <<- lsl_usl_data %>% select(-table_name)
output$admin_editable_table <- renderDT({
datatable(
lsl_usl_data_display,
rownames = FALSE,
editable = TRUE,
class = "cell-border stripe",
options = list(dom = 'tip', pageLength = -1)
)
})
admin_editable_table_output_proxy <- dataTableProxy("admin_editable_table")
observeEvent(input$admin_editable_table_cell_edit, {
info = input$admin_editable_table_cell_edit
this_id <- lsl_usl_data[info$row, "id"]
this_column_name <- lsl_usl_data[info$row, "column_name"]
update_column_name <- names(lsl_usl_data_display)[info$col+1]
updateUnitsTable(id = this_id, column_name = update_column_name, value = info$value)
lsl_usl_data[lsl_usl_data$id == this_id, update_column_name] <<- info$value
lsl_usl_data_display[lsl_usl_data_display$id == this_id, update_column_name] <<- info$value
# This might be optional
# replaceData(admin_editable_table_output_proxy, lsl_usl_data_display, resetPaging = FALSE, rownames = FALSE)
})
shinyjs::hide("admin_authentication_div", anim = TRUE)
shinyjs::show("admin_div", anim = TRUE)
} else {
popUpWindow("The password is incorrect")
}
})
}
})
observeEvent(input$data_source_input_file, {
inFile <- input$data_source_input_file
mainData <<- read.csv(inFile$datapath, stringsAsFactors = FALSE, header = TRUE) %>% formatLocalData()
minDate <<- as.Date(min(mainData$Date_Time), tz = "")
maxDate <<- as.Date(max(mainData$Date_Time), tz = "")
familyOptions <<- unique(mainData$Family)
custOptions <<- unique(mainData$Cust)
modelOptions <<- unique(mainData$Model)
resultOptions <<- unique(mainData$Result)
operatorOptions <<- unique(mainData$Opr)
machineOptions <<- unique(mainData$Machine)
mainData$Defects_Qty <<- 1
hasDbConnection <<- FALSE
plots__trigger$trigger()
})
```
this code contains global functions
formatData <- function(data) {
if ("id" %in% names(data)) {
idData <- data$id
data$id <- NULL
} else {
idData <- c(1:nrow(data))
}
if ("Machine" %in% names(data)) {
machineData <- data$Machine
data$Machine <- NULL
} else {
machineData <- "No Machine Name was specified!"
}
if ("Defects_Category" %in% names(data)) {
defectsCatData <- data$Defects_Category
data$Defects_Category <- NULL
} else {
defectsCatData <- ""
}
if ("cause" %in% names(data)) {
causeData <- data$cause
data$cause <- NULL
} else {
causeData <- rep(fishBoneSkeleton, nrow(data))
}
idAndMachineData <- data.frame(
id = idData,
Machine = machineData,
Defects_Category = defectsCatData,
stringsAsFactors = FALSE
)
idAndMachineData$cause <- causeData
data <- cbind(idAndMachineData, data)
data[, numericColumns] <- sapply(data[, numericColumns], as.numeric)
data$Opr[is.na(data$Opr)] <- "NA"
data$Date_Time <- as.POSIXct(data$Date_Time)
data$shift <- getShifts(data$Date_Time)
data$Date <- as.Date(data$Date_Time, tz = "")
data$Machine <- as.character(data$Machine)
data$Defects_Qty <- 1
return(data)
}
formatRemoteData <- function(data) {
names(data)[1:10] <- static_names
pass_regex <- "^[pP]|^(ok)|^(OK)|^(Ok)"
data$has_passed <- str_detect(data$Result, pass_regex)
data$Result[data$has_passed] <- passName
data$Result[!data$has_passed] <- failName
data$has_passed <- NULL
data$Date_Time <- as.POSIXct(data$Date_Time, format = "%d-%m-%Y %H:%M:%S")
data <- data %>% filter(!is.na(Date_Time))
data$shift <- getShifts(data$Date_Time)
data$Date <- as.Date(data$Date_Time, tz = "")
data$Defects_Qty <- 1
old_direction <- data$Direction
suppressWarnings(
data[,11:(ncol(data) - 5)] <- data.frame(lapply(data[,11:(ncol(data) - 5)], function(x) as.numeric(as.character(x))))
)
data$Direction <- old_direction
return(data)
}
formatLocalData <- function(data) {
id_data <- data.frame(
id = c(1:nrow(data))
)
data <- cbind(id_data, data)
names(data)[1:10] <- static_names
pass_regex <- "^[pP]|^(ok)|^(OK)|^(Ok)"
data$has_passed <- str_detect(data$Result, pass_regex)
data$Result[data$has_passed] <- passName
data$Result[!data$has_passed] <- failName
data$has_passed <- NULL
data$Date_Time <- as.POSIXct(data$Date_Time, format = "%d-%m-%Y %H:%M:%S")
data <- data %>% filter(!is.na(Date_Time))
data$shift <- getShifts(data$Date_Time)
data$Date <- as.Date(data$Date_Time, tz = "")
data$Defects_Qty <- 1
old_direction <- data$Direction
suppressWarnings(
data[,11:(ncol(data) - 5)] <- data.frame(lapply(data[,11:(ncol(data) - 5)], function(x) as.numeric(as.character(x))))
)
data$Direction <- old_direction
data$Opr[is.na(data$Opr)] <- ""
data$DEFECTS_CATEGORY <- ""
data$CAUSE <- ""
return(data)
}
