Skip to content

Commit

Permalink
Merge pull request #110 from EPPIcenter/jdi-updates
Browse files Browse the repository at this point in the history 
jdi: some cleanup + check new name in edit container dialog
  • Loading branch information
Brian Palmer authored Sep 12, 2022
2 parents d623c06 + a2d34f4 commit a42e02d
Show file tree
Hide file tree
Showing 4 changed files with 58 additions and 49 deletions.
2 changes: 1 addition & 1 deletion R/UploadSamples.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@ UploadSamples <- function(sample_type, upload_data, container_name, container_ba
conn = conn, container_name = container_name, freezer_address = freezer_address,
container_barcode = container_barcode)

return_message <- paste("Successfully uploaded\n", container_name, "with", nrow(upload_data), "sample", "to", "freezer address:\n", unlist(freezer_address, use.names=F))
return_message <- paste("Upload Successful!\nPlate", container_name, "with", nrow(upload_data), "sample(s) were added to freezer address:", paste(unlist(freezer_address, use.names=F), collapse = ", "), "\n")

#close connection
tryCatch(
Expand Down
38 changes: 26 additions & 12 deletions inst/sampleDB/server_helpers/AppMoveMicronixSamples.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,19 +106,33 @@ CreateEmptyMicronixPlate <- function(input, output, database){
# create empty micronix plate using user input
# use a "req" to require "CreateEmptyMicronixPlateID", "CreateEmptyMicronixPlateLocation", etc
# throw error if user uses name that is already in the database
conn <- RSQLite::dbConnect(RSQLite::SQLite(), database)
RSQLite::dbBegin(conn)
sampleDB:::.UploadMicronixPlate(conn = conn,
container_name = input[["CreateEmptyMicronixPlateID"]],
container_barcode = input[["CreateEmptyMicronixPlateBarcode"]],
freezer_address = list(location_name = input[["CreateEmptyMicronixPlateLocation"]],
level_I = input[["CreateEmptyMicronixPlateLevelI"]],
level_II = input[["CreateEmptyMicronixPlateLevelII"]]))
req(
input$CreateEmptyMicronixPlateID,
input$CreateEmptyMicronixPlateLocation,
input$CreateEmptyMicronixPlateLevelI,
input$CreateEmptyMicronixPlateLevelII
)

if (CheckTable(database = database, table = "matrix_plate") %>%
filter(input$CreateEmptyMicronixPlateID == plate_name) %>%
nrow(.) > 0) {
showNotification("Plate name exists!", id = "MoveNotification", type = "error", action = NULL, duration = 3, closeButton = TRUE)
} else {
conn <- RSQLite::dbConnect(RSQLite::SQLite(), database)
RSQLite::dbBegin(conn)
sampleDB:::.UploadMicronixPlate(conn = conn,
container_name = input[["CreateEmptyMicronixPlateID"]],
container_barcode = input[["CreateEmptyMicronixPlateBarcode"]],
freezer_address = list(location_name = input[["CreateEmptyMicronixPlateLocation"]],
level_I = input[["CreateEmptyMicronixPlateLevelI"]],
level_II = input[["CreateEmptyMicronixPlateLevelII"]]))

RSQLite::dbCommit(conn)
RSQLite::dbDisconnect(conn)
vals$data <- ""
removeModal()
RSQLite::dbCommit(conn)
RSQLite::dbDisconnect(conn)
vals$data <- ""
removeModal()
}

})

