Merge pull request #9 from ricoderks/dev

Dev

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: lipidomics
 Type: Package
 Title: Lipidomics workflow
-Version: 0.5
+Version: 0.6.0
 Author: Rico Derks
 Maintainer: Rico Derks <[email protected]>
 Description: Lipidomics workflow to proces the result files (export alignment)
@@ -10,6 +10,7 @@ License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
 Imports:
+    broom,
     dplyr,
     DT,
     ggCPM,

NAMESPACE

@@ -5,6 +5,7 @@ import(shiny)
 import(tidyselect)
 importFrom(DT,DTOutput)
 importFrom(DT,renderDT)
+importFrom(broom,tidy)
 importFrom(dplyr,across)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
@@ -74,6 +75,7 @@ importFrom(plotly,plot_ly)
 importFrom(plotly,plotlyOutput)
 importFrom(plotly,renderPlotly)
 importFrom(purrr,map)
+importFrom(purrr,map_dbl)
 importFrom(readr,col_character)
 importFrom(readr,col_double)
 importFrom(readr,col_integer)
@@ -91,7 +93,9 @@ importFrom(recipes,step_pca)
 importFrom(recipes,step_scale)
 importFrom(recipes,tidy)
 importFrom(recipes,update_role)
+importFrom(rlang,"!!")
 importFrom(rlang,.data)
+importFrom(rlang,sym)
 importFrom(scales,scientific)
 importFrom(sessioninfo,session_info)
 importFrom(shiny,NS)
@@ -103,13 +107,15 @@ importFrom(shinyjs,hidden)
 importFrom(shinyjs,toggle)
 importFrom(shinyjs,useShinyjs)
 importFrom(stats,cor)
+importFrom(stats,p.adjust)
 importFrom(stats,sd)
 importFrom(stringr,str_extract)
 importFrom(stringr,str_replace)
 importFrom(stringr,str_split)
 importFrom(tibble,column_to_rownames)
 importFrom(tibble,tibble)
 importFrom(tidyr,everything)
+importFrom(tidyr,nest)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyr,separate)

R/box_plot.R

@@ -0,0 +1,37 @@
+#' @title Create box plot
+#'
+#' @description Create box plot.
+#'
+#' @param lipid_data tibble with all the lipid data and test data
+#' @param title title of the plot
+#'
+#' @return plotly object
+#'
+#' @importFrom magrittr %>%
+#' @importFrom dplyr filter select
+#' @importFrom tidyr unnest
+#' @importFrom rlang .data
+#' @importFrom plotly plot_ly layout hide_legend
+#'
+#' @author Rico Derks
+#'
+box_plot <- function(lipid_data, title = "") {
+  # create the plot
+  p <- lipid_data %>%
+    plot_ly(x = ~my_group_info,
+            y = ~value,
+            text = ~sample_name,
+            color = ~my_group_info,
+            type = "box",
+            boxpoints = "all",
+            jitter = 0.4,
+            pointpos = 0) %>%
+    layout(title = list(text = title,
+                        x = 0),
+           yaxis = list(title = "Value",
+                        exponentformat = "E"),
+           xaxis = list(title = "Group")) %>%
+    hide_legend()
+
+  return(p)
+}

R/do_mwtest.R

