update readInfinieXMl to use start time as time for all wells

Author: dcangst

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rrobot
 Title: Useful R functions for the Tecan Freedom Evo
-Version: 1.2
+Version: 1.2.1
 Date: 2020-04-22
 Authors@R: as.person(c(
   "Daniel C Angst <[email protected]> [aut, cre]",
@@ -9,6 +9,7 @@ Authors@R: as.person(c(
 Description: functions for generating worklists and reading data from reader.
 Depends:
     R (>= 3.3.2),
+    rlang,
     xml2,
     XML,
     jsonlite,
@@ -24,4 +25,4 @@ License: file LICENCE
 URL: https://github.com/dcangst/rrobot
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.0

R/iControlFunctions.R

@@ -6,13 +6,14 @@
 #' @section Output:
 #'    \code{list} with data in longform format and parameters
 #' @export
-readInfiniteXML <- function(file){
+readInfiniteXML <- function(file) {
   data_xml <- withCallingHandlers(xml2::read_xml(file),
-    warning = function(w){
-      if (any(grepl("is not absolute", w))){
-        invokeRestart( "muffleWarning" )
+    warning = function(w) {
+      if (any(grepl("is not absolute", w))) {
+        invokeRestart("muffleWarning")
       }
-    })
+    }
+  )
 
   # plate name
   plate_name <- xml_text(xml_find_first(data_xml, "//Plate"), trim = TRUE)
@@ -21,38 +22,47 @@ readInfiniteXML <- function(file){
   measurementNames <- xml_attr(xml_find_all(data_xml, "//Section"), "Name")
   nMeasurement <- length(measurementNames)
 
-  #parameter
+  # parameter
   pars_node <- xml_find_all(data_xml, "//Section/Parameters")
-  parameter <- lapply(pars_node, function(x){
+  parameter <- lapply(pars_node, function(x) {
     .listToDf(xml_attrs(xml_children(x)))
   })
   names(parameter) <- measurementNames
 
-  #data
+  # data
   data <- xml_find_all(data_xml, "//Section/Data")
   data_nodes <- lapply(data, xml_children)
   data_attrs1 <- lapply(lapply(data_nodes, xml_attrs), .listToDf)
   data_values <- lapply(
     lapply(
-      lapply(data_nodes, xml_children), xml_text), .listToDf)
+      lapply(data_nodes, xml_children), xml_text
+    ), .listToDf
+  )
   names(data_values) <- c(measurementNames)
   data_values_df <- data.frame(data_values)
   data_values_df <- sapply(data_values_df, as.numeric)
   n_values <- dim(data_values_df)[1]
 
-  #times
+  # times
   time <- data.frame(
-    t_start = .convertXMLtime(xml_attr(xml_find_all(data_xml, "//Section"),
-      "Time_Start")),
-    t_end = .convertXMLtime(xml_attr(xml_find_all(data_xml, "//Section"),
-      "Time_End")),
-    name = str_c("time_", measurementNames))
-  times <- data.frame(plyr::dlply(time, ("name"),
-    function(x)(seq(x[, 1], x[, 2], length.out = n_values))))
+    t_start = .convertXMLtime(xml_attr(
+      xml_find_all(data_xml, "//Section"),
+      "Time_Start"
+    )),
+    t_end = .convertXMLtime(xml_attr(
+      xml_find_all(data_xml, "//Section"),
+      "Time_End"
+    )),
+    name = str_c("time_", measurementNames)
+  )
+  times <- data.frame(plyr::dlply(
+    time, ("name"),
+    function(x) (rep(x[, 1], times = n_values))
+  ))
 
-  #data.frame
+  # data.frame
   rows <- str_sub(data_attrs1[[1]]$Pos, 1, 1)
-  rows_n <- as.integer(sapply(rows, function(x){
+  rows_n <- as.integer(sapply(rows, function(x) {
     which(x == LETTERS)
   }))
   cols <- as.integer(str_sub(data_attrs1[[1]]$Pos, 2))
@@ -66,7 +76,8 @@ readInfiniteXML <- function(file){
     well = wells,
     data_values_df,
     times,
-    stringsAsFactors = FALSE)
+    stringsAsFactors = FALSE
+  )
   data <- data[order(data$well), ]
 
   return(list(data = as_tibble(data), parameter = parameter))
@@ -86,7 +97,7 @@ readInfiniteXML2 <- function(file) {
 
   measurements <- lapply(dataXML[which(names(dataXML) == "Section")], function(section) {
     attributesSection <- t(as.data.frame(section$.attrs)) %>%
-          as_tibble()
+      as_tibble()
     data <- lapply(
       section[which(names(section) == "Data")],
       function(data) {
@@ -96,46 +107,48 @@ readInfiniteXML2 <- function(file) {
           data[which(names(data) == "Well")],
           function(well) {
             unlist(well)
-          }) %>%
+          }
+        ) %>%
           bind_rows() %>%
           bind_cols(dataAttributes)
         if ("Time_Start" %in% names(measurements)) {
           measurements <- measurements %>%
             rename(Time_Start_Inc = Time_Start)
         }
         return(measurements)
-      }) %>%
+      }
+    ) %>%
       bind_rows() %>%
       bind_cols(attributesSection)
   })
   dataDf <- measurements$Section
 
   # format data
   rows <- str_sub(dataDf$.attrs.Pos, 1, 1)
-  rows_n <- as.integer(sapply(rows, function(x){
+  rows_n <- as.integer(sapply(rows, function(x) {
     which(x == LETTERS)
   }))
   cols <- as.integer(str_sub(dataDf$.attrs.Pos, 2))
   wells <- (rows_n - 1) * max(cols) + cols
 
   if ("Time_Start_Inc" %in% names(dataDf)) {
-     data <- dataDf %>%
-        transmute(
-          plate = dataXML$Plate$ID,
-          cycle = as.integer(Cycle),
-          tStart = lubridate::as_datetime(Time_Start) + lubridate::as.duration(Time_Start_Inc),
-          name = Name,
-          pos = .attrs.Pos,
-          row = rows,
-          col = cols,
-          well = wells,
-          value = as.numeric(Single.text)
-        )
+    data <- dataDf %>%
+      transmute(
+        plate = dataXML$Plate$ID,
+        cycle = as.integer(Cycle),
+        tStart = lubridate::as_datetime(Time_Start) + lubridate::as.duration(Time_Start_Inc),
+        name = Name,
+        pos = .attrs.Pos,
+        row = rows,
+        col = cols,
+        well = wells,
+        value = as.numeric(Single.text)
+      )
   } else {
     data <- dataDf %>%
       transmute(
         plate = dataXML$Plate$ID,
-        cycle =  as.integer(Cycle),
+        cycle = as.integer(Cycle),
         tStart = lubridate::as_datetime(Time_Start),
         name = Name,
         pos = .attrs.Pos,

R/rrobot.r

@@ -2,82 +2,82 @@
 #' A package containing tools for worklist generation for the freedom evo.
 #'
 #'
-#'@section base methods:
+#' @section base methods:
 #'
 #'      \code{\link{init}} - initialize a new worklist
 #'
 #'      \code{\link{write.gwl}} - write worklist
 #'
 #'      \code{\link{addToWorktable}} - add labware to worktable
-#' 
+#'
 #'      \code{\link{addToWorklist}} - add an arbitrary command
 #'
-#'@section Basic Worklist methods:
-#'      
+#' @section Basic Worklist methods:
+#'
 #'      \code{\link{aspirate}}
-#'      
+#'
 #'      \code{\link{dispense}}
-#'      
+#'
 #'      \code{\link{wash}}
-#'          
+#'
 #'      \code{\link{gwl_flush}}
-#'      
+#'
 #'      \code{\link{gwl_break}}
-#'      
+#'
 #'      \code{\link{distribute}}
 #'
-#'@section Advanced Worklist methods:
-#'      
+#' @section Advanced Worklist methods:
+#'
 #'      \code{\link{adv_aspirate}}
-#'      
+#'
 #'      \code{\link{adv_dispense}}
-#'      
+#'
 #'      \code{\link{adv_gwl_comment}}
 #'
 #'      \code{\link{adv_wash}}
 #'
 #'      \code{\link{adv_mix}}
-#' 
+#'
 #'      \code{\link{moveLiHa}}
-#' 
+#'
 #'      \code{\link{moveMCA}}
-#' 
+#'
 #'      \code{\link{MCAvector}}
-#' 
+#'
 #'      \code{\link{MCArelative}}
 #'
 #'      \code{\link{startTimer}}
 #'
 #'      \code{\link{waitTimer}}
 #'
 #'      \code{\link{sterile_wash}}
-#' 
+#'
 #'      \code{\link{fwCommand}}
 #'
-#'@section Worklist check methods:
-#' 
+#' @section Worklist check methods:
+#'
 #'      \code{\link{read_gwl}} - read in a gwl file
 #'
 #'      \code{\link{gwlToTable}} - produces a list of markdown tables with images
 #'
 #'      \code{\link{gwlToHTML}} - produces a HTML report of the worklist
 #'
-#'@section Reader methods:
-#' 
+#' @section Reader methods:
+#'
 #'      \code{\link{readInfiniteXML}} - returns data.frame, multiple reads
 #'
-#'@section Pickolo methods:
-#' 
+#' @section Pickolo methods:
+#'
 #'      \code{\link{readColonies}} - in which wells was there growth?
 #'
 #'      \code{\link{plotColonies}} - returns a ggplot plot of the plate & colonies
-#'      
-#'@section Data:
+#'
+#' @section Data:
 #'
 #'      \code{\link{basic}} - basic worktable layout at ETHZ as of 27.01.2015
 #'
 #'      \code{\link{ansi_table}} - look up table for ANSI (Windows-1252) characters (used in \code{\link{ANSIIFromWells}})
 #'
 #' @name rrobot
-#' @docType package
+#' @docType _PACKAGE
 NULL

exampleScript.R

@@ -88,8 +88,8 @@ for (iGroup in pipGroups){
       .groups = "drop"
       )
 
-  if (!all(tipVolumes$volume < 800)){
-    stop("volume too high")
+  if (!all(tipVolumes$volume < 800)) {
+    rlang::abort("volume too high")
   }
 
   # generate the tip mask (boolean vector, 0 = tip not used, 1 = tip used) and the volume mask (volume in ul)
@@ -130,14 +130,14 @@ for (iGroup in pipGroups){
         volume = volAdd,
         well = well,
         .groups = "drop")
-    
+
     # make masks
     masksCol <- generateMasks(tipVolumeCol$tip, tipVolumeCol$volume)
-    
+
     # write dispense command
     adv_dispense(
       tipMask       = masksCol$tip_mask,
-      volumes       = masksCol$vol_mask,
+      volumes       = c(masksCol$vol_mask, 4),
       RackLabel     = "MP3pos_mid",
       wellSelection = tipVolumeCol$well,
       ncol = 12, nrow = 8)