qrcode setup

NEWS.md

@@ -18,7 +18,8 @@
 - Tarpuy
   - Change name of the trait tab from `abbreviation` to `trait`
   - Update traits tab for include two formats: `date` and `mcategorical`
-  - Fix sort of the traits in fielbook app
+  - Fix sort of the traits in field book app
+  - New option for generate the qr-code for each plot
 
 # inti 0.6.5
 

R/design_noreps.R

@@ -9,6 +9,7 @@
 #' @param nrows Experimental design dimension by rows [numeric: value]
 #' @param seed Replicability from randomization [numeric: NULL].
 #' @param fbname Bar code prefix for data collection [string: "inkaverse"].
+#' @param qrcode [string: "\{fbname\}\{plots\}\{factors\}"] String to concatenate the qr code.
 #'
 #' @return A list with the field-book design and parameters
 #' 
@@ -38,12 +39,13 @@
 #' }
 
 design_noreps <- function(factors
-                            , type = "sorted"
-                            , zigzag = FALSE
-                            , nrows = NA
-                            , serie = 100
-                            , seed = NULL
-                            , fbname = "inkaverse"
+                          , type = "sorted"
+                          , zigzag = FALSE
+                          , nrows = NA
+                          , serie = 100
+                          , seed = NULL
+                          , fbname = "inkaverse"
+                          , qrcode = "{fbname}{plots}{factors}"
                             ) {
 
   # factors <- factores
@@ -69,6 +71,17 @@ design_noreps <- function(factors
     unlist() %>% 
     length()/nrows; ncols <- ceiling(ncols)
 
+  # qr-code name
+
+  qrcolumns <- qrcode %>% 
+    gsub("factors", paste0(name.factors, collapse = "\\}\\{"), .) %>% 
+    strsplit(., split = "\\}\\{") %>% 
+    unlist() %>% 
+    gsub("\\{|\\}", "", .) %>% 
+    trimws()
+
+  # design
+
   fb <- dfactors %>% 
     expand.grid() %>% 
     dplyr::mutate(ntreat = as.numeric(row.names(.))) %>% 
@@ -95,8 +108,8 @@ design_noreps <- function(factors
     dplyr::select(.data$plots, .data$ntreat, {{name.factors}}, .data$sort, everything()) %>% 
     dplyr::mutate(across(.data$cols, as.numeric)) %>% 
     dplyr::mutate(fbname = fbname) %>% 
-    tidyr::unite("barcode", .data$fbname, .data$plots, {{name.factors}}, .data$rows, .data$cols
-                 , sep = "_", remove = F) %>% 
+    tidyr::unite("qrcode", any_of({{qrcolumns}}), sep = "_", remove = F) %>% 
+    dplyr::select(.data$qrcode, dplyr::everything()) %>% 
     dplyr::select(!c(.data$icols, .data$fbname)) 
 
   result <- list(

R/design_repblock.R

@@ -11,6 +11,7 @@
 #' @param nrows Experimental design dimension by rows [numeric: value]
 #' @param seed Replicability from randomization [numeric: NULL].
 #' @param fbname Bar code prefix for data collection [string: "inkaverse"].
+#' @param qrcode [string: "\{fbname\}\{plots\}\{factors\}"] String to concatenate the qr code.
 #'
 #' @return A list with the field-book design and parameters
 #' 
@@ -34,6 +35,7 @@
 #'                      , zigzag = T
 #'                      , seed = 0
 #'                      , nrows = 20
+#'                      , qrcode = "{fbname}{plots}{factors}"
 #'                      )
 #'                      
 #' dsg <- fb$fieldbook
@@ -54,9 +56,12 @@ design_repblock <- function(nfactors = 1
                             , serie = 100
                             , seed = NULL
                             , fbname = "inkaverse"
+                            , qrcode = "{fbname}{plots}{factors}"
                             ) {
 
-  # factors <- factores; nrows = 6
+  # nfactors = 2; factors = factores; type = "crd"; rep = 3
+  # zigzag = FALSE; nrows = NA; serie = 100; seed = NULL
+  # fbname = "inkaverse"; qrcode = "{fbname}{plot}{treat}"
 
   set.seed(seed)
 
@@ -65,7 +70,7 @@ design_repblock <- function(nfactors = 1
     purrr::map(base::unique) %>% 
     purrr::map(stats::na.omit) %>% 
     purrr::map(~gsub("[[:space:]]", ".", .)) %>% 
-    purrr::set_names(gsub("[[:space:]]", "." , names(.))) %>% 
+    purrr::set_names(gsub("[[:space:]]", "_" , names(.))) %>% 
     .[1:nfactors]
 
   nrowsfb <- dfactors %>% lengths() %>% prod()*rep
@@ -78,6 +83,16 @@ design_repblock <- function(nfactors = 1
 
   ncols <- nrowsfb/nrows; ncols <- ceiling(ncols)
 
+  # qr-code name
+
+  qrcolumns <- qrcode %>% 
+    gsub("factors", paste0(name.factors, collapse = "\\}\\{"), .) %>% 
+    strsplit(., split = "\\}\\{") %>% 
+    unlist() %>% 
+    gsub("\\{|\\}", "", .) %>% 
+    trimws()
+
+  # design
 
   if(type == "lsd") {
 
@@ -128,8 +143,8 @@ design_repblock <- function(nfactors = 1
     dplyr::select(.data$plots, .data$ntreat, {{name.factors}}, .data$sort, everything()) %>% 
     dplyr::mutate(across(.data$cols, as.numeric)) %>% 
     dplyr::mutate(fbname = fbname) %>% 
-    tidyr::unite("barcode", .data$fbname, .data$plots, {{name.factors}}, .data$rows, .data$cols
-                 , sep = "_", remove = F) %>% 
+    tidyr::unite("qrcode", any_of({{qrcolumns}}), sep = "_", remove = F) %>% 
+    dplyr::select(.data$qrcode, dplyr::everything()) %>% 
     dplyr::select(!c(.data$icols, .data$fbname)) 
 
   result <- list(

R/tarpuy_design.R

@@ -14,6 +14,7 @@
 #' @param seed Replicability of draw results (default = 0) always random. See
 #'   details.
 #' @param fbname Barcode prefix for data collection.
+#' @param qrcode [string: "\{fbname\}\{plots\}\{factors\}"] String to concatenate the qr code.
 #'
 #' @details The function allows to include the arguments in the sheet that have
 #'   the information of the design. You should include 2 columns in the sheet:
@@ -34,7 +35,7 @@
 #' library(gsheet)
 #' 
 #' url <- paste0("https://docs.google.com/spreadsheets/d/"
-#'               , "1_BVzChX_-lzXhB7HAm6FeSrwq9iKfZ39_Sl8NFC6k7U/edit#gid=1868565342")
+#'               , "1510fOKj0g4CDEAFkrpFbr-zNMnle_Hou9O_wuf7Vdo4/edit?gid=1479851579#gid=1479851579")
 #' # browseURL(url)
 #' 
 #' fb <- gsheet2tbl(url) 
@@ -55,6 +56,7 @@ tarpuy_design <- function(data
                           , serie = 100
                           , seed = NULL
                           , fbname = NA
+                          , qrcode = "{fbname}{plots}{factors}"
                           ) {
 
 plots <- Row.names <- factors <- where <- NULL
@@ -162,6 +164,9 @@ fbname <- if(is.null(arguments$fbname) || is.na(arguments$fbname) || arguments$f
   toupper() %>% 
   gsub("[[:space:]]", "-", .)
 
+qrcode <- if(is.null(arguments$fbname) || is.na(arguments$fbname) || arguments$fbname == "") { qrcode
+} else {arguments$qrcode} 
+
 # -------------------------------------------------------------------------
 
 factor_names <- dt_factors %>%
@@ -190,6 +195,7 @@ design <- if(nfactors == 1 & rep == 1) {
                 , serie = serie
                 , seed = seed
                 , fbname = fbname
+                , qrcode = qrcode
                 ) %>% purrr::pluck(1)
   } else {
 
@@ -203,6 +209,7 @@ design <- if(nfactors == 1 & rep == 1) {
       , serie = serie
       , seed = seed
       , fbname = fbname
+      , qrcode = qrcode
       )  %>% purrr::pluck(1)
 
 }

R/tarpuy_plex.R

@@ -30,6 +30,7 @@
 #' @param nrows Experimental design dimension by rows [numeric: value]
 #' @param serie Number of digits in the plots.
 #' @param seed Seed for the randomization.
+#' @param qrcode [string: "\{fbname\}\{plots\}\{factors\}"] String to concatenate the qr code.
 #'
 #' @details
 #'
@@ -76,6 +77,7 @@ tarpuy_plex <- function(data = NULL
                         , nrows = NA
                         , serie = 100
                         , seed = 0
+                        , qrcode = "{fbname}{plots}{factors}"
                          ) {
 
 
@@ -277,6 +279,7 @@ dsg_info <-  c(nfactors = nfactor
               , serie = serie
               , seed = seedset
               , fbname = barcode
+              , qrcode = qrcode
               ) %>%
   enframe() %>%
   rename('{arguments}' = .data$name, '{values}' = .data$value)