format_validation <- function(results){
### Format validation checks - these are run before data is saved for all tests
### during data entry. If they fail, the data won't be saved. The format checks
### are based on data types and settings selected during test creation. The main
### feature of format and logic checks are that they are internal to to a single
### test/result and can be determined without comparison to saved data. Format
### and logical checks should be used to check the raw data coming in is as
### expected not to convert, update, round or manipulate raw data. For instance,
### if data from a piece of equipment is expected to record data to two decimal
### points, a check should be in place to test this. But the data should not be
### rounded or extra decimals added. The data should be recorded as it is
### provided by laboratory machinery or direct observation without changes.
###
tests <- get_test()
name_test <- unique(as.character(results$test))
tests <- tests[tests$test == name_test,]
version <- max(tests$version)
tests <- tests[tests$test == name_test & tests$version == version,]
validate_test <- lapply(tests$question,function(question){
testquestion <- tests[tests$question == question,]
valid <- lapply(results$result_number[results$question == testquestion$question],function(result_number){
result_list <- results[results$result_number == result_number,]
result_list <- cbind(result_list,testquestion)
if(result_list$types == 'text box'){
result_list$result <- as.character(result_list$result)
result_valid_check <- is.character(result_list$result)
if(result_valid_check == TRUE){
result_list$valid_msg <- "Result is of class character"
result_list$result_msg <- "PASS"}
if(result_valid_check == FALSE){
result_list$valid_msg <- "Result is not of class character"
result_list$result_msg <- "FAIL"}
return(result_list[,c("question","result","types","sample_number","result_number","test","result_msg","valid_msg")])
}
if(result_list$types == 'numeric'){
result_list$result <- as.numeric(result_list$result)
result_valid_check <- is.numeric(result_list$result)
# ifelse(result_list$result == 11,result_valid_check_2 <- FALSE, result_valid_check_2 <- TRUE)
if(result_valid_check == TRUE){
result_list$valid_msg <- "PASS - Result is of class numeric"}
result_list$result_msg <- "PASS"
if(result_valid_check == FALSE){
result_list$valid_msg <- "FAIL - Result is not of class numeric"}
result_list$result_msg <- "FAIL"
return(result_list[,c("question","result","types","sample_number","result_number","test","result_msg","valid_msg")])
}
})
valid <- data.frame(do.call("rbind", valid))
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.