@@ -0,0 +1,41 @@
+#' @title Do a Mann-Whitney U test on all lipids
+#'
+#' @description Do a Mann-Whitney U test on all lipids
+#'
+#' @param lipid_data tibble in tidy format, already nested
+#'
+#' @details A Mann-Whitney U test will be done for each lipid. Also the p-value will be corrected
+#'     for multiple testing.
+#'
+#' @return a tibble with the results and the following columns
+#'     model_test contains the model information for each lipid (nested)
+#'     pvalue contains the uncorrected pvalue
+#'     pvalue_cor contains the corrected pvalue
+#'     fc the fold change estimate1/estimate2
+#'
+#' @import tidyselect
+#' @importFrom dplyr mutate group_by summarise pull
+#' @importFrom tidyr pivot_wider
+#' @importFrom magrittr %>%
+#' @importFrom rlang .data
+#' @importFrom purrr map map_dbl
+#' @importFrom broom tidy
+#' @importFrom stats p.adjust
+#'
+#' @author Rico Derks
+#'
+do_mwtest <- function(lipid_data) {
+  results <- lipid_data %>%
+    mutate(model_test = map(.x = .data$test_data,
+                            .f = ~ broom::tidy(wilcox.test(formula = value ~ my_group_info,
+                                                           data = .x))),
+           pvalue = map_dbl(.x = .data$model_test,
+                            .f = ~ .x$p.value),
+           pvalue_adj = p.adjust(.data$pvalue,
+                                 method = "BH"),
+           p_log10 = -log10(.data$pvalue),
+           p_log10_adj = -log10(.data$pvalue_adj))
+
+  return(results)
+}
+

R/do_ttest.R

@@ -0,0 +1,42 @@
+#' @title Do a t-test on all lipids
+#'
+#' @description Do a t-test on all lipids.
+#'
+#' @param lipid_data tibble in tidy format, already nested
+#'
+#' @details A t-test will be done for each lipid. Also the p-value will be corrected
+#'     for multiple testing.
+#'
+#' @return a tibble with the results and the following columns
+#'     model_test contains the model information for each lipid (nested)
+#'     pvalue contains the uncorrected pvalue
+#'     pvalue_cor contains the corrected pvalue
+#'     fc the fold change estimate1/estimate2
+#'
+#' @import tidyselect
+#' @importFrom dplyr mutate
+#' @importFrom magrittr %>%
+#' @importFrom rlang .data
+#' @importFrom purrr map map_dbl
+#' @importFrom broom tidy
+#' @importFrom stats p.adjust
+#'
+#' @author Rico Derks
+#'
+do_ttest <- function(lipid_data) {
+  results <- lipid_data %>%
+    mutate(model_test = map(.x = .data$test_data,
+                            .f = ~ broom::tidy(t.test(formula = value ~ my_group_info,
+                                                      data = .x)) %>%
+                              # calculate the fold change
+                              mutate(fc = estimate1 / estimate2)),
+           pvalue = map_dbl(.x = .data$model_test,
+                            .f = ~ .x$p.value),
+           pvalue_adj = p.adjust(.data$pvalue,
+                                 method = "BH"),
+           p_log10 = -log10(.data$pvalue),
+           p_log10_adj = -log10(.data$pvalue_adj))
+
+  return(results)
+}
+

R/pca_observation_plot.R

@@ -29,7 +29,8 @@ pca_observation_plot <- function(obs_data, var_name, color_by = "none") {
             color = ~color_group) %>%
     add_bars() %>%
     layout(title = list(text = paste("Observation plot for", var_name),
-                        x = 0)) %>%
+                        x = 0),
+           xaxis = list(title = "Sample name")) %>%
     hide_legend() %>%
     config(displayModeBar = FALSE)
 

R/pca_scores_plot.R

@@ -37,7 +37,8 @@ pca_scores_plot <- function(scores_data, xaxis = "PC1", yaxis = "PC2", color_by
     layout(title = list(text = "Scores plot",
                         x = 0),
            xaxis = list(title = xaxis),
-           yaxis = list(title = yaxis)) %>%
+           yaxis = list(title = yaxis),
+           legend = list(orientation = "h")) %>%
     # config(displayModeBar = FALSE) %>%
     event_register(event = "plotly_click")
 

R/pca_variable_plot.R

@@ -32,7 +32,8 @@ pca_variable_plot <- function(var_data, sample_name) {
                    categoryorder = "array",
                    categoryarray =  ~order_x)) %>%
     layout(title = list(text = paste("Variable plot", sample_name),
-                        x = 0)) %>%
+                        x = 0),
+           xaxis = list(title = "Lipid")) %>%
     hide_legend()
 
   return(p)