fct_drop refined

NAMESPACE

@@ -7,6 +7,8 @@ S3method(as_factor,haven_labelled)
 S3method(as_factor,labelled)
 S3method(as_factor,logical)
 S3method(as_factor,numeric)
+S3method(fct_drop,data.frame)
+S3method(fct_drop,factor)
 S3method(process_user_input,character)
 S3method(process_user_input,data.frame)
 S3method(process_user_input,default)
@@ -34,7 +36,6 @@ export(easy_redcap)
 export(export_redcap_instrument)
 export(fct2num)
 export(fct_drop)
-export(fct_drop.data.frame)
 export(file_extension)
 export(focused_metadata)
 export(format_redcap_factor)

NEWS.md

@@ -1,4 +1,8 @@
-# REDCapCAST 24.11.4
+# REDCapCAST 24.12.2
+
+The newly introduced extension of `forcats::fct_drop()` has been corrected to work as intended as a method.
+
+# REDCapCAST 24.12.1
 
 This release attempts to solve problems hosting the shiny_cast app, while also implementing functions to preserve as much meta data as possible from the REDCap database when exporting data.
 

R/fct_drop.R

@@ -1,7 +1,7 @@
 #' Drop unused levels preserving label data
 #'
 #' This extends [forcats::fct_drop()] to natively work across a data.frame and
-#' replace [base::droplevels()].
+#' replaces [base::droplevels()].
 #'
 #' @param x Factor to drop unused levels
 #' @param ... Other arguments passed down to method.
@@ -10,13 +10,20 @@
 #' @importFrom forcats fct_drop
 #' @export
 #' @name fct_drop
-NULL
+fct_drop <- function(x, ...) {
+  UseMethod("fct_drop")
+}
 
 #' @rdname fct_drop
 #' @export
+#'
+#' @examples
+#' mtcars |>
+#'   numchar2fct() |>
+#'   fct_drop()
 fct_drop.data.frame <- function(x, ...) {
   purrr::map(x, \(.x){
-    if (is.factor(.x)){
+    if (is.factor(.x)) {
       forcats::fct_drop(.x)
     } else {
       .x
@@ -26,4 +33,13 @@ fct_drop.data.frame <- function(x, ...) {
 }
 
 
-
+#' @rdname fct_drop
+#' @export
+#'
+#' @examples
+#' mtcars |>
+#'   numchar2fct() |>
+#'   dplyr::mutate(vs = fct_drop(vs))
+fct_drop.factor <- function(x, ...) {
+  forcats::fct_drop(f = x, ...)
+}

REDCapCAST.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: d97cf790-0785-4be6-9651-e02a4867726b
 
 RestoreWorkspace: No
 SaveWorkspace: No

inst/shiny-examples/casting/app.R

@@ -61,6 +61,10 @@ server <- function(input, output, session) {
     out
   })
 
+  shiny::eventReactive(input$load_data, {
+    v$file <- "loaded"
+  })
+
   # getData <- reactive({
   #   if(is.null(input$ds$datapath)) return(NULL)
   # })
@@ -70,7 +74,7 @@ server <- function(input, output, session) {
 
   dd <- shiny::reactive({
     shiny::req(input$ds)
-    v$file <- "loaded"
+    # v$file <- "loaded"
     ds2dd_detailed(
       data = dat(),
       add.auto.id = input$add_id == "yes",
@@ -228,16 +232,17 @@ ui <-
             ".ods"
           )
         ),
-        # shiny::actionButton(
-        #   inputId = "load_data",
-        #   label = "Load data",
-        #   icon = shiny::icon("circle-down")
-        # ),
-        shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
+        shiny::actionButton(
+          inputId = "options",
+          label = "Show options",
+          icon = shiny::icon("wrench")
+        ),
+        shiny::helpText("Choose and upload a dataset, then press the button for data modification and options for data download or upload."),
         # For some odd reason this only unfolds when the preview panel is shown..
         # This has been solved by adding an arbitrary button to load data - which was abandoned again
         shiny::conditionalPanel(
-          condition = "output.uploaded=='yes'",
+          # condition = "output.uploaded=='yes'",
+          condition = "input.options > 0",
           shiny::radioButtons(
             inputId = "add_id",
             label = "Add ID, or use first column?",

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 11351429
-bundleId: 9425139
+bundleId: 9461113
 url: https://agdamsbo.shinyapps.io/redcapcast/
 version: 1

man/fct_drop.Rd

@@ -3,9 +3,14 @@
 \name{fct_drop}
 \alias{fct_drop}
 \alias{fct_drop.data.frame}
+\alias{fct_drop.factor}
 \title{Drop unused levels preserving label data}
 \usage{
-fct_drop.data.frame(x, ...)
+fct_drop(x, ...)
+
+\method{fct_drop}{data.frame}(x, ...)
+
+\method{fct_drop}{factor}(x, ...)
 }
 \arguments{
 \item{x}{Factor to drop unused levels}
@@ -14,5 +19,13 @@ fct_drop.data.frame(x, ...)
 }
 \description{
 This extends [forcats::fct_drop()] to natively work across a data.frame and
-replace [base::droplevels()].
+replaces [base::droplevels()].
+}
+\examples{
+mtcars |>
+  numchar2fct() |>
+  fct_drop()
+mtcars |>
+  numchar2fct() |>
+  dplyr::mutate(vs = fct_drop(vs))
 }

renv.lock

@@ -187,6 +187,22 @@
       ],
       "Hash": "cd9a672193789068eb5a2aad65a0dedf"
     },
+    "cards": {
+      "Package": "cards",
+      "Version": "0.4.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cli",
+        "dplyr",
+        "glue",
+        "rlang",
+        "tidyr",
+        "tidyselect"
+      ],
+      "Hash": "2cd0d1966092de416f9b7fa1e88b6132"
+    },
     "cellranger": {
       "Package": "cellranger",
       "Version": "1.1.0",
@@ -456,6 +472,25 @@
       ],
       "Hash": "3170d1f0f45e531c241179ab57cd30bd"
     },
+    "gtsummary": {
+      "Package": "gtsummary",
+      "Version": "2.0.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cards",
+        "cli",
+        "dplyr",
+        "glue",
+        "gt",
+        "lifecycle",
+        "rlang",
+        "tidyr",
+        "vctrs"
+      ],
+      "Hash": "cd4d593e8ce0ad4e5c2c0acc50ce7330"
+    },
     "haven": {
       "Package": "haven",
       "Version": "2.5.4",