andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 01:49: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,
eulerr,
ggforce,
RcppArmadillo
RcppArmadillo,
ggcorrplot
Suggests:
styler,
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 {
out <- data()
}
out
out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
# as.numeric()
})
# rv <- list()
@ -74,7 +75,25 @@ data_correlations_server <- function(id,
})
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(
shiny::sliderInput(
inputId = "cor_cutoff",
@ -128,9 +147,9 @@ cor_app <- function() {
data_correlations_ui("data", height = 600)
)
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)
}
cor_app()
cor_demo_app()

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

@ -10,7 +10,7 @@
#### 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 {
out <- data()
}
out
out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
# as.numeric()
})
# rv <- list()
@ -178,7 +179,25 @@ data_correlations_server <- function(id,
})
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(
shiny::sliderInput(
inputId = "cor_cutoff",
@ -232,12 +251,12 @@ cor_app <- function() {
data_correlations_ui("data", height = 600)
)
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)
}
cor_app()
cor_demo_app()
########
@ -2662,12 +2681,6 @@ missing_fraction <- function(data){
#### Current file: R//import-file-ext.R
########
# library(htmltools)
# library(shiny)
# library(shinyWidgets)
# library(rlang)
# library(readxl)
#' @title Import data from a file
#'
#' @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(
list(
input$file,
@ -3120,18 +3093,28 @@ import_xls <- function(file, sheet, skip, na.strings) {
}
import_ods <- function(file, sheet, skip, na.strings) {
readODS::read_ods(
path = file,
sheet = sheet,
skip = skip,
na = na.strings
tryCatch(
{
sheet |>
purrr::map(\(.x){
readODS::read_ods(
path = file,
sheet = .x,
skip = skip,
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)
#'
#' @description Extend form controls by adding text or icons before,
@ -3175,90 +3158,90 @@ selectInputIcon <- function(inputId,
}
# library(shiny)
# library(datamods)
ui <- shiny::fluidPage(
# theme = bslib::bs_theme(version = 5L),
# theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
shiny::tags$h3("Import data from a file"),
shiny::fluidRow(
shiny::column(
width = 4,
import_file_ui(
id = "myid",
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta"),
layout_params = "dropdown" # "inline" # or "dropdown"
#' Test app for the import_file module
#'
#' @rdname import-file_module
#'
#' @examples
#' \dontrun{
#' import_file_demo_app()
#' }
import_file_demo_app <- function() {
ui <- shiny::fluidPage(
# theme = bslib::bs_theme(version = 5L),
# theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
shiny::tags$h3("Import data from a file"),
shiny::fluidRow(
shiny::column(
width = 4,
import_file_ui(
id = "myid",
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta"),
layout_params = "dropdown" # "inline" # or "dropdown"
)
),
shiny::column(
width = 8,
shiny::tags$b("Import status:"),
shiny::verbatimTextOutput(outputId = "status"),
shiny::tags$b("Name:"),
shiny::verbatimTextOutput(outputId = "name"),
shiny::tags$b("Code:"),
shiny::verbatimTextOutput(outputId = "code"),
shiny::tags$b("Data:"),
shiny::verbatimTextOutput(outputId = "data")
)
),
shiny::column(
width = 8,
shiny::tags$b("Import status:"),
shiny::verbatimTextOutput(outputId = "status"),
shiny::tags$b("Name:"),
shiny::verbatimTextOutput(outputId = "name"),
shiny::tags$b("Code:"),
shiny::verbatimTextOutput(outputId = "code"),
shiny::tags$b("Data:"),
shiny::verbatimTextOutput(outputId = "data")
)
)
)
server <- function(input, output, session) {
imported <- import_file_server(
id = "myid",
show_data_in = "popup",
trigger_return = "change",
return_class = "data.frame",
# Custom functions to read data
read_fns = list(
ods = import_ods,
dta = function(file) {
haven::read_dta(
file = file,
.name_repair = "unique_quiet"
)
},
# csv = function(file) {
# readr::read_csv(
# file = file,
# na = consider.na,
# name_repair = "unique_quiet"
# )
# },
csv = import_delim,
tsv = import_delim,
txt = import_delim,
xls = import_xls,
xlsx = import_xls,
rds = function(file) {
readr::read_rds(
file = file,
name_repair = "unique_quiet"
)
}
server <- function(input, output, session) {
imported <- import_file_server(
id = "myid",
show_data_in = "popup",
trigger_return = "change",
return_class = "data.frame",
# Custom functions to read data
read_fns = list(
ods = import_ods,
dta = function(file) {
haven::read_dta(
file = file,
.name_repair = "unique_quiet"
)
},
# csv = function(file) {
# readr::read_csv(
# file = file,
# na = consider.na,
# name_repair = "unique_quiet"
# )
# },
csv = import_delim,
tsv = import_delim,
txt = import_delim,
xls = import_xls,
xlsx = import_xls,
rds = function(file) {
readr::read_rds(
file = file,
name_repair = "unique_quiet"
)
}
)
)
)
output$status <- shiny::renderPrint({
imported$status()
})
output$name <- shiny::renderPrint({
imported$name()
})
output$code <- shiny::renderPrint({
imported$code()
})
output$data <- shiny::renderPrint({
imported$data()
})
}
if (FALSE) {
output$status <- shiny::renderPrint({
imported$status()
})
output$name <- shiny::renderPrint({
imported$name()
})
output$code <- shiny::renderPrint({
imported$code()
})
output$data <- shiny::renderPrint({
imported$data()
})
}
shiny::shinyApp(ui, server)
}
@ -7051,9 +7034,9 @@ ui_elements <- list(
bslib::accordion_panel(
vlaue = "acc_cor",
title = "Correlations",
icon = bsicons::bs_icon("table"),
icon = bsicons::bs_icon("bounding-box"),
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(),
shinyWidgets::noUiSliderInput(
inputId = "cor_cutoff",
@ -7064,7 +7047,8 @@ ui_elements <- list(
value = .8,
format = shinyWidgets::wNumbFormat(decimals = 2),
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({
shiny::selectInput(
columnSelectInput(
inputId = "outcome_var_cor",
selected = NULL,
selected = "none",
data = rv$list$data,
label = "Select outcome variable",
choices = c(
col_subset = c(
"none",
colnames(rv$list$data)
# ,"none"
),
multiple = FALSE
)
@ -8018,10 +8003,10 @@ server <- function(input, output, session) {
id = "correlations",
data = shiny::reactive({
shiny::req(rv$list$data)
out <- dplyr::select(rv$list$data, -!!input$outcome_var_cor)
# input$outcome_var_cor=="none"){
# out <- rv$list$data
# }
out <- rv$list$data
if (!is.null(input$outcome_var_cor) && input$outcome_var_cor!="none"){
out <- out[!names(out) %in% input$outcome_var_cor]
}
out
}),
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
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
bundleId: 9932726
bundleId: 9937654
url: https://agdamsbo.shinyapps.io/freesearcheR/
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({
shiny::selectInput(
columnSelectInput(
inputId = "outcome_var_cor",
selected = NULL,
selected = "none",
data = rv$list$data,
label = "Select outcome variable",
choices = c(
col_subset = c(
"none",
colnames(rv$list$data)
# ,"none"
),
multiple = FALSE
)
@ -641,10 +642,10 @@ server <- function(input, output, session) {
id = "correlations",
data = shiny::reactive({
shiny::req(rv$list$data)
out <- dplyr::select(rv$list$data, -!!input$outcome_var_cor)
# input$outcome_var_cor=="none"){
# out <- rv$list$data
# }
out <- rv$list$data
if (!is.null(input$outcome_var_cor) && input$outcome_var_cor!="none"){
out <- out[!names(out) %in% input$outcome_var_cor]
}
out
}),
cutoff = shiny::reactive(input$cor_cutoff)

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

@ -311,9 +311,9 @@ ui_elements <- list(
bslib::accordion_panel(
vlaue = "acc_cor",
title = "Correlations",
icon = bsicons::bs_icon("table"),
icon = bsicons::bs_icon("bounding-box"),
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(),
shinyWidgets::noUiSliderInput(
inputId = "cor_cutoff",
@ -324,7 +324,8 @@ ui_elements <- list(
value = .8,
format = shinyWidgets::wNumbFormat(decimals = 2),
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]",
"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": {
"Package": "ggeffects",
"Version": "2.2.0",