From 9c1d6ed6309a5167cb72e0eaba18fb07669a90c1 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 2 Oct 2025 11:15:40 +0200 Subject: [PATCH] feat: loading of local data was internalised based on the datamods package --- R/import_globalenv-ext.R | 357 +++++++++++++++++++++++++++++++++++++++ R/regression_table.R | 34 ---- R/sysdata.rda | Bin 2713 -> 2781 bytes man/data_type.Rd | 2 +- man/data_types.Rd | 2 +- man/get_data_packages.Rd | 21 +++ man/ggeulerr.Rd | 2 +- man/import-globalenv.Rd | 50 ++++++ man/list_pkg_data.Rd | 21 +++ man/plot_euler.Rd | 15 ++ man/regression_table.Rd | 32 ---- 11 files changed, 467 insertions(+), 69 deletions(-) create mode 100644 R/import_globalenv-ext.R create mode 100644 man/get_data_packages.Rd create mode 100644 man/import-globalenv.Rd create mode 100644 man/list_pkg_data.Rd diff --git a/R/import_globalenv-ext.R b/R/import_globalenv-ext.R new file mode 100644 index 00000000..5368d45e --- /dev/null +++ b/R/import_globalenv-ext.R @@ -0,0 +1,357 @@ + +#' @title Import data from an Environment +#' +#' @description Let the user select a dataset from its own environment or from a package's environment. +#' Modified from datamods +#' +#' @param id Module's ID. +#' @param globalenv Search for data in Global environment. +#' @param packages Name of packages in which to search data. +#' @param title Module's title, if `TRUE` use the default title, +#' use `NULL` for no title or a `shiny.tag` for a custom one. +#' +#' @export +#' +#' @name import-globalenv +#' +import_globalenv_ui <- function(id, + globalenv = TRUE, + packages = datamods::get_data_packages(), + title = TRUE) { + + ns <- NS(id) + + choices <- list() + if (isTRUE(globalenv)) { + choices <- append(choices, "Global Environment") + } + if (!is.null(packages)) { + choices <- append(choices, list(Packages = as.character(packages))) + } + + if (isTRUE(globalenv)) { + selected <- "Global Environment" + } else { + selected <- packages[1] + } + + if (isTRUE(title)) { + title <- tags$h4( + i18n$t("Import a dataset from an environment"), + class = "datamods-title" + ) + } + + tags$div( + class = "datamods-import", + datamods:::html_dependency_datamods(), + title, + shinyWidgets::pickerInput( + inputId = ns("env"), + label = i18n$t("Select a data source:"), + choices = choices, + selected = selected, + width = "100%", + options = list( + "title" = i18n$t("Select source"), + "live-search" = TRUE, + "size" = 10 + ) + ), + shinyWidgets::pickerInput( + inputId = ns("data"), + label = i18n$t("Select a dataset:"), + # selected = character(0), + choices = NULL, + # options = list(title = i18n$t("List of datasets...")), + width = "100%" + ), + + tags$div( + id = ns("import-placeholder"), + shinyWidgets::alert( + id = ns("import-result"), + status = "info", + tags$b(i18n$t("No data selected!")), + i18n$t("Use a datasat from your environment or from the environment of a package."), + dismissible = TRUE + ) + ), + uiOutput( + outputId = ns("container_valid_btn"), + style = "margin-top: 20px;" + ) + ) +} + + + +#' @param btn_show_data Display or not a button to display data in a modal window if import is successful. +#' @param show_data_in Where to display data: in a `"popup"` or in a `"modal"` window. +#' @param trigger_return When to update selected data: +#' `"button"` (when user click on button) or +#' `"change"` (each time user select a dataset in the list). +#' @param return_class Class of returned data: `data.frame`, `data.table`, `tbl_df` (tibble) or `raw`. +#' @param reset A `reactive` function that when triggered resets the data. +#' +#' @export +#' +#' @importFrom shiny moduleServer reactiveValues observeEvent reactive removeUI is.reactive icon actionLink isTruthy +#' @importFrom htmltools tags tagList +#' @importFrom shinyWidgets updatePickerInput +#' +#' @rdname import-globalenv +import_globalenv_server <- function(id, + btn_show_data = TRUE, + show_data_in = c("popup", "modal"), + trigger_return = c("button", "change"), + return_class = c("data.frame", "data.table", "tbl_df", "raw"), + reset = reactive(NULL)) { + + trigger_return <- match.arg(trigger_return) + return_class <- match.arg(return_class) + + module <- function(input, output, session) { + + ns <- session$ns + imported_rv <- reactiveValues(data = NULL, name = NULL) + temporary_rv <- reactiveValues(data = NULL, name = NULL, status = NULL) + + observeEvent(reset(), { + temporary_rv$data <- NULL + temporary_rv$name <- NULL + temporary_rv$status <- NULL + }) + + output$container_valid_btn <- renderUI({ + if (identical(trigger_return, "button")) { + button_import() + } + }) + + observeEvent(input$env, { + if (identical(input$env, "Global Environment")) { + choices <- datamods:::search_obj("data.frame") + } else { + choices <- datamods:::list_pkg_data(input$env) + } + if (is.null(choices)) { + choices <- i18n$t("No dataset here...") + choicesOpt <- list(disabled = TRUE) + } else { + choicesOpt <- list( + subtext = datamods:::get_dimensions(choices) + ) + } + temporary_rv$package <- attr(choices, "package") + shinyWidgets::updatePickerInput( + session = session, + inputId = "data", + selected = character(0), + choices = choices, + choicesOpt = choicesOpt, + options = list(title = i18n$t("List of datasets...")) + ) + }) + + observe( + shinyWidgets::alert( + id = "import-result", + status = "info", + tags$b(i18n$t("No data selected!")), + i18n$t("Use a datasat from your environment or from the environment of a package."), + dismissible = TRUE + ) + ) + + + observeEvent(input$trigger, { + if (identical(trigger_return, "change")) { + datamods:::hideUI(selector = paste0("#", ns("container_valid_btn"))) + } + }) + + + + observeEvent(input$data, { + if (!isTruthy(input$data)) { + datamods:::toggle_widget(inputId = "confirm", enable = FALSE) + datamods:::insert_alert( + selector = ns("import"), + status = "info", + tags$b(i18n$t("No data selected!")), + i18n$t("Use a dataset from your environment or from the environment of a package.") + ) + } else { + name_df <- input$data + + if (!is.null(temporary_rv$package)) { + attr(name_df, "package") <- temporary_rv$package + } + + imported <- try(get_env_data(name_df), silent = TRUE) + + if (inherits(imported, "try-error") || NROW(imported) < 1) { + datamods:::toggle_widget(inputId = "confirm", enable = FALSE) + datamods:::insert_error(mssg = i18n$t(attr(imported, "condition")$message)) + temporary_rv$status <- "error" + temporary_rv$data <- NULL + temporary_rv$name <- NULL + } else { + datamods:::toggle_widget(inputId = "confirm", enable = TRUE) + datamods:::insert_alert( + selector = ns("import"), + status = "success", + datamods:::make_success_alert( + imported, + trigger_return = trigger_return, + btn_show_data = btn_show_data + ) + ) + pkg <- attr(name_df, "package") + if (!is.null(pkg)) { + name <- paste(pkg, input$data, sep = "::") + } else { + name <- input$data + } + name <- trimws(sub("\\(([^\\)]+)\\)", "", name)) + temporary_rv$status <- "success" + temporary_rv$data <- imported + temporary_rv$name <- name + } + } + }, ignoreInit = TRUE, ignoreNULL = FALSE) + + + observeEvent(input$see_data, { + show_data(temporary_rv$data, title = i18n$t("Imported data"), type = show_data_in) + }) + + observeEvent(input$confirm, { + imported_rv$data <- temporary_rv$data + imported_rv$name <- temporary_rv$name + }) + + + if (identical(trigger_return, "button")) { + return(list( + status = reactive(temporary_rv$status), + name = reactive(imported_rv$name), + data = reactive(datamods:::as_out(imported_rv$data, return_class)) + )) + } else { + return(list( + status = reactive(temporary_rv$status), + name = reactive(temporary_rv$name), + data = reactive(datamods:::as_out(temporary_rv$data, return_class)) + )) + } + } + + moduleServer( + id = id, + module = module + ) +} + + + + + + + +# utils ------------------------------------------------------------------- + + +#' Get packages containing datasets +#' +#' @return a character vector of packages names +#' @export +#' +#' @importFrom utils data +#' +#' @examples +#' if (interactive()) { +#' +#' get_data_packages() +#' +#' } +get_data_packages <- function() { + suppressWarnings({ + pkgs <- data(package = .packages(all.available = TRUE)) + }) + unique(pkgs$results[, 1]) +} + + +#' List dataset contained in a package +#' +#' @param pkg Name of the package, must be installed. +#' +#' @return a \code{character} vector or \code{NULL}. +#' @export +#' +#' @importFrom utils data +#' +#' @examples +#' +#' list_pkg_data("ggplot2") +list_pkg_data <- function(pkg) { + if (isTRUE(requireNamespace(pkg, quietly = TRUE))) { + list_data <- data(package = pkg, envir = environment())$results[, "Item"] + list_data <- sort(list_data) + attr(list_data, "package") <- pkg + if (length(list_data) < 1) { + NULL + } else { + unname(list_data) + } + } else { + NULL + } +} + +#' @importFrom utils data +get_env_data <- function(obj, env = globalenv()) { + pkg <- attr(obj, "package") + re <- regexpr(pattern = "\\(([^\\)]+)\\)", text = obj) + obj_ <- substr(x = obj, start = re + 1, stop = re + attr(re, "match.length") - 2) + obj <- gsub(pattern = "\\s.*", replacement = "", x = obj) + if (obj %in% ls(name = env)) { + get(x = obj, envir = env) + } else if (!is.null(pkg) && !identical(pkg, "")) { + res <- suppressWarnings(try( + get(utils::data(list = obj, package = pkg, envir = environment())), silent = TRUE + )) + if (!inherits(res, "try-error")) + return(res) + data(list = obj_, package = pkg, envir = environment()) + get(obj, envir = environment()) + } else { + NULL + } +} + + +get_dimensions <- function(objs) { + if (is.null(objs)) + return(NULL) + dataframes_dims <- Map( + f = function(name, pkg) { + attr(name, "package") <- pkg + tmp <- suppressWarnings(get_env_data(name)) + if (is.data.frame(tmp)) { + sprintf("%d obs. of %d variables", nrow(tmp), ncol(tmp)) + } else { + i18n$t("Not a data.frame") + } + }, + name = objs, + pkg = if (!is.null(attr(objs, "package"))) { + attr(objs, "package") + } else { + character(1) + } + ) + unlist(dataframes_dims) +} diff --git a/R/regression_table.R b/R/regression_table.R index 557359b3..ed512ab1 100644 --- a/R/regression_table.R +++ b/R/regression_table.R @@ -70,38 +70,6 @@ #' purrr::map(regression_table) |> #' tbl_merge() #' } -#' regression_table <- function(x, ...) { -#' UseMethod("regression_table") -#' } -#' -#' #' @rdname regression_table -#' #' @export -#' regression_table.list <- function(x, ...) { -#' x |> -#' purrr::map(\(.m){ -#' regression_table(x = .m, ...) |> -#' gtsummary::add_n() -#' }) |> -#' gtsummary::tbl_stack() -#' } -#' -#' #' @rdname regression_table -#' #' @export -#' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") { -#' # Stripping custom class -#' class(x) <- class(x)[class(x) != "freesearchr_model"] -#' -#' if (any(c(length(class(x)) != 1, class(x) != "lm"))) { -#' if (!"exponentiate" %in% names(args.list)) { -#' args.list <- c(args.list, list(exponentiate = TRUE)) -#' } -#' } -#' -#' out <- do.call(getfun(fun), c(list(x = x), args.list)) -#' out |> -#' gtsummary::add_glance_source_note() # |> -#' # gtsummary::bold_p() -#' } regression_table <- function(x, ...) { args <- list(...) @@ -179,5 +147,3 @@ tbl_merge <- function(data) { } } -# as_kable(tbl) |> write_lines(file=here::here("inst/apps/data_analysis_modules/www/_table1.md")) -# as_kable_extra(tbl)|> write_lines(file=here::here("inst/apps/data_analysis_modules/www/table1.md")) diff --git a/R/sysdata.rda b/R/sysdata.rda index 463120753399f65122208435ec9eca297cec6711..27b7821900ba46de2fefd1d7709702fc0d0f8722 100644 GIT binary patch literal 2781 zcmV<33L^DFT4*^jL0KkKSt>e3p8y*ff5QL&Xazw3|KNXb-@w2B|L{Nn0DuSq;0%8k z6Ra-uhforx$^wFd`R}1X2cTs|;i-@U2ATqB5vC+$)WUk6plCDz02&PgRX+)&#A2F{ zQz^1~nun+w13{1g00TfY0jc5wr9c208Vvvd4FCWD001P?NQi{Sf@Yzh0MGyc00000 zAx%agXagW<8UQo^&}aYvXlT#^DH3R9JsK&I=^l__Jx@`f8UO%jX`pPN87@TJBw{31 zCKAaBMG_PSm_<`(B$WU;IH@KIjOIaCi|y0J7eKrhxc&T`W)U~w8wiRdB%r`kyB(Tw z6QuyV3IH!M75r)WYg>a)`oH7Ni@krBc#TyK{h{aXEHUPF`zT0FRgbZ=g`c~}t`D5b z$r&TJh-8!QE*}IsJ&^?e*>p#}wP9ygDUyYm=;AnJh*;oKTePAlPzqtHb)sa|A*K!) zb%tU^47=q_7O5m-6wMS;2MfgpPaHxxn)L7jPW?#AM|ZU0^=rARVK>Y zy)s@nKo-f#BiAi6<~^`5#e}m|T6q-RKBgvWHVwX31rp5mbf;~maO!YWZrciYZd!vO z2LSh@t=2U$nTloNs)9T0wK^i@>zQV9#aj~1GZJMSI-=-#8+{b?!7$U%hD2VBrP8VC zlS*u(5jm8Gt=w+8lxQ@<^5Q1Yv%6DKn>{aL7PRj2m5U}I?6U3~$62dmM+3h5C9uM# z7MZ!KzZ^Q)&F(VW$7YRZk5sIQn#jWOU7c8SOr%A2Aq6!e%QDk$)j4AL8_=RDn1BR` z0RU1UqKH6*iy;cC3Wx3lQRzS`1oq-ZdH^&+AUmHP1F_EmHQ-cC*|TK$Ma&-ESOG@U zdfMg{kr5PBU??mWERkTKi~$vk767n|5dmaaqLEfAs(_%eNGf!DoSC$em~^0 z%*)7O^9!gtomiS?UWo;XGYF$e%CgCo)#T0Z6F6;fx)T*kfI^vMkb+({Vnq^>j5zsV z(1O@Ti98lj<3SU$#NF}RR$7*kvqzCRQ!;G98gf8V3LVhyO`P15$F)7&`hbE9)n#hh_GyWPYT8D#xied z4XHsELZF}vf)vWAj5q7QGlr}40#KDfa;UgSlTwx}fUuG+WP*iKOqi18hZa_8qNke7 zGRs9#+KMd{d9Diysk&n&L!aL1^6$+{zb>iCi>ql`w6wK?GAS`2Imxc1x-)JU1Eu`t z+-;>TjV(cUEStkjP|ax_CA6)rvegKMvfvjdo_NkINQme=++D40nSBuv&|dIVZ}qZx zz-~sQ3Cc2AU4zSe|L4jscSZNiF?v$x6Yb!z8ZQOB`?sspf(tKMpoKM1d^ ziKajAp7T1%$Z?&()R4jI4KDCq8a3&vs`gr*j5XPKhU;aHTf+K!%4GB{v zXtepy7Ym;DdE7e2z5<2< z|4*7m+jod_Fw*7ha8tKGgcTVv-ni5U z;^xM53*6L^sqD+Yn%*PeLIKcP1ad5uSyNk=2Z9j1l4KzF9&60E*kU~q&LR~RCeu!> z>_f5Vv*vp-k~Y0-I(`#KAw{C5g*fs_?=R4f(4r17uN;#=#K~s}Y9p(i?yqC9OX2nS zaoFL~*1lJ0qPZsh3p`%kP~wo3$x1UDbHzqU_)3Hg;E^p%T>x<)V3zcvqy*GFL>!Ie z)cMm@eM{x?>3FCMb39A5rv~HZCqE^EDVgCs$HZejg%=V-TZf+SL^?ANj?$o!=&?0- z9R=G8&SI{=O>^Yg&iw^KwpB^JYiwa2iWk5M6sURtxV1E^Bwiz@5$(imElSkM#IE=*cnLhDH*)K`3lDYq~? z>l@(p&W);3ljw+A*zzW6 zD;D7#R^3ub*iIP9UD@bzAAa6U)J3aRwjz<7s7nlDCfn6xkS!#Lk~dt!1dzGb69B6` z&#u!`YIUtqCQ#QziRlzZbYL9dI}hKrFLMW(lZgl;3XQ8$>Y+Q8V;1nXvJz`F()rSp zVs1wHBNN+P{BnhIDrU6bS{so>h@V>>io%?7S$Y(VE?pg+5$r|6NFZjsx2SLzRn>(x z_hqlPiwIh@*QiyrXR8`EbNJzN@Qvk}Q%SuWCgbNiXA;;Yy)>?3kj9qA6(Ax>wz+b_ jmJ0+E)T&U?hBo#M0j2`lC@2zxIsX@OML1B9Dmq1gusa?nwh9IJwRj{8XiyvfCE4Q z>Hx$BOcKW#G8AZmjMJnowt!T+2&u8FLMre6E-XMs%LrfL`(?>A0Kyn|z1#c7F+H$N zGD~R+hM{*>b}q@mw?J16QABvqUER(mp6B}(?#XxI{k@|p4{gI~`>hRx{#7k3nERjp zBX8dU_(l|=TXB(IwV@YD>^MFE$)XAWw=9o)mhta}RLMgPbUB!%61B*+$|h$}3DaD6 z!BuwnWa+19%*6`L6->2>Dc4nH6oJzAT@X5Yy>8pPJ^c>j?(e^0^xh4zz@wI}uDox) z{1ECi2zV^Cm@Xs}rh{$$oI?j@}jj(GjF977g&D%4}!Ls86E*<;#Gtai`VsUEGw^Wj!R1E<@D}ex@6OUOFg=G)3-~nz&;F0(C&C7SllhNft4OB|$Y*PAL?! zlrht5nA~-dC8e%Zne9aTT5hGmxT$j!#l(*?=_7wXBEC> zmkK~-jI5nsj4Bsci89l)mg^P8CNe39Ljy9Zx(fh6rW|Y%U~c1>AsblK<3Y;Y%$7Nr zXxN@$s{#OkvzlO*(gc;TvZ#sY)0r_C?zPe+G5+F#K^vI?+)kX59hY!0ddg5IFT zMT+3ufeQ>NYDx>-5+HX|yE{6fql8NfCQ}TGLt55oM$qqlvJ-&>2!sM80%;*91d?)O zg%gdEqUn`~W5LnB?sEegT%(xg2GD^9QwEsVB2hBch|w*Wg;pF=afn>F$S~w}HKG}k z))p{WF_6{Fmfxi@6lWMgJNgiy!YYEprpd-HV_n0d93UuIBcx4mZzs+RaIEQ5J1v4!mAQ;v#D%~2>q74 zP%8v?cd+7SlSwa`*W)*CYih>ZyEeekqXb}}2*xsQv<<027DAxH5OKjdAfU$mELI;Y z@mK{wz8Ei%jtEgqU+KMd|dK?rcp;->cbC-{9 zie21Vrwm?}W?gvimdX#0Qs4m4O(9;w%T13^OZEbBWSh94s z18nVQIr(z}2nE4k?xb%7d;$ms!1~Mp-;#fAtAY9lb58YL%3PnQDyuswEbFIdoKCpV z!2|-ANQ<5A=IhZ5UzsS7Kswi&2p}DQQW)r*g!)KJ5!qmMK?y>NJvQ3Ke|VcnE~I!X z7AR5R`Wws@H6FcKhCnq)?{G3eekoieOk@9xQY$K{35%>w0@y5>&`MX<<0v!C8S1>| z|4ev9d>S>WO@_sMJ#4E%=sFY&i|(C5K~9tET8t(F%xx;>=`33PM8D$-3&0ak-amgo z708q+<&GxrDyW^A@n+LRPF22bX4r}<4~7W!u~z-sCoLdn z89*u#(yYpFWQ}GhGa1G&i*(_@-7W&d24z!)W(&Hw1nsJv@|7+*?7GA(X$qxT{v{%ZO%t*usW$IOH1TGZt)^{!{Iag!4w*@M1Tq}n6 z+hmq?n;J6Ob&rCL6rKkx}8K9 ziQQ(<&dz7$H2{YZeJVU|@ksI*M7e7-95l&hN%a*<9DyqBTFRB)N-#`eA(0W?Zj3E`W{8%SH;g-f*k}d6-8yv_1y?9S6VMhy63%ugA|>hFF3Z*7JCdmb%^j?T%?vf zm^biSJ-%%nO>=IfTI+qPtZQ{h(;3m&uGgquNF++*gGdqvQeh$%yE1jGvl{0)qE`NC zVNWPjaY?vU18ugfLbZrvGNOqXN^4YFtU~Hqinvy7&1SmcN|4%^E0wC)d@R4uY-fR2 zMq@QQGLaENZFWoxdEC!p)w2cF=-wQcV=N0Yu68*Zt?shPA86nhY8gfT0l&paVxFjj*kIVf}IJBSZ)sBI*1EM Tfdv5unDZBMML1B9rJ>m>bJ^{P diff --git a/man/data_type.Rd b/man/data_type.Rd index cf287f28..cb49cf49 100644 --- a/man/data_type.Rd +++ b/man/data_type.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/regression_model.R +% Please edit documentation in R/helpers.R \name{data_type} \alias{data_type} \title{Data type assessment.} diff --git a/man/data_types.Rd b/man/data_types.Rd index b37a81b8..655c1ec5 100644 --- a/man/data_types.Rd +++ b/man/data_types.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/regression_model.R +% Please edit documentation in R/helpers.R \name{data_types} \alias{data_types} \title{Recognised data types from data_type} diff --git a/man/get_data_packages.Rd b/man/get_data_packages.Rd new file mode 100644 index 00000000..25371aa1 --- /dev/null +++ b/man/get_data_packages.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/import_globalenv-ext.R +\name{get_data_packages} +\alias{get_data_packages} +\title{Get packages containing datasets} +\usage{ +get_data_packages() +} +\value{ +a character vector of packages names +} +\description{ +Get packages containing datasets +} +\examples{ +if (interactive()) { + + get_data_packages() + +} +} diff --git a/man/ggeulerr.Rd b/man/ggeulerr.Rd index 78fc3138..e9983218 100644 --- a/man/ggeulerr.Rd +++ b/man/ggeulerr.Rd @@ -17,7 +17,7 @@ data.frame(See \code{eulerr::euler})} \item{...}{further arguments passed to eulerr::euler} } \description{ -THis is slightly modified from https://gist.github.com/danlooo/d23d8bcf8856c7dd8e86266097404ded +This is slightly modified from https://gist.github.com/danlooo/d23d8bcf8856c7dd8e86266097404ded This functions uses eulerr::euler to plot area proportional venn diagramms but plots it using ggplot2 diff --git a/man/import-globalenv.Rd b/man/import-globalenv.Rd new file mode 100644 index 00000000..5c8f304c --- /dev/null +++ b/man/import-globalenv.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/import_globalenv-ext.R +\name{import-globalenv} +\alias{import-globalenv} +\alias{import_globalenv_ui} +\alias{import_globalenv_server} +\title{Import data from an Environment} +\usage{ +import_globalenv_ui( + id, + globalenv = TRUE, + packages = datamods::get_data_packages(), + title = TRUE +) + +import_globalenv_server( + id, + btn_show_data = TRUE, + show_data_in = c("popup", "modal"), + trigger_return = c("button", "change"), + return_class = c("data.frame", "data.table", "tbl_df", "raw"), + reset = reactive(NULL) +) +} +\arguments{ +\item{id}{Module's ID.} + +\item{globalenv}{Search for data in Global environment.} + +\item{packages}{Name of packages in which to search data.} + +\item{title}{Module's title, if \code{TRUE} use the default title, +use \code{NULL} for no title or a \code{shiny.tag} for a custom one.} + +\item{btn_show_data}{Display or not a button to display data in a modal window if import is successful.} + +\item{show_data_in}{Where to display data: in a \code{"popup"} or in a \code{"modal"} window.} + +\item{trigger_return}{When to update selected data: +\code{"button"} (when user click on button) or +\code{"change"} (each time user select a dataset in the list).} + +\item{return_class}{Class of returned data: \code{data.frame}, \code{data.table}, \code{tbl_df} (tibble) or \code{raw}.} + +\item{reset}{A \code{reactive} function that when triggered resets the data.} +} +\description{ +Let the user select a dataset from its own environment or from a package's environment. +Modified from datamods +} diff --git a/man/list_pkg_data.Rd b/man/list_pkg_data.Rd new file mode 100644 index 00000000..de2567a9 --- /dev/null +++ b/man/list_pkg_data.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/import_globalenv-ext.R +\name{list_pkg_data} +\alias{list_pkg_data} +\title{List dataset contained in a package} +\usage{ +list_pkg_data(pkg) +} +\arguments{ +\item{pkg}{Name of the package, must be installed.} +} +\value{ +a \code{character} vector or \code{NULL}. +} +\description{ +List dataset contained in a package +} +\examples{ + +list_pkg_data("ggplot2") +} diff --git a/man/plot_euler.Rd b/man/plot_euler.Rd index b4bc1b2d..4f387162 100644 --- a/man/plot_euler.Rd +++ b/man/plot_euler.Rd @@ -32,4 +32,19 @@ data.frame( ) |> plot_euler("A", c("B", "C"), "D", seed = 4) mtcars |> plot_euler("vs", "am", seed = 1) mtcars |> plot_euler("vs", "am", "cyl", seed = 1) +stRoke::trial |> + dplyr::mutate( + mfi_cut = cut(mfi_6, c(0, 12, max(mfi_6, na.rm = TRUE))), + mdi_cut = cut(mdi_6, c(0, 20, max(mdi_6, na.rm = TRUE))) + ) |> + purrr::map2( + c(sapply(stRoke::trial, \(.x)REDCapCAST::get_attr(.x, attr = "label")), "Fatigue", "Depression"), + \(.x, .y){ + REDCapCAST::set_attr(.x, .y, "label") + } + ) |> + dplyr::bind_cols() |> + plot_euler("mfi_cut", "mdi_cut") +stRoke::trial |> + plot_euler(pri="male", sec=c("hypertension")) } diff --git a/man/regression_table.Rd b/man/regression_table.Rd index d319247b..8a362df2 100644 --- a/man/regression_table.Rd +++ b/man/regression_table.Rd @@ -82,36 +82,4 @@ list( purrr::map(regression_table) |> tbl_merge() } -regression_table <- function(x, ...) { - UseMethod("regression_table") -} - -#' @rdname regression_table -#' @export -regression_table.list <- function(x, ...) { - x |> - purrr::map(\(.m){ - regression_table(x = .m, ...) |> - gtsummary::add_n() - }) |> - gtsummary::tbl_stack() -} - -#' @rdname regression_table -#' @export -regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") { - # Stripping custom class - class(x) <- class(x)[class(x) != "freesearchr_model"] - - if (any(c(length(class(x)) != 1, class(x) != "lm"))) { - if (!"exponentiate" \%in\% names(args.list)) { - args.list <- c(args.list, list(exponentiate = TRUE)) - } - } - - out <- do.call(getfun(fun), c(list(x = x), args.list)) - out |> - gtsummary::add_glance_source_note() # |> - # gtsummary::bold_p() -} }