andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 09:59:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

correlations module modifications

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-03-13 14:13:18 +01:00
parent e3261ad328
commit 9ae7cc2d03
No known key found for this signature in database
8 changed files with 211 additions and 170 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
DESCRIPTION
View file

@ -68,7 +68,8 @@ Imports:
REDCapCAST, REDCapCAST,
eulerr, eulerr,
ggforce, ggforce,
RcppArmadillo RcppArmadillo,
ggcorrplot
Suggests: Suggests:
styler, styler,
devtools, devtools,

2
R/app_version.R
View file

@ -1 +1 @@
app_version <- function()'250313_1240' app_version <- function()'250313_1343'

29
R/correlations-module.R
View file

@ -46,7 +46,8 @@ data_correlations_server <- function(id,
} else { } else {
out <- data() out <- data()
} }
out out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
# as.numeric()
}) })
# rv <- list() # rv <- list()
@ -74,7 +75,25 @@ data_correlations_server <- function(id,
}) })
output$correlation_plot <- shiny::renderPlot({ output$correlation_plot <- shiny::renderPlot({
psych::pairs.panels(rv$data()) ggcorrplot::ggcorrplot(cor(rv$data())) +
# ggplot2::theme_void() +
ggplot2::theme(
# legend.position = "none",
legend.title = ggplot2::element_text(size = 20),
legend.text = ggplot2::element_text(size = 14),
# panel.grid.major = element_blank(),
# panel.grid.minor = element_blank(),
# axis.text.y = element_blank(),
# axis.title.y = element_blank(),
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20),
# text = element_text(size = 5),
# plot.title = element_blank(),
# panel.background = ggplot2::element_rect(fill = "white"),
# plot.background = ggplot2::element_rect(fill = "white"),
panel.border = ggplot2::element_blank()
)
# psych::pairs.panels(rv$data())
}) })
} }
) )
@ -114,7 +133,7 @@ sentence_paste <- function(data, and.str = "and") {
} }
cor_app <- function() { cor_demo_app <- function() {
ui <- shiny::fluidPage( ui <- shiny::fluidPage(
shiny::sliderInput( shiny::sliderInput(
inputId = "cor_cutoff", inputId = "cor_cutoff",
@ -128,9 +147,9 @@ cor_app <- function() {
data_correlations_ui("data", height = 600) data_correlations_ui("data", height = 600)
) )
server <- function(input, output, session) { server <- function(input, output, session) {
data_correlations_server("data", data = shiny::reactive(mtcars), cutoff = shiny::reactive(input$cor_cutoff)) data_correlations_server("data", data = shiny::reactive(default_parsing(mtcars)), cutoff = shiny::reactive(input$cor_cutoff))
} }
shiny::shinyApp(ui, server) shiny::shinyApp(ui, server)
} }
cor_app() cor_demo_app()

147
inst/apps/freesearcheR/app.R
View file

@ -10,7 +10,7 @@
#### Current file: R//app_version.R #### Current file: R//app_version.R
######## ########
app_version <- function()'250313_1240' app_version <- function()'250313_1343'
######## ########
@ -150,7 +150,8 @@ data_correlations_server <- function(id,
} else { } else {
out <- data() out <- data()
} }
out out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
# as.numeric()
}) })
# rv <- list() # rv <- list()
@ -178,7 +179,25 @@ data_correlations_server <- function(id,
}) })
output$correlation_plot <- shiny::renderPlot({ output$correlation_plot <- shiny::renderPlot({
psych::pairs.panels(rv$data()) ggcorrplot::ggcorrplot(cor(rv$data())) +
# ggplot2::theme_void() +
ggplot2::theme(
# legend.position = "none",
legend.title = ggplot2::element_text(size = 20),
legend.text = ggplot2::element_text(size = 14),
# panel.grid.major = element_blank(),
# panel.grid.minor = element_blank(),
# axis.text.y = element_blank(),
# axis.title.y = element_blank(),
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20),
# text = element_text(size = 5),
# plot.title = element_blank(),
# panel.background = ggplot2::element_rect(fill = "white"),
# plot.background = ggplot2::element_rect(fill = "white"),
panel.border = ggplot2::element_blank()
)
# psych::pairs.panels(rv$data())
}) })
} }
) )
@ -218,7 +237,7 @@ sentence_paste <- function(data, and.str = "and") {
} }
cor_app <- function() { cor_demo_app <- function() {
ui <- shiny::fluidPage( ui <- shiny::fluidPage(
shiny::sliderInput( shiny::sliderInput(
inputId = "cor_cutoff", inputId = "cor_cutoff",
@ -232,12 +251,12 @@ cor_app <- function() {
data_correlations_ui("data", height = 600) data_correlations_ui("data", height = 600)
) )
server <- function(input, output, session) { server <- function(input, output, session) {
data_correlations_server("data", data = shiny::reactive(mtcars), cutoff = shiny::reactive(input$cor_cutoff)) data_correlations_server("data", data = shiny::reactive(default_parsing(mtcars)), cutoff = shiny::reactive(input$cor_cutoff))
} }
shiny::shinyApp(ui, server) shiny::shinyApp(ui, server)
} }
cor_app() cor_demo_app()
######## ########
@ -2662,12 +2681,6 @@ missing_fraction <- function(data){
#### Current file: R//import-file-ext.R #### Current file: R//import-file-ext.R
######## ########
# library(htmltools)
# library(shiny)
# library(shinyWidgets)
# library(rlang)
# library(readxl)
#' @title Import data from a file #' @title Import data from a file
#' #'
#' @description Let user upload a file and import data #' @description Let user upload a file and import data
@ -2906,46 +2919,6 @@ import_file_server <- function(id,
} }
}) })
# output$sheet <- shiny::renderUI({
# if (is_workbook(input$file$datapath)) {
# if (isTRUE(is_excel(input$file$datapath))) {
# choices <- readxl::excel_sheets(input$file$datapath)
# } else if (isTRUE(is_ods(input$file$datapath))) {
# choices <- readODS::ods_sheets(input$file$datapath)
# }
# selected <- choices[1]
#
# shiny::selectInput(
# inputId = ns("sheet"),
# label = datamods:::i18n("Select sheet(s) to import:"),
# choices = choices,
# selected = selected,
# width = "100%",
# multiple = TRUE
# )
# # shinyWidgets::pickerInput(
# # inputId = ns("sheet"),
# # label = datamods:::i18n("Select sheet(s) to import:"),
# # choices = choices,
# # selected = selected,
# # width = "100%",
# # multiple = TRUE
# # )
# }
# })
# observeEvent(
# input$sheet,
# {
# req(input$file)
# if (is_workbook(input$file$datapath) && is.null(shiny::req(input$sheet))) {
# temporary_rv$data <- NULL
# }
# }
# )
observeEvent( observeEvent(
list( list(
input$file, input$file,
@ -3120,18 +3093,28 @@ import_xls <- function(file, sheet, skip, na.strings) {
} }
import_ods <- function(file, sheet, skip, na.strings) { import_ods <- function(file, sheet, skip, na.strings) {
tryCatch(
{
sheet |>
purrr::map(\(.x){
readODS::read_ods( readODS::read_ods(
path = file, path = file,
sheet = sheet, sheet = .x,
skip = skip, skip = skip,
na = na.strings na = na.strings
) )
}) |>
purrr::reduce(dplyr::full_join)
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0(err), type = "err")
}
)
} }
# import_xls(openxlsx2::read_xlsx("~/freesearcheR/dev/Test data/trials_redcap_sheets.xlsx"),)
# list()
#' @title Create a select input control with icon(s) #' @title Create a select input control with icon(s)
#' #'
#' @description Extend form controls by adding text or icons before, #' @description Extend form controls by adding text or icons before,
@ -3175,13 +3158,16 @@ selectInputIcon <- function(inputId,
} }
#' Test app for the import_file module
#'
#' @rdname import-file_module
# library(shiny) #'
# library(datamods) #' @examples
#' \dontrun{
ui <- shiny::fluidPage( #' import_file_demo_app()
#' }
import_file_demo_app <- function() {
ui <- shiny::fluidPage(
# theme = bslib::bs_theme(version = 5L), # theme = bslib::bs_theme(version = 5L),
# theme = bslib::bs_theme(version = 5L, preset = "bootstrap"), # theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
shiny::tags$h3("Import data from a file"), shiny::tags$h3("Import data from a file"),
@ -3206,9 +3192,8 @@ ui <- shiny::fluidPage(
shiny::verbatimTextOutput(outputId = "data") shiny::verbatimTextOutput(outputId = "data")
) )
) )
) )
server <- function(input, output, session) {
server <- function(input, output, session) {
imported <- import_file_server( imported <- import_file_server(
id = "myid", id = "myid",
show_data_in = "popup", show_data_in = "popup",
@ -3256,9 +3241,7 @@ server <- function(input, output, session) {
output$data <- shiny::renderPrint({ output$data <- shiny::renderPrint({
imported$data() imported$data()
}) })
} }
if (FALSE) {
shiny::shinyApp(ui, server) shiny::shinyApp(ui, server)
} }
@ -7051,9 +7034,9 @@ ui_elements <- list(
bslib::accordion_panel( bslib::accordion_panel(
vlaue = "acc_cor", vlaue = "acc_cor",
title = "Correlations", title = "Correlations",
icon = bsicons::bs_icon("table"), icon = bsicons::bs_icon("bounding-box"),
shiny::uiOutput("outcome_var_cor"), shiny::uiOutput("outcome_var_cor"),
shiny::helpText("This variable will be excluded from the correlation plot."), shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
shiny::br(), shiny::br(),
shinyWidgets::noUiSliderInput( shinyWidgets::noUiSliderInput(
inputId = "cor_cutoff", inputId = "cor_cutoff",
@ -7064,7 +7047,8 @@ ui_elements <- list(
value = .8, value = .8,
format = shinyWidgets::wNumbFormat(decimals = 2), format = shinyWidgets::wNumbFormat(decimals = 2),
color = datamods:::get_primary_color() color = datamods:::get_primary_color()
) ),
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
) )
) )
), ),
@ -7994,13 +7978,14 @@ server <- function(input, output, session) {
) )
output$outcome_var_cor <- shiny::renderUI({ output$outcome_var_cor <- shiny::renderUI({
shiny::selectInput( columnSelectInput(
inputId = "outcome_var_cor", inputId = "outcome_var_cor",
selected = NULL, selected = "none",
data = rv$list$data,
label = "Select outcome variable", label = "Select outcome variable",
choices = c( col_subset = c(
"none",
colnames(rv$list$data) colnames(rv$list$data)
# ,"none"
), ),
multiple = FALSE multiple = FALSE
) )
@ -8018,10 +8003,10 @@ server <- function(input, output, session) {
id = "correlations", id = "correlations",
data = shiny::reactive({ data = shiny::reactive({
shiny::req(rv$list$data) shiny::req(rv$list$data)
out <- dplyr::select(rv$list$data, -!!input$outcome_var_cor) out <- rv$list$data
# input$outcome_var_cor=="none"){ if (!is.null(input$outcome_var_cor) && input$outcome_var_cor!="none"){
# out <- rv$list$data out <- out[!names(out) %in% input$outcome_var_cor]
# } }
out out
}), }),
cutoff = shiny::reactive(input$cor_cutoff) cutoff = shiny::reactive(input$cor_cutoff)

2
inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
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: 9932726 bundleId: 9937654
url: https://agdamsbo.shinyapps.io/freesearcheR/ url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1 version: 1

17
inst/apps/freesearcheR/server.R
View file

@ -617,13 +617,14 @@ server <- function(input, output, session) {
) )
output$outcome_var_cor <- shiny::renderUI({ output$outcome_var_cor <- shiny::renderUI({
shiny::selectInput( columnSelectInput(
inputId = "outcome_var_cor", inputId = "outcome_var_cor",
selected = NULL, selected = "none",
data = rv$list$data,
label = "Select outcome variable", label = "Select outcome variable",
choices = c( col_subset = c(
"none",
colnames(rv$list$data) colnames(rv$list$data)
# ,"none"
), ),
multiple = FALSE multiple = FALSE
) )
@ -641,10 +642,10 @@ server <- function(input, output, session) {
id = "correlations", id = "correlations",
data = shiny::reactive({ data = shiny::reactive({
shiny::req(rv$list$data) shiny::req(rv$list$data)
out <- dplyr::select(rv$list$data, -!!input$outcome_var_cor) out <- rv$list$data
# input$outcome_var_cor=="none"){ if (!is.null(input$outcome_var_cor) && input$outcome_var_cor!="none"){
# out <- rv$list$data out <- out[!names(out) %in% input$outcome_var_cor]
# } }
out out
}), }),
cutoff = shiny::reactive(input$cor_cutoff) cutoff = shiny::reactive(input$cor_cutoff)

7
inst/apps/freesearcheR/ui.R
View file

@ -311,9 +311,9 @@ ui_elements <- list(
bslib::accordion_panel( bslib::accordion_panel(
vlaue = "acc_cor", vlaue = "acc_cor",
title = "Correlations", title = "Correlations",
icon = bsicons::bs_icon("table"), icon = bsicons::bs_icon("bounding-box"),
shiny::uiOutput("outcome_var_cor"), shiny::uiOutput("outcome_var_cor"),
shiny::helpText("This variable will be excluded from the correlation plot."), shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
shiny::br(), shiny::br(),
shinyWidgets::noUiSliderInput( shinyWidgets::noUiSliderInput(
inputId = "cor_cutoff", inputId = "cor_cutoff",
@ -324,7 +324,8 @@ ui_elements <- list(
value = .8, value = .8,
format = shinyWidgets::wNumbFormat(decimals = 2), format = shinyWidgets::wNumbFormat(decimals = 2),
color = datamods:::get_primary_color() color = datamods:::get_primary_color()
) ),
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
) )
) )
), ),

34
renv.lock
View file

@ -3683,6 +3683,40 @@
"Author": "Jason Cory Brunson [aut, cre], Quentin D. Read [aut]", "Author": "Jason Cory Brunson [aut, cre], Quentin D. Read [aut]",
"Repository": "CRAN" "Repository": "CRAN"
}, },
"ggcorrplot": {
"Package": "ggcorrplot",
"Version": "0.1.4.1",
"Source": "Repository",
"Type": "Package",
"Title": "Visualization of a Correlation Matrix using 'ggplot2'",
"Authors@R": "c(person(given = \"Alboukadel\", family = \"Kassambara\", role = c(\"aut\", \"cre\"), email = \"alboukadel.kassambara@gmail.com\"), person(given = \"Indrajeet\", family = \"Patil\", role = \"ctb\", email = \"patilindrajeet.science@gmail.com\", comment = c(ORCID = \"0000-0003-1995-6531\", Twitter = \"@patilindrajeets\")))",
"Description": "The 'ggcorrplot' package can be used to visualize easily a correlation matrix using 'ggplot2'. It provides a solution for reordering the correlation matrix and displays the significance level on the plot. It also includes a function for computing a matrix of correlation p-values.",
"License": "GPL-2",
"URL": "http://www.sthda.com/english/wiki/ggcorrplot-visualization-of-a-correlation-matrix-using-ggplot2",
"BugReports": "https://github.com/kassambara/ggcorrplot/issues",
"Depends": [
"R (>= 3.3)",
"ggplot2 (>= 3.3.6)"
],
"Imports": [
"reshape2",
"stats"
],
"Suggests": [
"testthat (>= 3.0.0)",
"knitr",
"spelling",
"vdiffr (>= 1.0.0)"
],
"Encoding": "UTF-8",
"Language": "en-US",
"RoxygenNote": "7.1.0",
"Config/testthat/edition": "3",
"NeedsCompilation": "no",
"Author": "Alboukadel Kassambara [aut, cre], Indrajeet Patil [ctb] (<https://orcid.org/0000-0003-1995-6531>, @patilindrajeets)",
"Maintainer": "Alboukadel Kassambara <alboukadel.kassambara@gmail.com>",
"Repository": "CRAN"
},
"ggeffects": { "ggeffects": {
"Package": "ggeffects", "Package": "ggeffects",
"Version": "2.2.0", "Version": "2.2.0",