Fix: Plot rendering for row-column design

.Rbuildignore

@@ -42,3 +42,6 @@ $run_dev.*
 ^vignettes/incomplete_blocks\.Rmd$
 ^vignettes/rectangular_lattice\.Rmd$
 ^vignettes/square_lattice\.Rmd$
+^vignettes/sparse_allocation\.Rmd$
+^vignettes/optimized_arrangement\.Rmd$
+

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FielDHub
 Title: A Shiny App for Design of Experiments in Life Sciences
-Version: 1.4.1
+Version: 1.4.2
 Authors@R: 
        c(person(given = "Didier",
               family = "Murillo",

NAMESPACE

@@ -12,14 +12,12 @@ export(alpha_lattice)
 export(diagonal_arrangement)
 export(do_optim)
 export(full_factorial)
-export(improve_efficiency)
 export(incomplete_blocks)
 export(latin_square)
 export(multi_location_prep)
 export(optimized_arrangement)
 export(partially_replicated)
 export(rectangular_lattice)
-export(report_efficiency)
 export(row_column)
 export(run_app)
 export(sparse_allocation)
@@ -29,7 +27,6 @@ export(split_split_plot)
 export(square_lattice)
 export(strip_plot)
 export(swap_pairs)
-export(swap_treatments)
 import(shiny)
 importFrom(config,get)
 importFrom(dplyr,glimpse)

R/app_ui.R

@@ -17,7 +17,7 @@ app_ui <- function(request) {
   tagList(
     golem_add_external_resources(),
     fluidPage(theme = shinythemes::shinytheme("flatly"),
-              navbarPage(title = "FielDHub v1.4.1", 
+              navbarPage(title = "FielDHub v1.4.2", 
                          tabPanel(
                            " Welcome!", icon = icon("home", lib = "glyphicon"),
                             suppressWarnings(

R/fct_row_column.R

@@ -40,11 +40,12 @@
 #'
 #' @examples
 #' 
-#' # Example 1: Generates a row-column design with 3 full blocks and 36 treatments
+#' # Example 1: Generates a row-column design with 3 full blocks and 24 treatments
 #' # and 6 rows. This for one location.
-#' rowcold1 <- row_column(t = 36, nrows = 6, r = 3, l = 1, 
+#' rowcold1 <- row_column(t = 24, nrows = 6, r = 3, l = 1, 
 #'                        plotNumber= 101, 
 #'                        locationNames = "Loc1",
+#'                        iterations = 500,
 #'                        seed = 21)
 #' rowcold1$infoDesign
 #' rowcold1$resolvableBlocks
@@ -61,6 +62,7 @@
 #'                        plotNumber= c(101,1001), 
 #'                        locationNames = c("A", "B"),
 #'                        seed = 15,
+#'                        iterations = 500,
 #'                        data = treatment_list)
 #' rowcold2$infoDesign
 #' rowcold2$resolvableBlocks
@@ -164,7 +166,10 @@ row_column <- function(t = NULL, nrows = NULL, r = NULL, l = 1, plotNumber= 101,
         PLOT = plots, 
         ENTRY = treatments) |>
       dplyr::mutate(
-        REP = as.numeric(factor(REP, levels = unique(REP))),
+        REP = as.numeric(factor(REP, levels = unique(REP)))
+      ) |> 
+      dplyr::group_by(REP) |>
+      dplyr::mutate(
         COLUMN = as.numeric(factor(COLUMN, levels = unique(COLUMN))),
         ROW = as.numeric(factor(ROW, levels = unique(ROW)))
       ) |>
@@ -179,7 +184,7 @@ row_column <- function(t = NULL, nrows = NULL, r = NULL, l = 1, plotNumber= 101,
   out_row_col <- dplyr::bind_rows(out_row_col_loc)
   out_row_col$ENTRY <- as.numeric(out_row_col$ENTRY)
 
-  if(lookup) {
+  if (lookup) {
     out_row_col <- dplyr::inner_join(out_row_col, dataLookUp, by = "ENTRY")
     out_row_col <- out_row_col |> 
       dplyr::rename(TREATMENT = LABEL_TREATMENT) |> 
@@ -191,11 +196,10 @@ row_column <- function(t = NULL, nrows = NULL, r = NULL, l = 1, plotNumber= 101,
   ID <- 1:nrow(out_row_col)
   out_row_col_id <- cbind(ID, out_row_col)
 
+  out_row_col_id <- out_row_col_id[order(out_row_col_id$LOCATION, out_row_col_id$REP, out_row_col_id$ROW),]
   row_col_plots <- ibd_plot_numbers(nt = nt, plot.number = plotNumber, r = r, l = l)
   out_row_col_id$PLOT <- as.vector(unlist(row_col_plots))
 
-  # return(list(fieldBook = out_row_col_id, blocks_model = blocks_model))
-
   loc <- levels(out_row_col_id$LOCATION)
   ib <- nt/k
   Resolvable_rc_reps <- vector(mode = "list", length = r*l)

R/globals.R

@@ -32,4 +32,7 @@ utils::globalVariables(c("ENTRY",
                          "Times", 
                          "all_consecutive", 
                          "are_consecutive", 
-                         "plots", "arcbd_plot", "new_order_treatments"))
+                         "plots", "arcbd_plot", "new_order_treatments", 
+                         "LABEL_TREATMENT",
+                         "Level", 
+                         "Level_3"))

R/utils_plot_latinSQ.R

@@ -25,7 +25,7 @@ plot_latinSQ <- function(x = NULL, dims = NULL, n_Reps = NULL, layout = 1,
     plots <- NewBook$PLOT
     if (x$infoDesign$id_design == 9) {
       plots <- NewBook$PLOT
-      NewROWS1 <- rep(1:(rsRep*n_Reps), each = csRep)
+      NewROWS1 <- rep(1:(rsRep * n_Reps), each = csRep)
       NewCOLUMNS1 <- NewBook$COLUMN
       NewROWS2 <- NewBook$ROW
     } else if (x$infoDesign$id_design == 7) {

R/utils_row_col_optimization.R

@@ -1,6 +1,6 @@
 # Function to randomly swap a pair of treatments within a random 
 # level of Level_2 for all levels of Level_1
-#' @export
+#' @noRd
 swap_treatments <- function(df) {
   # Split the dataframe by Level_1
   df_split <- split(df, df$Level_1)
@@ -36,7 +36,7 @@ swap_treatments <- function(df) {
 }
 
 # Function to improve A-Efficiency for Level 2
-#' @export
+#' @noRd
 improve_efficiency <- function(design, iterations, seed) {
   set.seed(seed)
   # Initial design
@@ -76,7 +76,7 @@ improve_efficiency <- function(design, iterations, seed) {
 }
 
 # Function to calculate and return combined BlockEfficiencies
-#' @export
+#' @noRd
 report_efficiency <- function(design) {
   # Calculate row block efficiencies
   row_blocks <- design |>