Merge pull request #46 from DidierMurilloF/didier/remove-turner-depen…

…dency

Update DESCRIPTION file.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FielDHub
 Title: A Shiny App for Design of Experiments in Life Sciences
-Version: 1.3.4
+Version: 1.3.7
 Authors@R: 
  c(person(given = "Didier",
  family = "Murillo",
@@ -39,7 +39,7 @@ Authors@R:
 Description: A shiny design of experiments (DOE) app that aids in the creation of traditional, 
  un-replicated, augmented and partially-replicated designs applied to agriculture, 
  plant breeding, forestry, animal and biological sciences.
-Depends: R (>= 3.6.0)
+Depends: R (>= 4.1.0)
 License: MIT + file LICENSE
 Imports: 
  config,
@@ -48,13 +48,10 @@ Imports:
  htmltools,
  DT,
  shinythemes,
- turner,
  dplyr,
- shinyjqui,
  numbers,
  blocksdesign,
  shinycssloaders,
- magrittr,
  ggplot2,
  plotly,
  viridis,

Dockerfile

@@ -37,13 +37,10 @@ RUN R -q -e "install.packages('golem')"
 RUN R -q -e "install.packages('htmltools')"
 RUN R -q -e "install.packages('DT')"
 RUN R -q -e "install.packages('shinythemes')"
-RUN R -q -e "install.packages('turner')"
 RUN R -q -e "install.packages('dplyr')"
-RUN R -q -e "install.packages('shinyjqui')"
 RUN R -q -e "install.packages('numbers')"
 RUN R -q -e "install.packages('blocksdesign')"
 RUN R -q -e "install.packages('shinycssloaders')"
-RUN R -q -e "install.packages('magrittr')"
 RUN R -q -e "install.packages('ggplot2')"
 RUN R -q -e "install.packages('plotly')"
 RUN R -q -e "install.packages('viridis')"

NAMESPACE

@@ -5,7 +5,6 @@ S3method(print,FielDHub)
 S3method(print,fieldLayout)
 S3method(print,summary.FielDHub)
 S3method(summary,FielDHub)
-export("%>%")
 export(CRD)
 export(RCBD)
 export(RCBD_augmented)
@@ -40,7 +39,6 @@ importFrom(htmltools,HTML)
 importFrom(htmltools,tagAppendAttributes)
 importFrom(htmltools,tagList)
 importFrom(htmltools,tags)
-importFrom(magrittr,"%>%")
 importFrom(shiny,NS)
 importFrom(shiny,column)
 importFrom(shiny,shinyApp)

R/fct_diagonal_arrangement.R

@@ -690,9 +690,9 @@ unrep_data_parameters <- function(
  )
  # Generate the lists of entries for each location
  for (site in unique(gen_list$LOCATION)) {
- df_loc <- gen_list %>% 
- dplyr::filter(LOCATION == site) %>% 
- dplyr::mutate(ENTRY = as.numeric(ENTRY)) %>% 
+ df_loc <- gen_list |> 
+ dplyr::filter(LOCATION == site) |> 
+ dplyr::mutate(ENTRY = as.numeric(ENTRY)) |> 
  dplyr::select(ENTRY, NAME) 
 
  list_locs[[site]] <- df_loc

R/fct_do_optim.R

@@ -171,18 +171,18 @@ do_optim <- function(
  colnames(allocation_df) <- paste0("LOC", 1:l)
  # Create a wide data frame with number of copies and average per plant
  col_sum <- base::colSums(allocation_df)
- wide_allocation <- allocation_df %>%
+ wide_allocation <- allocation_df |>
  dplyr::mutate(
- copies = rowSums(.),
+ copies = rowSums(dplyr::across(dplyr::everything())),
  avg = copies / l
  )
  # Create a long data frame with the allocations per location
- long_allocation <- as.data.frame(allocation) %>%
- dplyr::rename_with(~c("ENTRY", "LOCATION", "REPS"), dplyr::everything()) %>% # rename columns
+ long_allocation <- as.data.frame(allocation) |>
+ dplyr::rename_with(~c("ENTRY", "LOCATION", "REPS"), dplyr::everything()) |> # rename columns
  dplyr::mutate(
  LOCATION = gsub("B", "LOC", LOCATION),
  NAME = paste0("G-", ENTRY)
- ) %>% 
+ ) |> 
  dplyr::select(LOCATION, ENTRY, NAME, REPS)
  # Create a data frame for the checks
  if (design != "prep") {
@@ -212,20 +212,20 @@ do_optim <- function(
  )
  # Generate the lists of entries for each location
  for (site in unique(long_allocation$LOCATION)) {
- df_loc <- long_allocation %>% 
- dplyr::filter(LOCATION == site, REPS > 0) %>% 
- dplyr::mutate(ENTRY = as.numeric(ENTRY)) %>% 
- dplyr::select(ENTRY, NAME, REPS) %>%
- dplyr::bind_rows(df_checks) %>%
+ df_loc <- long_allocation |> 
+ dplyr::filter(LOCATION == site, REPS > 0) |> 
+ dplyr::mutate(ENTRY = as.numeric(ENTRY)) |> 
+ dplyr::select(ENTRY, NAME, REPS) |>
+ dplyr::bind_rows(df_checks) |>
  dplyr::arrange(dplyr::desc(ENTRY)) 
 
  if (design == "prep") {
- df_loc <- df_loc %>% 
+ df_loc <- df_loc |> 
  dplyr::arrange(dplyr::desc(REPS))
  }
 
  if (design != "prep") {
- df_loc <- df_loc %>% 
+ df_loc <- df_loc |> 
  dplyr::select(ENTRY, NAME)
  }
 
@@ -235,13 +235,13 @@ do_optim <- function(
  # Combine the data frames into a single data frame with a new column for the list element name
  multi_location_data <- dplyr::bind_rows(lapply(names(list_locs), function(name) {
  dplyr::mutate(list_locs[[name]], LOCATION = name)
- })) %>% 
+ })) |> 
  dplyr::select(LOCATION, ENTRY, NAME, REPS)
  } else {
  # Combine the data frames into a single data frame with a new column for the list element name
  multi_location_data <- dplyr::bind_rows(lapply(names(list_locs), function(name) {
  dplyr::mutate(list_locs[[name]], LOCATION = name)
- })) %>% 
+ })) |> 
  dplyr::select(LOCATION, ENTRY, NAME)
  }
  # out object with the allocation and the list of entries per location
