From d890ab35049e73e8ed2d1e581c58122318765e43 Mon Sep 17 00:00:00 2001 From: Brian Bolt Date: Mon, 17 Jun 2024 15:30:44 -0700 Subject: [PATCH] ACAS-736: Append new experiment endpoints to protocol endpoints --- .../src/server/generic_data_parser.R | 51 ++++++++++++++----- 1 file changed, 39 insertions(+), 12 deletions(-) diff --git a/modules/GenericDataParser/src/server/generic_data_parser.R b/modules/GenericDataParser/src/server/generic_data_parser.R index 06d56853b..2623524f6 100644 --- a/modules/GenericDataParser/src/server/generic_data_parser.R +++ b/modules/GenericDataParser/src/server/generic_data_parser.R @@ -3673,19 +3673,14 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL, }) } - # Validate Experiment Columns against Protocol Endpoints - # only proceed if it associated with an existing protocol (the protocol is not new) - # also, only proceed if endpoint manager is enabled - - # We create experimentPassedEndpointValidation holding variable in case it is a new protocol and it is not assigned - # (Since we can't check if an empty variable is true or false later) - experimentPassedEndpointValidation <- FALSE + # Validate Experiment Columns against Protocol Endpoints when using existing protocol and endpoint manager is enabled + expProtocolEndpointValiation <- list(passed = FALSE, nonMatchingRows = data.frame()) if (!newProtocol && racas::applicationSettings$client.protocol.endpointManager.enabled) { # extract the endpoint data from the protocol object to check against protocolEndpointData <- getProtocolEndpointData(protocol) # Check the experiment columns against the protocolEndpointData - experimentPassedEndpointValidation <- validateExperimentColumns(selColumnOrderInfo, protocolEndpointData, getProtocolStrictEndpointMatching(protocol), protocol$lsLabels[[1]]$labelText) + expProtocolEndpointValiation <- validateExperimentColumns(selColumnOrderInfo, protocolEndpointData, getProtocolStrictEndpointMatching(protocol), protocol$lsLabels[[1]]$labelText) } # If there are errors, do not allow an upload @@ -3707,7 +3702,6 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL, validatedCustomMetaDataStates <- NULL customExperimentMetaDataValues <- NULL } - columnOrderStates <- createColumnOrderStates(selColumnOrderInfo, errorEnv, recordedBy, lsTransaction) @@ -3722,6 +3716,11 @@ runMain <- function(pathToGenericDataFormatExcelFile, reportFilePath=NULL, if (newProtocol) { protocol <- createNewProtocol(metaData = validatedMetaData, lsTransaction, recordedBy, columnOrderStates) + } else { + # If the protocol has passed endpoint validation and we are not in a dry run, update the protocol with any new endpoints + if (expProtocolEndpointValiation$passed && nrow(expProtocolEndpointValiation$nonMatchingRows) > 0) { + protocol <- updateColumnOrderStates(protocol, "protocols", expProtocolEndpointValiation$nonMatchingRows, errorEnv, recordedBy, lsTransaction) + } } } @@ -4257,7 +4256,7 @@ getProtocolEndpointData <- function(protocol) { #go through the protocol data to wrangle the endpoint data into the dataframe for (lsState in protocol$lsStates) { - if (lsState[['lsKind']] == "data column order") { + if (lsState$ignored != TRUE && lsState$deleted != TRUE && lsState[['lsKind']] == "data column order") { #if the name/units/data type cant be found, submit a NA columnNameEntry = NA @@ -4357,6 +4356,7 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr # Returns TRUE/FALSE (whether the experiment passed validation) experimentPassedValidation = TRUE + nonMatchingRows <- data.frame() for (experimentRowNum in seq(1, nrow(selColumnOrderInfo))) { experimentRowData <- selColumnOrderInfo[experimentRowNum,] @@ -4406,6 +4406,7 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr if (experimentRowMatchesEndpoint == FALSE) { # If strict endpoint matching is enabled, we throw an error, otherwise we throw a warning + nonMatchingRows <- rbind(nonMatchingRows, experimentRowData) if (protocolStrictEndpointMatchingEnabled == TRUE) { addError(paste0("The result type '", experimentRowName, "' with data type '", experimentRowDataType, "' and units '", experimentRowUnits, "' is not one of the allowed result types for this ", racas::applicationSettings$client.protocol.label, ". Please revise your file or contact an ACAS administrator to update the allowed result types for this ", racas::applicationSettings$client.protocol.label, ".")) @@ -4416,10 +4417,9 @@ validateExperimentColumns <- function(selColumnOrderInfo, protocolEndpointDataFr warnUser(paste0("The result type '", experimentRowName, "' with data type '", experimentRowDataType, "' and units '", experimentRowUnits, "' is not configured for this ", racas::applicationSettings$client.protocol.label, ". If this is expected, you may proceed with the upload. Otherwise contact an ACAS Administrator to update the configured result types for this ", racas::applicationSettings$client.protocol.label ,".")) } } - } - return(experimentPassedValidation) + return(list(passed = experimentPassedValidation, nonMatchingRows = nonMatchingRows)) } getProtocolStrictEndpointMatching <- function(protocol) { @@ -4783,3 +4783,30 @@ createColumnOrderStates <- function(exptDataColumns=selColumnOrderInfo, errorEnv } return(experimentStates) } +updateColumnOrderStates <- function(entity, acasCategory, columnOrderRows, errorEnv, recordedBy, lsTransaction){ + # Check if the entity has a column order state, if it does, update it, if not, create it + # Returns the updated or created state + columnOrderStates <- getStatesByTypeAndKind(entity, "metadata_data column order") + + if(length(columnOrderStates) > 0) { + # If the column order state > 0 then find the highest "column order" and update the selected column order info + columnOrders <- sapply(columnOrderStates, getValuesByTypeAndKind, typeAndKind = "numericValue_column order") + maxOrder <- max(unlist(lapply(columnOrders, function(x) x$numericValue))) + } else { + maxOrder <- 0 + } + + # Apply the max order to the new column order info + columnOrderRows$order <- maxOrder + 1:nrow(columnOrderRows) + + # Create the new column order states + newColumnOrderStates <- createColumnOrderStates(columnOrderRows, errorEnv, recordedBy, lsTransaction) + + # Append the new column order states to the entity + entity$lsStates <- c(entity$lsStates, newColumnOrderStates) + + # Update the entity + updatedEntity <- rjson::fromJSON(updateAcasEntity(entity, acasCategory)) + + return(updatedEntity) +} \ No newline at end of file