From 81b4b02f07eb5ece99fd32bb7db85ad61104d714 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 3 Nov 2023 15:41:02 +0100
Subject: [PATCH 1/5] add base r graph
---
R/mod_boxplots.R | 166 ++++++++++++++++++++++++++++++++++++++++++++++-
R/utils.R | 5 ++
2 files changed, 170 insertions(+), 1 deletion(-)
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index d2b5155..60af8c2 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -9,6 +9,7 @@
#' @importFrom shiny NS tagList
#' @importFrom sortable rank_list bucket_list add_rank_list sortable_options
#' @importFrom ggstatsplot ggbetweenstats
+#' @importFrom car Boxplot
#' @import PMCMRplus
tmpdir <- tempdir()
@@ -365,7 +366,7 @@ mod_boxplots_server <- function(id, r = r, session = session){
LL <- list()
req(r_values$tabF_melt2, r_values$fact3ok)
fact3ok <- r_values$fact3ok
-
+ tabF_melt2 <- r_values$tabF_melt2
if(input$outtype == "all"){
tabF_melt2 <- r_values$tabF_melt2
}else{
@@ -642,11 +643,174 @@ mod_boxplots_server <- function(id, r = r, session = session){
)
+ output$pdf_rbase <- downloadHandler(
+ filename = glue::glue("{input$outtype}_figuresRbase_{systim}.pdf"),
+ content = function(file) {
+ req(r_values$tabF_melt2,r_values$fact3ok)
+ tabF_melt2 <- r_values$tabF_melt2
+
+ print(unique(tabF_melt2[r_values$fact3ok]))
+ print(input$sorted1)
+ if(!any(unique(tabF_melt2[r_values$fact3ok]) %in% input$sorted1)){
+ # validate("Run plot/stats & tests again.")
+ print("Run plot/stats & tests again.")
+ }
+
+ pdf(file)
+ for(i in 1:length(levels(tabF_melt2$features))){
+
+ if(input$nbPicPage == 4){
+ if((i %% 4) == 1) {par(mfrow= c(2,2), mar=c(4,4,2,0.5))}
+ }else if(input$nbPicPage == 3){
+ if((i %% 3) == 1) {
+ if(input$verticaldisplay){
+ par(mfrow= c(1,3), mar=c(4,4,2,0.5))
+ }else{
+ par(mfrow= c(3,1), mar=c(4,4,2,0.5))
+ }
+ }
+ }else if(input$nbPicPage == 2){
+ if((i %% 2) == 1) {
+ if(input$verticaldisplay){
+ par(mfrow= c(1,2), mar=c(4,4,2,0.5))
+ }else{
+ par(mfrow= c(2,1), mar=c(4,4,2,0.5))
+ }
+ }
+ }
+
+ feat1 <- levels(tabF_melt2$features)[i]
+ if(input$custom_ytitle != "None"){
+ YLAB <- input$custom_ytitle
+ }else{
+ YLAB <- stringr::str_split_1(feat1, "__")[3]
+ }
+
+
+
+ fun1 <- glue::glue('
+ tab1 <- tabF_melt2 %>% dplyr::filter(features == feat1) %>%
+ tidyr::separate(features, c("feature","type","unit"), "__", remove= FALSE) %>%
+ dplyr::filter({r_values$fact3ok} %in% input$sorted1) %>%
+ droplevels() %>%
+ mutate({r_values$fact3ok} = factor({r_values$fact3ok}, levels = input$sorted1))
+ ')
+ eval(parse(text=fun1))
+ row.names(tab1) <- tab1$sample.id
+ if(input$outlier_labs){
+ car::Boxplot(as.formula(glue::glue("value~{r_values$fact3ok}")), data = tab1, main = feat1,
+ cex.main = 0.6, boxwex=.3, col = gg_color_hue(nrow(unique(tab1[r_values$fact3ok]))),
+ cex.lab = 0.9, cex.axis = 0.5, las = 2, xlab = "", ylab = YLAB,
+ ylim=c(0,max(tab1$value, na.rm = TRUE)))
+ }else{
+ boxplot(as.formula(glue::glue("value~{r_values$fact3ok}")), data = tab1, main = feat1,
+ cex.main = 0.6, boxwex=.3, col = gg_color_hue(nrow(unique(tab1[r_values$fact3ok]))),
+ cex.lab = 0.9, cex.axis = 0.5, las = 2, xlab = "", ylab = "area",
+ ylim=c(0,max(tab1$value, na.rm = TRUE)))
+ }
+
+ grid()
+ }
+ dev.off()
+
+ })
+
+ output$downloadTAR_rbase <- downloadHandler(
+ filename <- glue::glue("{tmpdir}/figures_jpgs_rbase.tar"),
+
+ content <- function(file) {
+ print("WRITE PLOTS")
+ systim <- as.numeric(Sys.time())
+ print(glue::glue("{tmpdir}/figures_jpgs/figures_{systim}"))
+ dir.create(glue::glue("{tmpdir}/figures_jpgs/figures_{systim}"), recursive = TRUE)
+
+ req(r_values$tabF_melt2,r_values$fact3ok)
+ tabF_melt2 <- r_values$tabF_melt2
+
+
+ for(i in 1:length(levels(tabF_melt2$features))){
+
+ if(input$nbPicPage == 4){
+ if((i %% 4) == 1) {par(mfrow= c(2,2), mar=c(4,4,2,0.5))}
+ }else if(input$nbPicPage == 3){
+ if((i %% 3) == 1) {
+ if(input$verticaldisplay){
+ par(mfrow= c(1,3), mar=c(4,4,2,0.5))
+ }else{
+ par(mfrow= c(3,1), mar=c(4,4,2,0.5))
+ }
+ }
+ }else if(input$nbPicPage == 2){
+ if((i %% 2) == 1) {
+ if(input$verticaldisplay){
+ par(mfrow= c(1,2), mar=c(4,4,2,0.5))
+ }else{
+ par(mfrow= c(2,1), mar=c(4,4,2,0.5))
+ }
+ }
+ }
+
+ feat1 <- levels(tabF_melt2$features)[i]
+ if(input$custom_ytitle != "None"){
+ YLAB <- input$custom_ytitle
+ }else{
+ YLAB <- stringr::str_split_1(feat1, "__")[3]
+ }
+
+ fun1 <- glue::glue('
+ tab1 <- tabF_melt2 %>% dplyr::filter(features == feat1) %>%
+ tidyr::separate(features, c("feature","type","unit"), "__", remove= FALSE) %>%
+ dplyr::filter({r_values$fact3ok} %in% input$sorted1) %>%
+ droplevels() %>%
+ mutate({r_values$fact3ok} = factor({r_values$fact3ok}, levels = input$sorted1))
+ ')
+ eval(parse(text=fun1))
+ row.names(tab1) <- tab1$sample.id
+
+ met1 <- stringr::str_split_1(feat1, "__")[1]
+ typ1 <- stringr::str_split_1(feat1, "__")[2]
+ jpeg(glue::glue("{tmpdir}/figures_jpgs/figures_{systim}/bp_{met1}_{typ1}.jpeg"),
+ width = 800, height = 800, quality = 100, res = 150)
+ if(input$outlier_labs){
+ car::Boxplot(as.formula(glue::glue("value~{r_values$fact3ok}")), data = tab1, main = feat1,
+ cex.main = 0.6, boxwex=.3, col = gg_color_hue(nrow(unique(tab1[r_values$fact3ok]))),
+ cex.lab = 0.9, cex.axis = 0.5, las = 2, xlab = "", ylab = YLAB,
+ ylim=c(0,max(tab1$value, na.rm = TRUE)))
+ }else{
+ boxplot(as.formula(glue::glue("value~{r_values$fact3ok}")), data = tab1, main = feat1,
+ cex.main = 0.6, boxwex=.3, col = gg_color_hue(nrow(unique(tab1[r_values$fact3ok]))),
+ cex.lab = 0.9, cex.axis = 0.5, las = 2, xlab = "", ylab = "area",
+ ylim=c(0,max(tab1$value, na.rm = TRUE)))
+ }
+
+ grid()
+ dev.off()
+ }
+
+
+ tar(filename, files = glue::glue("{tmpdir}/figures_jpgs/figures_{systim}") )
+
+
+ file.copy(filename, file)
+ },
+ contentType = "application/tar"
+ )
+
+
+
+
+
output$DLbuttons <- renderUI({
req(input$go3)
tagList(
+ column(width = 6,
downloadButton(outputId = ns("boxplots_download"), label = "Download PDF (long process)"),
downloadButton(outputId = ns("downloadTAR"), label = "Download Images (long process)")
+ ),
+ column(width = 6,
+ downloadButton(outputId = ns("pdf_rbase"), label = "Download PDF rbase (faster)"),
+ downloadButton(outputId = ns("downloadTAR_rbase"), label = "Download JPEG rbase (faster)")
+ )
)
})
diff --git a/R/utils.R b/R/utils.R
index 8cd8770..c25633a 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -2,6 +2,11 @@
#' @param x a dataframe
#'
+gg_color_hue <- function(n) {
+ hues = seq(15, 375, length = n + 1)
+ hcl(h = hues, l = 65, c = 100)[1:n]
+}
+
replace_mu <- function(x){
for(i in 1:ncol(x)){
if(is.factor(x[,i])){
--
GitLab
From a55865ba5527993fa7d38d1972c08e099ac716c8 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 8 Nov 2023 13:11:34 +0100
Subject: [PATCH 2/5] update
---
R/mod_boxplots.R | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index 8fc6867..e017505 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -782,10 +782,10 @@ mod_boxplots_server <- function(id, r = r, session = session){
next
}
- met1 <- stringr::str_split_1(feat1, "__")[1]
- typ1 <- stringr::str_split_1(feat1, "__")[2]
+ met1 <- stringr::str_split_1(feat1, "__")[1] %>% stringr::str_replace("/", "_")
+ typ1 <- stringr::str_split_1(feat1, "__")[2] %>% stringr::str_replace("/", "_")
jpeg(glue::glue("{tmpdir}/figures_jpgs/figures_{systim}/bp_{met1}_{typ1}.jpeg"),
- width = 800, height = 800, quality = 100, res = 150)
+ width = 1422, height = 800, quality = 100, res = 150)
if(input$outlier_labs){
car::Boxplot(as.formula(glue::glue("value~{r_values$fact3ok}")), data = tab1, main = feat1,
cex.main = 0.6, boxwex=.3, col = gg_color_hue(nrow(unique(tab1[r_values$fact3ok]))),
--
GitLab
From b0de150a3b0143f88ea78daf8ed61d931c3b2c83 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 8 Nov 2023 13:43:51 +0100
Subject: [PATCH 3/5] document
---
DESCRIPTION | 3 +++
NAMESPACE | 1 +
man/replace_mu.Rd | 14 --------------
3 files changed, 4 insertions(+), 14 deletions(-)
delete mode 100644 man/replace_mu.Rd
diff --git a/DESCRIPTION b/DESCRIPTION
index 68c3d9b..022bb47 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -7,6 +7,9 @@ Description: A shiny app to easily generate advanced graphics and some non
parametric tests.
License: MIT + file LICENSE
Imports:
+ base64enc,
+ bit64,
+ car,
config (>= 0.3.1),
datamods,
dplyr,
diff --git a/NAMESPACE b/NAMESPACE
index 42b7c9c..72806cc 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,6 +13,7 @@ import(shinydashboard)
import(tibble)
import(tidyr)
importFrom(bit64,is.integer64)
+importFrom(car,Boxplot)
importFrom(factoextra,fviz_pca_var)
importFrom(factoextra,get_pca_var)
importFrom(ggrepel,geom_text_repel)
diff --git a/man/replace_mu.Rd b/man/replace_mu.Rd
deleted file mode 100644
index c710497..0000000
--- a/man/replace_mu.Rd
+++ /dev/null
@@ -1,14 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.R
-\name{replace_mu}
-\alias{replace_mu}
-\title{replace_mu}
-\usage{
-replace_mu(x)
-}
-\arguments{
-\item{x}{a dataframe}
-}
-\description{
-replace_mu
-}
--
GitLab
From f478588706bc78e323560014ad0bf2d65c173611 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 8 Nov 2023 13:44:03 +0100
Subject: [PATCH 4/5] document
---
man/gg_color_hue.Rd | 14 ++++++++++++++
1 file changed, 14 insertions(+)
create mode 100644 man/gg_color_hue.Rd
diff --git a/man/gg_color_hue.Rd b/man/gg_color_hue.Rd
new file mode 100644
index 0000000..75d359b
--- /dev/null
+++ b/man/gg_color_hue.Rd
@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{gg_color_hue}
+\alias{gg_color_hue}
+\title{replace_mu}
+\usage{
+gg_color_hue(n)
+}
+\arguments{
+\item{x}{a dataframe}
+}
+\description{
+replace_mu
+}
--
GitLab
From 3151925e338539be7da0d3b8a912eea213eafd02 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 16 Nov 2023 14:47:27 +0100
Subject: [PATCH 5/5] version
---
DESCRIPTION | 2 +-
R/app_ui.R | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 022bb47..ce61f31 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: graphstatsr
Title: graphstatsr
-Version: 1.8.1
+Version: 1.9.0
Authors@R:
person("Etienne", "Rifa", , "etienne.rifa@insa-toulouse.fr", role = c("cre", "aut"))
Description: A shiny app to easily generate advanced graphics and some non
diff --git a/R/app_ui.R b/R/app_ui.R
index 62450aa..f76cf3c 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -19,7 +19,7 @@ app_ui <- function(request) {
# )
dashboardPage(skin = "red",
dashboardHeader(
- title = "GraphStatsR 1.8.1",
+ title = "GraphStatsR 1.9.0",
tags$li(class="dropdown",tags$a("Hosted by", img(src = SK8img,
title = "SK8", height = "20px"), headerText = "Source code",href="https://sk8.inrae.fr/", target="_blank")),
--
GitLab