@@ -673,24 +673,25 @@ merge_user_data <- function(
  # Merge each optimized location into the user data input
  for (LOC in locs_range) {
  iter_loc <- optim_out$list_locs[[LOC]]
- data_input_mutated <- user_data_input %>%
- dplyr::mutate(
- USER_ENTRY = ENTRY,
- ENTRY = vlookup_entry
- ) %>%
- dplyr::select(USER_ENTRY, ENTRY, NAME) %>%
- dplyr::left_join(y = iter_loc, by = "ENTRY") %>% 
- {
- if (inherits(optim_out, "MultiPrep")) {
- dplyr::select(.data = ., USER_ENTRY, NAME.x, REPS) %>%
- dplyr::arrange(dplyr::desc(REPS)) %>%
- dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x)
- } else if (inherits(optim_out, "Sparse")) {
- dplyr::filter(.data = ., !is.na(NAME.y)) %>% 
- dplyr::select(USER_ENTRY, NAME.x) %>%
- dplyr::rename(ENTRY = USER_ENTRY, NAME = NAME.x)
- } 
- }
+ data_input_mutated <- user_data_input |>
+ dplyr::mutate(
+ USER_ENTRY = ENTRY,
+ ENTRY = vlookup_entry
+ ) |>
+ 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)
+ } 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)
+ } 
  # 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")) {

R/fct_incomplete_blocks.R

