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

updated feedback links

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-05-05 14:45:07 +02:00
parent b7b688f8b1
commit 868df9f8f1
No known key found for this signature in database
2 changed files with 73 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

110
inst/apps/FreesearchR/app.R
View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'v25.4.4.250430' app_version <- function()'25.5.1'
######## ########
@ -1619,15 +1619,23 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
title = "Download", title = "Download",
icon = bsicons::bs_icon("download"), icon = bsicons::bs_icon("download"),
shinyWidgets::noUiSliderInput( shinyWidgets::noUiSliderInput(
inputId = ns("height"), inputId = ns("height_slide"),
label = "Plot height (mm)", label = "Plot height (mm)",
min = 50, min = 50,
max = 300, max = 300,
value = 100, value = 100,
step = 1, step = 1,
format = shinyWidgets::wNumbFormat(decimals = 0), format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color() color = datamods:::get_primary_color(),
inline = TRUE
), ),
# shiny::numericInput(
# inputId = ns("height_numeric"),
# label = "Plot height (mm)",
# min = 50,
# max = 300,
# value = 100
# ),
shinyWidgets::noUiSliderInput( shinyWidgets::noUiSliderInput(
inputId = ns("width"), inputId = ns("width"),
label = "Plot width (mm)", label = "Plot width (mm)",
@ -1946,17 +1954,32 @@ data_visuals_server <- function(id,
} }
}) })
# shiny::observeEvent(input$height_numeric, {
# shinyWidgets::updateNoUiSliderInput(session, ns("height_slide"), value = input$height_numeric)
# }, ignoreInit = TRUE)
# shiny::observeEvent(input$height_slide, {
# shiny::updateNumericInput(session, ns("height_numeric"), value = input$height_slide)
# }, ignoreInit = TRUE)
output$download_plot <- shiny::downloadHandler( output$download_plot <- shiny::downloadHandler(
filename = shiny::reactive({ filename = shiny::reactive({
paste0("plot.", input$plot_type) paste0("plot.", input$plot_type)
}), }),
content = function(file) { content = function(file) {
if (inherits(rv$plot,"patchwork")){
plot <- rv$plot
} else {
plot <- rv$plot[[1]]
}
# browser()
shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", { shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
ggplot2::ggsave( ggplot2::ggsave(
filename = file, filename = file,
plot = rv$plot, plot = plot,
width = input$width, width = input$width,
height = input$height, height = input$height_slide,
dpi = 300, dpi = 300,
units = "mm", scale = 2 units = "mm", scale = 2
) )
@ -2091,8 +2114,8 @@ supported_plots <- function() {
fun = "plot_euler", fun = "plot_euler",
descr = "Euler diagram", descr = "Euler diagram",
note = "Generate area-proportional Euler diagrams to display set relationships", note = "Generate area-proportional Euler diagrams to display set relationships",
primary.type = "dichotomous", primary.type = c("dichotomous", "categorical"),
secondary.type = "dichotomous", secondary.type = c("dichotomous", "categorical"),
secondary.multi = TRUE, secondary.multi = TRUE,
secondary.max = 4, secondary.max = 4,
tertiary.type = c("dichotomous", "categorical"), tertiary.type = c("dichotomous", "categorical"),
@ -3338,7 +3361,7 @@ write_rmd <- function(data, ...) {
## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041 ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
## Outputs to the same as the .qmd file ## Outputs to the same as the .qmd file
rmarkdown::render( rmarkdown::render(
params = list(data.file = "web_data.rds"), params = list(data.file = "web_data.rds",version=app_version()),
# execute_params = list(data.file = temp), # execute_params = list(data.file = temp),
... ...
) )
@ -3927,6 +3950,13 @@ is_identical_to_previous <- function(data, no.name = TRUE) {
} }
########
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
########
hosted_version <- function()'v25.5.1-250505'
######## ########
#### Current file: /Users/au301842/FreesearchR/R//html_dependency_freesearchr.R #### Current file: /Users/au301842/FreesearchR/R//html_dependency_freesearchr.R
######## ########
@ -4784,6 +4814,12 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
#' ) |> plot_euler_single() #' ) |> plot_euler_single()
#' mtcars[c("vs", "am")] |> plot_euler_single() #' mtcars[c("vs", "am")] |> plot_euler_single()
plot_euler_single <- function(data) { plot_euler_single <- function(data) {
# if (any("categorical" %in% data_type(data))){
# shape <- "ellipse"
# } else {
# shape <- "circle"
# }
data |> data |>
ggeulerr(shape = "circle") + ggeulerr(shape = "circle") +
ggplot2::theme_void() + ggplot2::theme_void() +
@ -5529,7 +5565,9 @@ m_redcap_readServer <- function(id) {
) )
# browser() # browser()
shiny::withProgress({
imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
},message = paste("Connecting to",data_rv$uri))
## TODO: Simplify error messages ## TODO: Simplify error messages
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
@ -5556,8 +5594,10 @@ m_redcap_readServer <- function(id) {
include_data_alert( include_data_alert(
see_data_text = "Click to see data dictionary", see_data_text = "Click to see data dictionary",
dataIdName = "see_data", dataIdName = "see_data",
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), extra = tags$p(
glue::glue("The {data_rv$info$project_title} project is loaded.")), tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
glue::glue("The {data_rv$info$project_title} project is loaded.")
),
btn_show_data = TRUE btn_show_data = TRUE
) )
) )
@ -7521,7 +7561,8 @@ regression_server <- function(id,
shiny::observeEvent( shiny::observeEvent(
list( list(
data_r() data_r(),
regression_vars()
), ),
{ {
rv$list$regression$tables <- NULL rv$list$regression$tables <- NULL
@ -9687,14 +9728,28 @@ ui_elements <- list(
), ),
############################################################################## ##############################################################################
######### #########
######### Documentation panel ######### Feedback link
#########
##############################################################################
"feedback" = bslib::nav_item(
# shiny::img(shiny::icon("book")),
shiny::tags$a(
href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8",
"Feedback",shiny::icon("arrow-up-right-from-square"),
target = "_blank",
rel = "noopener noreferrer"
)
),
##############################################################################
#########
######### Documentation link
######### #########
############################################################################## ##############################################################################
"docs" = bslib::nav_item( "docs" = bslib::nav_item(
# shiny::img(shiny::icon("book")), # shiny::img(shiny::icon("book")),
shiny::tags$a( shiny::tags$a(
href = "https://agdamsbo.github.io/FreesearchR/", href = "https://agdamsbo.github.io/FreesearchR/",
"Docs (external)", "Docs",shiny::icon("arrow-up-right-from-square"),
target = "_blank", target = "_blank",
rel = "noopener noreferrer" rel = "noopener noreferrer"
) )
@ -9736,6 +9791,7 @@ ui <- bslib::page_fixed(
ui_elements$analyze, ui_elements$analyze,
ui_elements$download, ui_elements$download,
bslib::nav_spacer(), bslib::nav_spacer(),
ui_elements$feedback,
ui_elements$docs, ui_elements$docs,
fillable = FALSE, fillable = FALSE,
footer = shiny::tags$footer( footer = shiny::tags$footer(
@ -9746,7 +9802,7 @@ ui <- bslib::page_fixed(
), ),
shiny::p( shiny::p(
style = "margin: 1; color: #888;", style = "margin: 1; color: #888;",
shiny::tags$a("Docs", href = "https://agdamsbo.github.io/FreesearchR/", target = "_blank", rel = "noopener noreferrer")," | ", app_version(), " | ", shiny::tags$a("License: AGPLv3", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Share feedback", href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8", target = "_blank", rel = "noopener noreferrer") shiny::tags$a("Docs", href = "https://agdamsbo.github.io/FreesearchR/", target = "_blank", rel = "noopener noreferrer")," | ", hosted_version(), " | ", shiny::tags$a("License: AGPLv3", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Share feedback", href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8", target = "_blank", rel = "noopener noreferrer")
), ),
) )
) )
@ -9773,9 +9829,7 @@ library(quarto)
library(here) library(here)
library(broom) library(broom)
library(broom.helpers) library(broom.helpers)
# library(REDCapCAST)
library(easystats) library(easystats)
# library(esquisse)
library(patchwork) library(patchwork)
library(DHARMa) library(DHARMa)
library(apexcharter) library(apexcharter)
@ -9786,32 +9840,17 @@ library(shinyWidgets)
library(DT) library(DT)
library(data.table) library(data.table)
library(gtsummary) library(gtsummary)
# library(FreesearchR)
# source("functions.R")
data(starwars) data(starwars)
data(mtcars) data(mtcars)
mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
mtcars_date$date <- as.Date(sample(seq_len(365), nrow(mtcars)))
data(trial) data(trial)
# light <- custom_theme()
#
# dark <- custom_theme(bg = "#000",fg="#fff")
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.
files.to.keep <- list.files("www/") files.to.keep <- list.files("www/")
output$docs_file <- shiny::renderUI({
# shiny::includeHTML("www/docs.html")
shiny::HTML(readLines("www/docs.html"))
})
############################################################################## ##############################################################################
######### #########
######### Night mode (just very popular, not really needed) ######### Night mode (just very popular, not really needed)
@ -10480,20 +10519,11 @@ server <- function(input, output, session) {
paste0("report.", input$output_type) paste0("report.", input$output_type)
}), }),
content = function(file, type = input$output_type) { content = function(file, type = input$output_type) {
# browser()
# shiny::req(rv$list$regression)
## Notification is not progressing ## Notification is not progressing
## Presumably due to missing ## Presumably due to missing
# browser()
# Simplified for .rmd output attempt # Simplified for .rmd output attempt
format <- ifelse(type == "docx", "word_document", "odt_document") format <- ifelse(type == "docx", "word_document", "odt_document")
# browser()
# if (shiny::is.reactive(rv$regression)){
# rv$list$regression <- rv$regression()
# }
# rv$list$regression <- rv$regression()
rv$list$regression <- rv$regression() rv$list$regression <- rv$regression()
shiny::withProgress(message = "Generating the report. Hold on for a moment..", { shiny::withProgress(message = "Generating the report. Hold on for a moment..", {

2
inst/apps/FreesearchR/www/intro.md
View file

@ -30,4 +30,4 @@ Here is a brief summary of the functions:
- Code to recreate all steps locally - Code to recreate all steps locally
The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed description of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8), or share on [GitHub](https://github.com/agdamsbo/FreesearchR/issues). The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed description of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).