From de388b00fd28c1b7e0204d6423366b0c9e27e90f Mon Sep 17 00:00:00 2001 From: Didier Murillo Florez Date: Thu, 11 Apr 2024 09:30:19 -0500 Subject: [PATCH 1/2] fix: merge user input data in optim multi loc p-rep design --- R/fct_do_optim.R | 17 +++++++++-------- R/utils_diagonals_checks.R | 34 +++++++++++----------------------- 2 files changed, 20 insertions(+), 31 deletions(-) diff --git a/R/fct_do_optim.R b/R/fct_do_optim.R index e44c69c..b8d2742 100644 --- a/R/fct_do_optim.R +++ b/R/fct_do_optim.R @@ -680,18 +680,19 @@ merge_user_data <- function( ) |> dplyr::select(USER_ENTRY, ENTRY, NAME) |> dplyr::left_join(y = iter_loc, by = "ENTRY") - + if (inherits(optim_out, "MultiPrep")) { data_input_mutated <- data_input_mutated |> - dplyr::select(.data = ., USER_ENTRY, NAME.x, REPS) |> - dplyr::arrange(dplyr::desc(REPS)) |> - dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x) + dplyr::select(USER_ENTRY, NAME.x, REPS) |> # Just specify columns directly + dplyr::arrange(dplyr::desc(REPS)) |> # Arrange rows + dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x) # Rename columns } else if (inherits(optim_out, "Sparse")) { data_input_mutated <- data_input_mutated |> - dplyr::filter(.data = ., !is.na(NAME.y)) |> - dplyr::select(USER_ENTRY, NAME.x) |> - dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x) - } + dplyr::filter(!is.na(NAME.y)) |> # Filter rows + dplyr::select(USER_ENTRY, NAME.x) |> # Select columns + dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x) # Rename columns + } + # Store the number of plots (It does not include checks) df_to_check <- data_input_mutated[(input_checks + 1):nrow(data_input_mutated), ] if (inherits(optim_out, "MultiPrep")) { diff --git a/R/utils_diagonals_checks.R b/R/utils_diagonals_checks.R index 78ea187..2580ef2 100644 --- a/R/utils_diagonals_checks.R +++ b/R/utils_diagonals_checks.R @@ -116,12 +116,12 @@ total_elements <- function(alist) { length(unlist(alist)) } -#' @title Split Matrix Into Blocks +#' @title Split matrix Into sub matrices #' #' @description #' Splits a matrix into a list of blocks, either by rows or by columns, based on the specified sizes of the blocks. #' -#' @param Matrix A matrix to be split. +#' @param matrix_object A matrix to be split. #' @param blocks Either a list or a vector indicating the sizes of the blocks to be split into. #' If \code{blocks} is a list of vectors, each vector's length defines the size of the blocks. #' If \code{blocks} is a vector, each element represents the size of a block. @@ -129,9 +129,9 @@ total_elements <- function(alist) { #' by rows; otherwise, it is split by columns. #' @return A list of matrices, each representing a block. #' @noRd -split_matrix_into_blocks <- function(Matrix, blocks, byrow = TRUE) { +split_matrix_into_blocks <- function(matrix_object, blocks, byrow = TRUE) { - if (!is.matrix(Matrix)) { + if (!is.matrix(matrix_object)) { stop("Input must be a matrix.") } @@ -156,32 +156,20 @@ split_matrix_into_blocks <- function(Matrix, blocks, byrow = TRUE) { blocks_list = vector(mode="list", length=num_blocks) # Validate the total size against the matrix dimension before the loop - if (byrow && size != nrow(Matrix)) { - stop("Number of rows in 'Matrix' does not match 'blocks'") - } else if (!byrow && size != ncol(Matrix)) { - stop("Number of columns in 'Matrix' does not match 'blocks'") + if (byrow && size != nrow(matrix_object)) { + stop("Number of rows in 'matrix_object' does not match 'blocks'") + } else if (!byrow && size != ncol(matrix_object)) { + stop("Number of columns in 'matrix_object' does not match 'blocks'") } # Use a loop to populate the blocks_list based on the 'byrow' flag for (k in 1:num_blocks) { if (byrow) { - blocks_list[[k]] = Matrix[from[k]:to[k], , drop = FALSE] # Ensuring the result is always a matrix + blocks_list[[k]] = matrix_object[from[k]:to[k], , drop = FALSE] # Ensuring the result is always a matrix } else { - blocks_list[[k]] = Matrix[, from[k]:to[k], drop = FALSE] # Ensuring the result is always a matrix + blocks_list[[k]] = matrix_object[, from[k]:to[k], drop = FALSE] # Ensuring the result is always a matrix } } return(blocks_list) -} - -# for (k in 1:num_blocks) { -# if (byrow) { -# if (size != nrow(Matrix)) -# stop("\nNumber of rows in 'Matrix' doesn't match 'blocks'") -# blocks_list[[k]] = Matrix[from[k]:to[k],] -# } else { -# if (size != ncol(Matrix)) -# stop("\nNumber of columns in 'Matrix' doesn't match 'blocks'") -# blocks_list[[k]] = Matrix[,from[k]:to[k]] -# } -# } \ No newline at end of file +} \ No newline at end of file From 46edb29c32440cf349abef15aa8f86b354d6cc4e Mon Sep 17 00:00:00 2001 From: Didier Murillo Florez Date: Thu, 11 Apr 2024 09:34:46 -0500 Subject: [PATCH 2/2] Update DESCRIPTION file and app version --- DESCRIPTION | 2 +- R/app_ui.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 80601e0..7615cd9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FielDHub Title: A Shiny App for Design of Experiments in Life Sciences -Version: 1.3.7 +Version: 1.3.8 Authors@R: c(person(given = "Didier", family = "Murillo", diff --git a/R/app_ui.R b/R/app_ui.R index 507f373..c3b9fd5 100644 --- a/R/app_ui.R +++ b/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.3.7", + navbarPage(title = "FielDHub v1.3.8", tabPanel( " Welcome!", icon = icon("home", lib = "glyphicon"), suppressWarnings(