@@ -145,23 +145,23 @@ incomplete_blocks <- function(t = NULL, k = NULL, r = NULL, l = 1, plotNumber =
  }
  # Apply check_consecutive function to each Level_2 group
  raw_design <- as.data.frame(mydes$Design)
- raw_design <- raw_design %>%
+ raw_design <- raw_design |>
  dplyr::mutate(
  Level_1 = as.character(Level_1),
  Level_2 = as.character(Level_2),
  plots = as.integer(plots),
  treatments = as.integer(treatments)
  )
- results <- raw_design %>%
- dplyr::group_by(Level_1, Level_2) %>%
- dplyr::summarise(are_consecutive = check_consecutive(treatments), .groups = "drop") %>%
- dplyr::group_by(Level_1) %>%
+ results <- raw_design |>
+ dplyr::group_by(Level_1, Level_2) |>
+ dplyr::summarise(are_consecutive = check_consecutive(treatments), .groups = "drop") |>
+ dplyr::group_by(Level_1) |>
  dplyr::summarise(all_consecutive = all(are_consecutive))
 
  # Filter Level_1 where all Level_2 levels have consecutive treatments
- consecutive_levels <- results %>%
- dplyr::filter(all_consecutive) %>%
- dplyr::pull(Level_1) %>%
+ consecutive_levels <- results |>
+ dplyr::filter(all_consecutive) |>
+ dplyr::pull(Level_1) |>
  unique()
 
  consecutive_levels_level_1 <- consecutive_levels
@@ -170,7 +170,7 @@ incomplete_blocks <- function(t = NULL, k = NULL, r = NULL, l = 1, plotNumber =
  rep_to_drop <- consecutive_levels_level_1[1]
  mydes$Design <- dplyr::filter(raw_design, Level_1 != rep_to_drop)
  } else {
- mydes$Design <- raw_design %>%
+ mydes$Design <- raw_design |>
  dplyr::filter(Level_1 != paste0("B", r + 1)) 
  }
  } else {

R/fct_partially_replicated.R

@@ -204,10 +204,10 @@ partially_replicated <- function(
  )
  # Generate the lists of entries for each location
  for (site in unique(gen_list$LOCATION)) {
- df_loc <- gen_list %>% 
- dplyr::filter(LOCATION == site) %>% 
- dplyr::mutate(ENTRY = as.numeric(ENTRY)) %>% 
- dplyr::select(ENTRY, NAME, REPS) %>%
+ df_loc <- gen_list |> 
+ dplyr::filter(LOCATION == site) |> 
+ dplyr::mutate(ENTRY = as.numeric(ENTRY)) |> 
+ dplyr::select(ENTRY, NAME, REPS) |>
  dplyr::arrange(dplyr::desc(REPS))
 
  if (length(df_loc$ENTRY) != length(unique(df_loc$ENTRY))) {

R/mod_Alpha_Lattice.R

@@ -198,7 +198,7 @@ mod_Alpha_Lattice_server <- function(id){
  type = "error")
  return(NULL)
  } else return(init_data_alpha())
- }) %>%
+ }) |>
  bindEvent(input$RUN.alpha)
 
  alpha_inputs <- reactive({
@@ -234,7 +234,7 @@ mod_Alpha_Lattice_server <- function(id){
  sites = sites,
  site_names = site_names,
  seed = seed))
- }) %>%
+ }) |>
  bindEvent(input$RUN.alpha)
 
 
@@ -260,9 +260,7 @@ mod_Alpha_Lattice_server <- function(id){
  observeEvent(toListen(), {
  if (input$owndata_alpha == "Yes") {
  showModal(
- shinyjqui::jqui_draggable(
- entriesInfoModal_ALPHA()
- )
+ entriesInfoModal_ALPHA()
  )
  }
  })
@@ -430,9 +428,7 @@ mod_Alpha_Lattice_server <- function(id){
  req(input$r.alpha)
  req(reactive_layoutAlpha()$fieldBookXY)
  showModal(
- shinyjqui::jqui_draggable(
- simuModal.alpha()
- )
+ simuModal.alpha()
  )
  })
 
