reverting and recovering from renv corruption

This commit is contained in:
Andreas Gammelgaard Damsbo 2024-12-19 21:21:29 +01:00
parent 99ed934cae
commit 2ad36d6dde
No known key found for this signature in database
12 changed files with 78 additions and 128 deletions

View file

@ -45,13 +45,18 @@ Imports:
lubridate, lubridate,
bsicons, bsicons,
thematic, thematic,
reshape2 reshape2,
shinyWidgets,
classInt,
htmltools,
rlang
Suggests: Suggests:
styler, styler,
devtools, devtools,
rhub, rhub,
usethis, usethis,
roxygen2, roxygen2,
pak pak,
rsconnect
URL: https://github.com/agdamsbo/freesearcheR URL: https://github.com/agdamsbo/freesearcheR
BugReports: https://github.com/agdamsbo/freesearcheR/issues BugReports: https://github.com/agdamsbo/freesearcheR/issues

View file

@ -28,12 +28,6 @@ export(specify_qmd_format)
export(tbl_merge) export(tbl_merge)
export(winbox_cut_variable) export(winbox_cut_variable)
export(write_quarto) export(write_quarto)
importFrom(REDCapCAST,as_factor)
importFrom(REDCapCAST,numchar2fct)
importFrom(REDCapCAST,parse_data)
importFrom(REDCapCAST,read_redcap_tables)
importFrom(REDCapCAST,redcap_wider)
importFrom(REDCapCAST,suffix2label)
importFrom(classInt,classIntervals) importFrom(classInt,classIntervals)
importFrom(graphics,abline) importFrom(graphics,abline)
importFrom(graphics,axis) importFrom(graphics,axis)

View file