output$CreateEmptyMicronixPlateMessage <- renderPrint({
Expand Down
12 changes: 5 additions & 7 deletions inst/sampleDB/server_helpers/AppUploadMicronixSamples.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,14 +28,12 @@ MicronixUpload <- function(session, output, input, database){

users_upload_file <- read.csv(unformatted_file, header = F) %>% suppressWarnings() # will throw a pointless corrupt last line warning if file comes from excel

print(paste0("MicronixUpload: ", users_upload_file))

#check colnames of user provided file
UploadFileLogisticalColnameCheck <- CheckLogisticalColnamesOfUserProvidedMicronixFile(input = input, output = output, users_upload_file = users_upload_file, ui_elements = GetUIUploadElements("micronix"))
UploadFileMetadataColnameCheck <- CheckMetadataColnamesOfUserProvidedMicronixFile(input = input, output = output, users_upload_file = users_upload_file, ui_elements = GetUIUploadElements("micronix"))

validate(need(isTRUE(UploadFileLogisticalColnameCheck), "*** ERROR: Logistical column name check failed."))
validate(need(isTRUE(UploadFileMetadataColnameCheck), "*** ERROR: Metadata column name check failed."))
validate(need(isTRUE(UploadFileLogisticalColnameCheck), "Logistical column name check failed."))
validate(need(isTRUE(UploadFileMetadataColnameCheck), "Metadata column name check failed."))

#There have been bugs caused by empty colums
#Find and remove columns on upload
Expand All @@ -49,7 +47,7 @@ MicronixUpload <- function(session, output, input, database){
#reformat upload file
formatted_file <- FormatMicronixUploadData(database, input = input, users_upload_file = users_upload_file, ui_elements = GetUIUploadElements("micronix"))
#after formatting takes place, check upload data content
validate(need(!is.null(formatted_file), "*** ERROR: Formatting micronix upload data."))
validate(need(!is.null(formatted_file), "Formatting micronix upload data."))

CheckFormattedUploadFile(output = output, database = database, formatted_upload_file = formatted_file, ui_elements = GetUIUploadElements("micronix"))

Expand All @@ -66,11 +64,11 @@ MicronixUpload <- function(session, output, input, database){
removeNotification(id = "UploadNotification")
},
warning = function(w) {
output$UploadMicronixReturnMessage2 <- renderText({ paste("ERROR:", w$message) })
output$UploadMicronixReturnMessage2 <- renderText({ w$message })
message(w)
},
error = function(e) {
output$UploadMicronixReturnMessage2 <- renderText({ paste("*** ABORT:", e$message) })
output$UploadMicronixReturnMessage2 <- renderText({ paste("ERROR:", e$message) })
message(e)
},
finally = {}
Expand Down
55 changes: 26 additions & 29 deletions inst/sampleDB/server_helpers/AppUtilities.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -283,17 +283,15 @@ CheckLogisticalColnamesOfUserProvidedMicronixFile <- function(input, output, use
upload_file_type <- input[[ui_elements$ui.input$MicronixFileType]]
out <- sampleDB:::.CheckLogisticalColnamesOfUserProvidedMicronixFile(upload_file_type = upload_file_type, users_upload_file = users_upload_file)

output[[ui_elements$ui.output$WarningLogisticalColnames]] <- renderText({
if(upload_file_type == "visionmate"){
validate(need(out, "ERROR:\nMalformed Logictical Colnames (Valid VisionMate Column Names: LocationRow, LocationColumn, TubeCode)"))
}
else if(upload_file_type == "traxcer"){
validate(need(out, "ERROR:\nMalformed Logictical Colnames (Valid Traxcer Column Names: Position, Tube ID)"))
}
else{
validate(need(out, "ERROR:\nMalformed Logictical Colnames (Valid Column Names: MicronixBarcode, Row, Column)"))
}
})
if(upload_file_type == "visionmate"){
validate(need(out, "Malformed Logistical Colnames in Uploaded File (Valid VisionMate Column Names: LocationRow, LocationColumn, TubeCode)"))
}
else if(upload_file_type == "traxcer"){
validate(need(out, "Malformed Logistical Colnames in Uploaded File (Valid Traxcer Column Names: Position, Tube ID)"))
}
else{
validate(need(out, "Malformed Logistical Colnames in Uploaded File (Valid Column Names: MicronixBarcode, Row, Column)"))
}

return(out)
}
Expand All @@ -306,35 +304,24 @@ CheckMetadataColnamesOfUserProvidedMicronixFile <- function(input, output, users
#validate colnames of user provided file format and print user messages if file is not valid
upload_file_type <- input[[ui_elements$ui.input$MicronixFileType]]
out <- sampleDB:::.CheckMetadataColnamesOfUserProvidedMicronixFile(users_upload_file = users_upload_file, upload_file_type = upload_file_type)
output[[ui_elements$ui.output$WarningMetadataColnames]] <- renderText({
validate(need(out, "ERROR:\nMalformed Metadata Colnames (Valid Metadata Column Names: StudyCode, Participant, SpecimenType, [CollectionDate])"))
})

validate(need(out, "ERROR:\nMalformed Metadata Colnames (Valid Metadata Column Names: StudyCode, Participant, SpecimenType, [CollectionDate])"))
return(out)
}

CheckFormattedUploadFile <- function(output, database, formatted_upload_file, ui_elements){

message("Checking formatted data in file...")
# check valid specimen type

# Check that there are no empty cells, except for collection_date in cross sectional studies
ignored_columns <- c("comment") # always ignore the comment column if it exists
study <- filter(sampleDB::CheckTable(database = database, "study"), short_code %in% formatted_upload_file$study_short_code)
if (0 < nrow(study) && 0 == study$is_longitudinal) {
ignored_columns <- c(ignored_columns, "collection_date")
}

row_with_empty_cell <- rowSums(is.na(
formatted_upload_file[, !colnames(formatted_upload_file) %in% ignored_columns]))

out <- row_with_empty_cell[row_with_empty_cell != 0]
# check that there are no empty cells besides collection_date (checked later) and comment (may or may not exist)
df_invalid <- formatted_upload_file[rowSums(is.na(formatted_upload_file[!colnames(formatted_upload_file) %in% c("collection_date", "comment")])) > 0, ]

if (length(out) > 0) {
errmsg <- paste("Empty cell detected in rows:", paste(names(out), collapse = " "))
if (nrow(df_invalid) > 0) {
errmsg <- paste("Missing data for following sample barcode(s):", paste(df_invalid$MicronixBarcode, collapse = " "))
warning(errmsg)
}

# check valid specimen type

out <- sampleDB:::.CheckUploadSpecimenTypes(database = database, formatted_upload_file = formatted_upload_file)
if (!out) {
warning("Specimen Type Not found... Consider creating a new specimen type")
Expand Down Expand Up @@ -366,6 +353,16 @@ CheckFormattedUploadFile <- function(output, database, formatted_upload_file, ui
errmsg <- paste("Unique Barcode Constraint Failed:", paste(out$out2, collapse = " "))
warning(errmsg)
}

study <- filter(sampleDB::CheckTable(database = database, "study"), short_code %in% formatted_upload_file$study_short_code)
df_invalid <- formatted_upload_file %>%
inner_join(study, by = c("study_short_code" = "short_code")) %>%
filter(is_longitudinal == 1 & is.na(collection_date))

if (nrow(df_invalid) > 0) {
errmsg <- paste("Missing collection date for following sample barcode(s):", paste(df_invalid$MicronixBarcode, collapse = " "))
warning(errmsg)
}
}

CheckFormattedMoveFile <- function(output, database, sample_type, formatted_move_file_list){
Expand Down

0 comments on commit a42e02d

Please sign in to comment.