@@ -452,9 +448,7 @@ mod_Alpha_Lattice_server <- function(id){
  removeModal()
  }else {
  showModal(
- shinyjqui::jqui_draggable(
- simuModal.alpha(failed = TRUE)
- )
+ simuModal.alpha(failed = TRUE)
  )
  }
  })
@@ -499,7 +493,7 @@ mod_Alpha_Lattice_server <- function(id){
  trail <- as.character(valsALPHA$trail.alpha)
  label_trail <- paste(trail, ": ")
  heatmapTitle <- paste("Heatmap for ", trail)
- new_df <- df %>%
+ new_df <- df |>
  dplyr::mutate(text = paste0("Site: ", loc, "\n", 
  "Row: ", df$ROW, "\n", 
  "Col: ", df$COLUMN, "\n", 
@@ -528,9 +522,7 @@ mod_Alpha_Lattice_server <- function(id){
  return(p2)
  } else {
  showModal(
- shinyjqui::jqui_draggable(
- heatmapInfoModal_ALPHA()
- )
+ heatmapInfoModal_ALPHA()
  )
  return(NULL)
  }
@@ -610,4 +602,4 @@ mod_Alpha_Lattice_server <- function(id){
 
 
  })
-}
+}

R/mod_CRD.R

@@ -196,7 +196,7 @@ mod_CRD_server <- function(id) {
  colnames(data_crd) <- c("TREATMENT", "REP")
  return(list(data_crd = data_crd, treatments = nt))
  }
- }) %>%
+ }) |>
  bindEvent(input$RUN.crd)
 
  crd_inputs <- reactive({
@@ -220,7 +220,7 @@ mod_CRD_server <- function(id) {
  plot_start = plot_start, 
  site_names = site_names,
  seed = seed))
- }) %>%
+ }) |>
  bindEvent(input$RUN.crd)
 
 
@@ -239,7 +239,7 @@ mod_CRD_server <- function(id) {
  data = get_data_crd()$data_crd
  )
 
- }) %>% 
+ }) |> 
  bindEvent(input$RUN.crd)
 
  output$well_panel_layout_CRD <- renderUI({
@@ -298,9 +298,7 @@ mod_CRD_server <- function(id) {
  observeEvent(toListen(), {
  if (input$owndatacrd == "Yes") {
  showModal(
- shinyjqui::jqui_draggable(
- entriesInfoModal_CRD()
- )
+ entriesInfoModal_CRD()
  )
  }
  })
@@ -338,9 +336,7 @@ mod_CRD_server <- function(id) {
  observeEvent(input$Simulate.crd, {
  req(CRD_reactive()$fieldBook)
  showModal(
- shinyjqui::jqui_draggable(
- simuModal.crd()
- )
+ simuModal.crd()
  )
  })
 
@@ -361,9 +357,7 @@ mod_CRD_server <- function(id) {
  removeModal()
  }else {
  showModal(
- shinyjqui::jqui_draggable(
- simuModal.crd(failed = TRUE)
- )
+ simuModal.crd(failed = TRUE)
  )
  }
  })
@@ -430,7 +424,7 @@ mod_CRD_server <- function(id) {
  label_trail <- paste(trail, ": ")
  heatmapTitle <- paste("Heatmap for ", trail)
  df <- simuDataCRD()$df
- new_df <- df %>%
+ new_df <- df |>
  dplyr::mutate(text = paste0("Row: ", df$ROW, "\n", "Col: ", df$COLUMN, "\n", "Entry: ", 
  df$TREATMENT, "\n", label_trail, round(df[,8],2)))
  w <- as.character(vals$trail.CRD)
@@ -449,9 +443,7 @@ mod_CRD_server <- function(id) {
  return(p2)
  } else {
  showModal(
- shinyjqui::jqui_draggable(
- heatmapInfoModal_CRD()
- )
+ heatmapInfoModal_CRD()
  )
  return(NULL)
  }