@ -98,7 +98,6 @@ argsstring2list <- function(string) {
#' @param vars variables to force factorize #' @param vars variables to force factorize
#' #'
#' @return data.frame #' @return data.frame
#' @importFrom REDCapCAST as_factor
#' @export #' @export
factorize <- function(data, vars) { factorize <- function(data, vars) {
if (!is.null(vars)) { if (!is.null(vars)) {
@ -106,7 +105,7 @@ factorize <- function(data, vars) {
dplyr::mutate( dplyr::mutate(
dplyr::across( dplyr::across(
dplyr::all_of(vars), dplyr::all_of(vars),
as_factor REDCapCAST::as_factor
) )
) )
} else { } else {
@ -138,7 +137,6 @@ dummy_Imports <- function() {
#' #'
#' @returns data #' @returns data
#' @export #' @export
#' @importFrom REDCapCAST as_factor parse_data numchar2fct
#' #'
file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) { file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) {
output.format <- match.arg(output.format) output.format <- match.arg(output.format)
@ -151,9 +149,7 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
{ {
assign(name, value |> assign(name, value |>
dplyr::bind_cols() |> dplyr::bind_cols() |>
parse_data() |> default_parsing())
as_factor() |>
numchar2fct())
}, },
value = data, value = data,
name = filename name = filename
@ -161,17 +157,15 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
datanames(out) <- filename datanames(out) <- filename
} else if (output.format == "df") { } else if (output.format == "df") {
out <- data|> out <- data |>
parse_data() |> default_parsing()
as_factor() |>
numchar2fct()
} else if (output.format == "list") { } else if (output.format == "list") {
out <- list( out <- list(
data = data, data = data,
name = filename name = filename
) )
out <- c(out,...) out <- c(out, ...)
} }
out out
@ -180,18 +174,19 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
#' Default data parsing #' Default data parsing
#' #'
#' @param data #' @param data data
#' #'
#' @returns data.frame or tibble #' @returns data.frame or tibble
#' @export #' @export
#' @importFrom REDCapCAST as_factor parse_data numchar2fct
#' #'
#' @examples #' @examples
#' mtcars |> str() #' mtcars |> str()
#' mtcars |> default_parsing() |> str() #' mtcars |>
default_parsing <- function(data){ #' default_parsing() |>
#' str()
default_parsing <- function(data) {
data |> data |>
parse_data() |> REDCapCAST::parse_data() |>
as_factor() |> REDCapCAST::as_factor() |>
numchar2fct() REDCapCAST::numchar2fct()
} }

View file

@ -100,7 +100,6 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
#' #'
#' @return shiny server module #' @return shiny server module
#' @export #' @export
#' @importFrom REDCapCAST read_redcap_tables redcap_wider suffix2label
#' #'
m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
output.format <- match.arg(output.format) output.format <- match.arg(output.format)
@ -227,7 +226,7 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
shiny::req(input$fields) shiny::req(input$fields)
record_id <- dd()[[1]][1] record_id <- dd()[[1]][1]
redcap_data <- read_redcap_tables( redcap_data <- REDCapCAST::read_redcap_tables(
uri = input$uri, uri = input$uri,
token = input$api, token = input$api,
fields = unique(c(record_id, input$fields)), fields = unique(c(record_id, input$fields)),
@ -236,10 +235,10 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
raw_or_label = "both", raw_or_label = "both",
filter_logic = input$filter filter_logic = input$filter
) |> ) |>
redcap_wider() |> REDCapCAST::redcap_wider() |>
dplyr::select(-dplyr::ends_with("_complete")) |> dplyr::select(-dplyr::ends_with("_complete")) |>
dplyr::select(-dplyr::any_of(record_id)) |> dplyr::select(-dplyr::any_of(record_id)) |>
suffix2label() REDCapCAST::suffix2label()
out_object <- file_export(redcap_data, out_object <- file_export(redcap_data,
output.format = output.format, output.format = output.format,

View file

@ -10,7 +10,6 @@
#' @param ... ignored for now #' @param ... ignored for now
#' #'
#' @importFrom stats as.formula #' @importFrom stats as.formula
#' @importFrom REDCapCAST as_factor
#' #'
#' @return object of standard class for fun #' @return object of standard class for fun
#' @export #' @export
@ -67,7 +66,7 @@ regression_model <- function(data,
data <- data |> data <- data |>
purrr::map(\(.x){ purrr::map(\(.x){
if (is.character(.x)) { if (is.character(.x)) {
suppressWarnings(as_factor(.x)) suppressWarnings(REDCapCAST::as_factor(.x))
} else { } else {
.x .x
} }

View file

@ -28,17 +28,6 @@ if (file.exists(here::here("functions.R"))) {
source(here::here("functions.R")) source(here::here("functions.R"))
} }
#' freesearcheR server
#'
#' @param input input
#' @param output output
#' @param session session
#'
#' @returns server
#' @export
#' @importFrom REDCapCAST numchar2fct
#'
#' @examples
server <- function(input, output, session) { server <- function(input, output, session) {
## Listing files in www in session start to keep when ending and removing ## Listing files in www in session start to keep when ending and removing
## everything else. ## everything else.
@ -75,7 +64,7 @@ server <- function(input, output, session) {
out <- out |> out <- out |>
(\(.x){ (\(.x){
suppressWarnings( suppressWarnings(
numchar2fct(.x) REDCapCAST::numchar2fct(.x)
) )
})() })()
} }

View file

@ -1,13 +1,13 @@
######## ########
#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/functions.R #### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/functions.R
######## ########
######## ########
#### Current file: R//baseline_table.R #### Current file: R//baseline_table.R
######## ########
@ -35,7 +35,7 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
######## ########
#### Current file: R//cut-variable-dates.R #### Current file: R//cut-variable-dates.R
######## ########
library(datamods) library(datamods)
@ -677,7 +677,7 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
######## ########
#### Current file: R//file-import-module.R #### Current file: R//file-import-module.R
######## ########
@ -808,7 +808,7 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
######## ########
#### Current file: R//helpers.R #### Current file: R//helpers.R
######## ########
@ -912,14 +912,13 @@ argsstring2list <- function(string) {
factorize <- function(data, vars) { factorize <- function(data, vars) {
if (!is.null(vars)) { if (!is.null(vars)) {
data |> data |>
dplyr::mutate( dplyr::mutate(
dplyr::across( dplyr::across(
dplyr::all_of(vars), dplyr::all_of(vars),
as_factor REDCapCAST::as_factor
) )
) )
} else { } else {
@ -952,8 +951,6 @@ dummy_Imports <- function() {
file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) { file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) {
output.format <- match.arg(output.format) output.format <- match.arg(output.format)
@ -965,9 +962,7 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
{ {
assign(name, value |> assign(name, value |>
dplyr::bind_cols() |> dplyr::bind_cols() |>
parse_data() |> default_parsing())
as_factor() |>
numchar2fct())
}, },
value = data, value = data,
name = filename name = filename
@ -975,17 +970,15 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
datanames(out) <- filename datanames(out) <- filename
} else if (output.format == "df") { } else if (output.format == "df") {
out <- data|> out <- data |>
parse_data() |> default_parsing()
as_factor() |>
numchar2fct()
} else if (output.format == "list") { } else if (output.format == "list") {
out <- list( out <- list(
data = data, data = data,
name = filename name = filename
) )
out <- c(out,...) out <- c(out, ...)
} }
out out
@ -1003,16 +996,17 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
default_parsing <- function(data){
default_parsing <- function(data) {
data |> data |>
parse_data() |> REDCapCAST::parse_data() |>
as_factor() |> REDCapCAST::as_factor() |>
numchar2fct() REDCapCAST::numchar2fct()
} }
######## ########
#### Current file: R//redcap_read_shiny_module.R #### Current file: R//redcap_read_shiny_module.R
######## ########
@ -1118,7 +1112,6 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
output.format <- match.arg(output.format) output.format <- match.arg(output.format)
@ -1244,7 +1237,7 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
shiny::req(input$fields) shiny::req(input$fields)
record_id <- dd()[[1]][1] record_id <- dd()[[1]][1]
redcap_data <- read_redcap_tables( redcap_data <- REDCapCAST::read_redcap_tables(
uri = input$uri, uri = input$uri,
token = input$api, token = input$api,
fields = unique(c(record_id, input$fields)), fields = unique(c(record_id, input$fields)),
@ -1253,10 +1246,10 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
raw_or_label = "both", raw_or_label = "both",
filter_logic = input$filter filter_logic = input$filter
) |> ) |>
redcap_wider() |> REDCapCAST::redcap_wider() |>
dplyr::select(-dplyr::ends_with("_complete")) |> dplyr::select(-dplyr::ends_with("_complete")) |>
dplyr::select(-dplyr::any_of(record_id)) |> dplyr::select(-dplyr::any_of(record_id)) |>
suffix2label() REDCapCAST::suffix2label()
out_object <- file_export(redcap_data, out_object <- file_export(redcap_data,
output.format = output.format, output.format = output.format,
@ -1383,7 +1376,7 @@ redcap_app <- function() {
######## ########
#### Current file: R//regression_model.R #### Current file: R//regression_model.R
######## ########
@ -1417,7 +1410,6 @@ redcap_app <- function() {
regression_model <- function(data, regression_model <- function(data,
@ -1455,7 +1447,7 @@ regression_model <- function(data,
data <- data |> data <- data |>
purrr::map(\(.x){ purrr::map(\(.x){
if (is.character(.x)) { if (is.character(.x)) {
suppressWarnings(as_factor(.x)) suppressWarnings(REDCapCAST::as_factor(.x))
} else { } else {
.x .x
} }
@ -1594,7 +1586,7 @@ regression_model_uv <- function(data,
######## ########
#### Current file: R//regression_table.R #### Current file: R//regression_table.R
######## ########
@ -1742,7 +1734,7 @@ tbl_merge <- function(data) {
######## ########
#### Current file: R//report.R #### Current file: R//report.R
######## ########
@ -1829,7 +1821,7 @@ modify_qmd <- function(file, format) {
######## ########
#### Current file: R//shiny_freesearcheR.R #### Current file: R//shiny_freesearcheR.R
######## ########
@ -1860,7 +1852,7 @@ shiny_freesearcheR <- function(...) {
######## ########
#### Current file: R//theme.R #### Current file: R//theme.R
######## ########
@ -1901,7 +1893,7 @@ custom_theme <- function(...,
######## ########
#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/ui.R #### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/ui.R
######## ########
# ns <- NS(id) # ns <- NS(id)
@ -2213,7 +2205,7 @@ ui <- bslib::page_fluid(
title = "freesearcheR", title = "freesearcheR",
theme = light, theme = light,
shiny::useBusyIndicators(), shiny::useBusyIndicators(),
bslib::page_navbar( bslib::page_navbar(title = "freesearcheR",
id = "main_panel", id = "main_panel",
# header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")), # header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")),
ui_elements$import, ui_elements$import,
@ -2221,7 +2213,7 @@ ui <- bslib::page_fluid(
ui_elements$analyze, ui_elements$analyze,
ui_elements$docs, ui_elements$docs,
# bslib::nav_spacer(), # bslib::nav_spacer(),
# bslib::nav_item(shinyWidgets::materialSwitch(inputId = "mode", label = icon("moon"), right=TRUE,status = "success")), # bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")),
fillable = TRUE, fillable = TRUE,
footer = shiny::tags$footer( footer = shiny::tags$footer(
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;", style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
@ -2238,7 +2230,7 @@ ui <- bslib::page_fluid(
######## ########
#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/server.R #### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/server.R
######## ########
library(readr) library(readr)
@ -2277,17 +2269,6 @@ library(DT)
# dark <- custom_theme(bg = "#000",fg="#fff") # dark <- custom_theme(bg = "#000",fg="#fff")
#' freesearcheR server
#'
#' @param input input
#' @param output output
#' @param session session
#'
#' @returns server
#' @export
#' @importFrom REDCapCAST fct_drop.data.frame
#'
#' @examples
server <- function(input, output, session) { server <- function(input, output, session) {
## Listing files in www in session start to keep when ending and removing ## Listing files in www in session start to keep when ending and removing
## everything else. ## everything else.
@ -2579,7 +2560,7 @@ server <- function(input, output, session) {
{ {
data <- data_filter() |> data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
fct_drop.data.frame() |> REDCapCAST::fct_drop.data.frame() |>
factorize(vars = input$factor_vars) factorize(vars = input$factor_vars)
if (input$strat_var == "none") { if (input$strat_var == "none") {
@ -2799,7 +2780,7 @@ server <- function(input, output, session) {
######## ########
#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/launch.R #### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/launch.R
######## ########
shinyApp(ui, server) shinyApp(ui, server)

View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1 hostUrl: https://api.shinyapps.io/v1
appId: 13611288 appId: 13611288
bundleId: bundleId: 9546880
url: https://agdamsbo.shinyapps.io/freesearcheR/ url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1 version: 1

View file

@ -34,17 +34,6 @@ library(DT)
# dark <- custom_theme(bg = "#000",fg="#fff") # dark <- custom_theme(bg = "#000",fg="#fff")
#' freesearcheR server
#'
#' @param input input
#' @param output output
#' @param session session
#'
#' @returns server
#' @export
#' @importFrom REDCapCAST fct_drop.data.frame
#'
#' @examples
server <- function(input, output, session) { server <- function(input, output, session) {
## Listing files in www in session start to keep when ending and removing ## Listing files in www in session start to keep when ending and removing
## everything else. ## everything else.
@ -336,7 +325,7 @@ server <- function(input, output, session) {
{ {
data <- data_filter() |> data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
fct_drop.data.frame() |> REDCapCAST::fct_drop.data.frame() |>
factorize(vars = input$factor_vars) factorize(vars = input$factor_vars)
if (input$strat_var == "none") { if (input$strat_var == "none") {

View file

@ -307,7 +307,7 @@ ui <- bslib::page_fluid(
title = "freesearcheR", title = "freesearcheR",
theme = light, theme = light,
shiny::useBusyIndicators(), shiny::useBusyIndicators(),
bslib::page_navbar( bslib::page_navbar(title = "freesearcheR",
id = "main_panel", id = "main_panel",
# header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")), # header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")),
ui_elements$import, ui_elements$import,
@ -315,7 +315,7 @@ ui <- bslib::page_fluid(
ui_elements$analyze, ui_elements$analyze,
ui_elements$docs, ui_elements$docs,
# bslib::nav_spacer(), # bslib::nav_spacer(),
# bslib::nav_item(shinyWidgets::materialSwitch(inputId = "mode", label = icon("moon"), right=TRUE,status = "success")), # bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")),
fillable = TRUE, fillable = TRUE,
footer = shiny::tags$footer( footer = shiny::tags$footer(
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;", style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",

View file

@ -7,7 +7,7 @@
default_parsing(data) default_parsing(data)
} }
\arguments{ \arguments{
\item{data}{} \item{data}{data}
} }
\value{ \value{
data.frame or tibble data.frame or tibble
@ -17,5 +17,7 @@ Default data parsing
} }
\examples{ \examples{
mtcars |> str() mtcars |> str()
mtcars |> default_parsing() |> str() mtcars |>
default_parsing() |>
str()
} }

View file

@ -193,13 +193,9 @@
}, },
"REDCapCAST": { "REDCapCAST": {
"Package": "REDCapCAST", "Package": "REDCapCAST",
"Version": "24.11.3", "Version": "24.12.1",
"Source": "GitHub", "Source": "Repository",
"RemoteType": "github", "Repository": "CRAN",
"RemoteHost": "api.github.com",
"RemoteRepo": "REDCapCAST",
"RemoteUsername": "agdamsbo",
"RemoteSha": "45315080c596d3c1ea5f2e815ef27d2a50230326",
"Requirements": [ "Requirements": [
"R", "R",
"REDCapR", "REDCapR",
@ -209,6 +205,7 @@
"forcats", "forcats",
"glue", "glue",
"gt", "gt",
"gtsummary",
"haven", "haven",
"here", "here",
"keyring", "keyring",
@ -223,7 +220,7 @@
"vctrs", "vctrs",
"zip" "zip"
], ],
"Hash": "9a9744292f30f1fb7fad55c2dd2e9baf" "Hash": "d0925e579ddfbedeb536c5cbf65fc42f"
}, },
"REDCapR": { "REDCapR": {
"Package": "REDCapR", "Package": "REDCapR",
@ -555,9 +552,9 @@
}, },
"cardx": { "cardx": {
"Package": "cardx", "Package": "cardx",
"Version": "0.2.1", "Version": "0.2.2",
"Source": "Repository", "Source": "Repository",
"Repository": "RSPM", "Repository": "CRAN",
"Requirements": [ "Requirements": [
"R", "R",
"cards", "cards",
@ -568,7 +565,7 @@
"rlang", "rlang",
"tidyr" "tidyr"
], ],
"Hash": "e5458dd65b0602136b16aed802d3bd50" "Hash": "21f5ce5381d529b08783dca434af3003"
}, },
"cellranger": { "cellranger": {
"Package": "cellranger", "Package": "cellranger",
@ -1593,7 +1590,7 @@
}, },
"lubridate": { "lubridate": {
"Package": "lubridate", "Package": "lubridate",
"Version": "1.9.3", "Version": "1.9.4",
"Source": "Repository", "Source": "Repository",
"Repository": "CRAN", "Repository": "CRAN",
"Requirements": [ "Requirements": [
@ -1602,7 +1599,7 @@
"methods", "methods",
"timechange" "timechange"
], ],
"Hash": "680ad542fbcf801442c83a6ac5a2126c" "Hash": "be38bc740fc51783a78edb5a157e4104"
}, },
"magrittr": { "magrittr": {
"Package": "magrittr", "Package": "magrittr",
@ -1790,7 +1787,7 @@
}, },
"openxlsx2": { "openxlsx2": {
"Package": "openxlsx2", "Package": "openxlsx2",
"Version": "1.11", "Version": "1.12",
"Source": "Repository", "Source": "Repository",
"Repository": "CRAN", "Repository": "CRAN",
"Requirements": [ "Requirements": [
@ -1803,7 +1800,7 @@
"utils", "utils",
"zip" "zip"
], ],
"Hash": "c519244e5080a630292e1fdc36717f0d" "Hash": "be241f0f1a58220243d69141407a97ac"
}, },
"parameters": { "parameters": {
"Package": "parameters", "Package": "parameters",
@ -2547,10 +2544,10 @@
}, },
"sodium": { "sodium": {
"Package": "sodium", "Package": "sodium",
"Version": "1.3.2", "Version": "1.4.0",
"Source": "Repository", "Source": "Repository",
"Repository": "CRAN", "Repository": "CRAN",
"Hash": "869b09ca565ecaa9efc62534ebfa3efd" "Hash": "ae00d33a499e429a04409bc1167c4995"
}, },
"sourcetools": { "sourcetools": {
"Package": "sourcetools", "Package": "sourcetools",