new failsafes for phases and pyro compatibility

DESCRIPTION

@@ -8,7 +8,7 @@ BugReports: https://github.com/hugomflavio/pyroresp/issues
 License: GPL-3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Language: en-GB
 NeedsCompilation: no
 VignetteBuilder: knitr,

NAMESPACE

@@ -1,11 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
+export(assign_device_names)
 export(calc_bg)
 export(calc_delta)
 export(calc_mr)
 export(calc_slopes)
 export(check_phases)
 export(clean_meas)
+export(conv_w_to_ml)
 export(discard_phase)
 export(extract_mmr)
 export(extrapolate_bg)

R/aux_functions.R

@@ -42,6 +42,8 @@ check_arg_in_data <- function(arg, data, name, verbose = TRUE) {
 #' 
 #' @return a units object in ml
 #' 
+#' @export
+#' 
 conv_w_to_ml <- function(w, d = 1) {
   if (!inherits(w, "units")) {
     stop("w must be a units class object")
@@ -60,3 +62,64 @@ conv_w_to_ml <- function(w, d = 1) {
 
   return(x)
 }
+
+
+#' Assign device names after completing experiment
+#' 
+#' To use if you forgot to assign a device name at the start of the experiment.
+#' Goes through the raw data files, renames the required device names, and
+#' resaves the files.
+#' 
+#' NOTE: This function will modify the files in your data folder!
+#' 
+#' @inheritParams load_experiment
+#' @param assign_list A list of format device_letter = device_name for the
+#'  devices to rename based on their letter.
+#' 
+#' @return Nothing. Used for side effects.
+#' 
+#' @export
+#' 
+assign_device_names <- function(folder, assign_list) {
+	if (length(folder) == 0 || !dir.exists(folder)) {
+		stop('Could not find target folder')
+	}
+
+	if (length(folder) > 1) {
+		stop('"folder" should be a string of length 1.')		
+	}
+
+	files <- list.files(paste0(folder, '/ChannelData/'))
+
+	file_link <- grepl("Oxygen|pH", files)
+
+	if (all(!file_link)) {
+		stop('No probe files found')
+	}
+
+	files <- files[file_link]
+
+	capture <- lapply(files, function(i) {
+		the_file <- paste0(folder, '/ChannelData/', i)
+
+		x <- readLines(the_file)
+
+		r <- grep("^#Device", x)[1]
+
+		# identify device name and letter
+		device_name <- stringr::str_extract(x[r],'(?<=Device: )[^\\[]*')
+		device_name <- sub(" $", "", device_name)
+
+		device_letter <- 	stringr::str_extract(x[r],'(?<=\\[)[^\\]]*')
+
+		if (device_letter %in% names(assign_list)) {
+			x[r] <- sub(device_name, assign_list[[device_letter]], x[r])
+			writeLines(x, the_file)
+			message("Renamed device ", device_name, " [", device_letter , "] to ",
+							assign_list[[device_letter]])
+		} else {
+			message("Could not find match for device ", device_name,
+							" [", device_letter , "] in assign_list.")
+		}
+	})
+}

R/phases_functions.R

@@ -351,12 +351,17 @@ rename_phases <- function(input) {
 #' 
 merge_pyro_phases <- function(input) {
 	pyrodata <- input$pyro$compiled_data
-	pyrodata$phase <- NULL
 
 	phases <- input$phases
 
 	new_col_order <- 1
 
+	pyro_names <- colnames(pyrodata)
+	phase_names <- names(phases)
+
+	check_devices_match(colnames(pyrodata), names(phases))
+	check_probes_match(colnames(pyrodata), names(phases))
+
 	tmp <- lapply(1:length(phases), function(dvc) {
 		lapply(1:length(phases[[dvc]]), function(prb) {
 			# create column with placeholders
@@ -367,9 +372,9 @@ merge_pyro_phases <- function(input) {
 			for (i in 1:nrow(phases[[dvc]][[prb]])) {
 				check1 <- pyrodata$date_time >= phases[[dvc]][[prb]]$start[i]
 				check2 <- pyrodata$date_time <= phases[[dvc]][[prb]]$stop[i]
-				this.phase <- check1 & check2
+				this_phase <- check1 & check2
 
-				pyrodata[this.phase, new_col] <- phases[[dvc]][[prb]]$phase[i]
+				pyrodata[this_phase, new_col] <- phases[[dvc]][[prb]]$phase[i]
 			}
 
 			NA_check <- is.na(pyrodata[, new_col])
@@ -405,7 +410,6 @@ merge_pyro_phases <- function(input) {
 	return(input)
 }
 
-
 #' Replicate phases from one probe to others
 #' 
 #' Useful when using one flush pump for many chambers/probes
@@ -436,4 +440,57 @@ replicate_phases <- function(input,
 	}
 
 	return(input)
-}
+}
+
+#' confirm that the devices listed in the pyro input
+#' are present in the phases input
+#' 
+#' @param pyro_names A vector of column names from the compiled_data object
+#' @param phase_names the names of the phases list
+#' 
+#' @return nothing. Used for side effects
+#' 
+#' @keywords internal
+#' 
+check_devices_match <- function(pyro_names, phase_names) {
+	pyro_names <- pyro_names[!grepl("date_time", pyro_names)]
+	pyro_names <- stringr::str_extract(pyro_names, "(?<=_)[^$]*$")
+	device_names <- unique(sub("[0-9]$", "", pyro_names))
+	if( any(!(phase_names %in% device_names))) {
+		these <- !(phase_names %in% device_names)
+		stop("The could not find all the required device names in the ",
+			 "phases list. Are you sure you matched the names correctly? ",
+			 "Devices missing in phases input: ",
+			 paste(phase_names[these], collapse = ", "))
+	}
+}
+
+#' confirm that the probes listed for each device in the pyro input
+#' are present in the phases input
+#' 
+#' @param pyro_names A vector of column names from the compiled_data object
+#' @param phases The phases list.
+#' 
+#' @return nothing. Used for side effects
+#' 
+#' @keywords internal
+#' 
+check_probes_match <- function(pyro_names, phases) {
+	pyro_names <- pyro_names[!grepl("date_time", pyro_names)]
+	pyro_names <- stringr::str_extract(pyro_names, "(?<=_)[^$]*$")
+	device_names <- unique(sub("[0-9]$", "", pyro_names))
+	capture <- lapply(device_names, function(dvc) {
+		dvc_probes <- unique(pyro_names[grep(dvc, pyro_names)])
+		dvc_probes <- stringr::str_extract(dvc_probes, "[0-9]*$")
+		aux <- sub("ch", "", names(phases[[dvc]]))
+		if (any(!(dvc_probes %in% aux))) {
+			these <- !(dvc_probes %in% aux)
+			stop("The could not find all the required probes for device ",
+				 dvc, " in the phases input. Are you sure the phases file ",
+				 "contains phases for all the required probes? ",
+				 " Probes missing for device ", dvc, ": ",
+				 paste(dvc_probes[these], collapse = ", "))
+		}
+	})
+}
+

R/pyro_functions.R

@@ -141,7 +141,8 @@ read_pyro_raw_file <- function(file, date_format,
 	# identify device and channel name
 	aux <- readLines(file, n = 10)
 	aux <- aux[grepl("^#Device", aux)]
-	device <- stringr::str_extract(aux,'(?<= )[^ ]*')
+	device <- stringr::str_extract(aux,'(?<=Device: )[^\\[]*')
+	device <- sub(" $", "", device)
 	ch <- stringr::str_extract(file,'(?<=Ch.)[0-9]')
 
 	if (grepl("Oxygen\\.txt$", file) || grepl("pH\\.txt$", file)) {

R/wrappers.R

@@ -12,18 +12,25 @@
 #' 		- id     	    : The ID of the animal
 #' 		- mass   	    : The mass of the animal, in grams
 #' 		- volume 	    : The non-corrected volume of the chamber + tubing
-#' 		- probe  	    : The device-channel combination for the_probe
+#' 		- probe  	    : The device-channel combination for the probe
 #' 		- first_cycle : The first cycle of valid data for that animal
 #'
-#' @return A list containing a phases dataframe and a pyro dataframe.
+#' @return A list containing a phases dataframe and a pyro list with the
+#' 	individual source data frames (in source_data), as well as a single,
+#'  combined data frame organized by time (in compiled_data).
 #'
 #' @export
 #'
 load_experiment <- function(folder, date_format, tz = Sys.timezone(),
 		phases_file = "CoolTerm", probe_info, fix_phases = TRUE) {
 
-	if (length(folder) == 0 || length(folder) > 1 || !dir.exists(folder))
+	if (length(folder) == 0 || !dir.exists(folder)) {
 		stop('Could not find target folder')
+	}
+
+	if (length(folder) > 1) {
+		stop('"folder" should be a string of length 1.')		
+	}
 
 	phases_file <- list.files(folder)[grepl(phases_file, list.files(folder))]
 
@@ -41,6 +48,13 @@ load_experiment <- function(folder, date_format, tz = Sys.timezone(),
 
 	names(phases) <- stringr::str_extract(phases_file, '(?<=_)[^_]*(?=.txt)')
 
+	if (any(sapply(names(phases), length) > 4)) {
+		warning("Long device names detected in the phases input. Are you sure",
+				" you appended the device names correctly to the file name?",
+				" These are the current device names: ", 
+				paste(names(phases), collapse = ", "), ".")
+	}
+
 	output$phases <- phases
 	output$pyro <- load_pyro_data(folder, date_format = date_format, tz = tz)
 
@@ -88,8 +102,7 @@ load_pyro_data <- function(folder, date_format, tz) {
 	})))
 
 	recipient <- data.frame(date_time = seq(from = very_start,
-											to = very_end, by = 1),
-							phase = NA_character_)
+											to = very_end, by = 1))
 
 	for (i in source_data) {
 		new_piece <-  i[!duplicated(i$date_time), ]
@@ -148,7 +161,8 @@ process_experiment <- function(input, wait, convert_o2_unit_to,
 
 	if (!missing(convert_o2_unit_to) && !(convert_o2_unit_to %in% all_units)) {
 		stop("the 'convert_o2_unit_to' argument is not an acceptable unit. ",
-			"Please choose one of the following: ", paste(all_units, collapse = ", "))
+			 "Please choose one of the following: ", 
+			 paste(all_units, collapse = ", "))
 	}
 
 	if (!missing(min_temp) & !missing(max_temp)) {
@@ -166,7 +180,7 @@ process_experiment <- function(input, wait, convert_o2_unit_to,
 
 	if (verbose) message("M: Melting resp data into computer-friendly format")
   	input$melted <- melt_resp(input = input$phased, 
-  														probe_info = input$probe_info)
+  							  probe_info = input$probe_info)
 
 	if (verbose) message("M: Removing flush and wait values.")
   	input$cleaned <- clean_meas(input = input$melted, wait = wait)