Skip to content

Commit

Permalink
Merge pull request #10 from ricoderks/dev
Browse files Browse the repository at this point in the history
Dev
  • Loading branch information
ricoderks authored Jul 1, 2021
2 parents f2b40c1 + ebedf27 commit 8931eb2
Show file tree
Hide file tree
Showing 5 changed files with 146 additions and 85 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: lipidomics
Type: Package
Title: Lipidomics workflow
Version: 0.6.0
Version: 0.6.1
Author: Rico Derks
Maintainer: Rico Derks <[email protected]>
Description: Lipidomics workflow to proces the result files (export alignment)
Expand Down
65 changes: 65 additions & 0 deletions R/do_stat_test.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,65 @@
#' @title Do a statitical test
#'
#' @description Do a statitical test, t-test or Mann-Whitney U test
#'
#' @param lipid_data tibble in tidy format
#' @param group what column contains the group info
#' @param group1_name is the name of group 1
#' @param group2_name is the name of group 2
#' @param normalization what normalization to use, none (raw data) or total area normalization
#' @param transformation what transformation to use
#' @param test do a t-test or Mann-Whitney U test
#'
#' @return a tibble ready for statistical testing
#'
#' @import tidyselect
#' @importFrom dplyr select filter mutate rename group_by ungroup
#' @importFrom tidyr pivot_wider everything nest
#' @importFrom purrr map_dbl
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#'
#' @author Rico Derks
#'
do_stat_test <- function(lipid_data, group, group1_name, group2_name, normalization = c("raw", "tot_area"), transformation = c("none", "log10"),
test) {

if(group1_name != "none" &
group2_name != "none" &
group1_name != group2_name) {
prep_test_data <- lipid_data %>%
filter(.data$keep == TRUE) %>%
rename(my_group_info = !!sym(group)) %>%
filter(.data$my_group_info == group1_name |
.data$my_group_info == group2_name) %>%
select(.data$my_id, .data$ShortLipidName, .data$LipidClass, .data$sample_name, .data$my_group_info, .data$area) %>%
# total area normalisation
group_by(.data$sample_name) %>%
mutate(norm_area = .data$area / sum(.data$area)) %>%
ungroup() %>%
# select which normalization to use for PCA
mutate(value = case_when(
normalization == "raw" ~ .data$area,
normalization == "tot_area" ~ .data$norm_area
)) %>%
# do transformations and select which transformation to keep
mutate(value = case_when(
transformation == "none" ~ .data$value,
transformation == "log10" ~ log10(.data$value + 1) # the +1 is correct for any zero's
)) %>%
# remove the 2 area columns
select(-.data$area, -.data$norm_area) %>%
nest(test_data = c(.data$sample_name, .data$my_group_info, .data$value)) %>%
mutate(fc = map_dbl(.x = .data$test_data,
.f = ~ mean(.x$value[.x$my_group_info == group1_name]) / mean(.x$value[.x$my_group_info == group2_name])),
fc_log2 = log2(.data$fc))

result <- switch(test,
"ttest" = do_ttest(lipid_data = prep_test_data),
"mwtest" = do_mwtest(lipid_data = prep_test_data))
} else {
result <- NULL
}

return(result)
}
122 changes: 39 additions & 83 deletions R/shinyAppServer.R
Original file line number Diff line number Diff line change
Expand Up @@ -117,19 +117,19 @@ shinyAppServer <- function(input, output, session) {

# tag lipid class/ion which should be removed
# find the id's to keep
keep_lipids_class <- all_data$lipid_data %>%
filter(.data$class_ion %in% all_data$class_ion_selected) %>%
keep_class <- all_data$lipid_data %>%
filter(.data$class_ion %in% default_class_ion) %>%
distinct(.data$my_id) %>%
pull(.data$my_id)

# tag lipids which have a too high RSD value
# find the lipids to keep
keep_lipids_rsd <- all_data$qc_results %>%
keep_rsd <- all_data$qc_results %>%
filter(.data$rsd_area <= 0.3) %>%
distinct(.data$my_id) %>%
pull(.data$my_id)

keep_lipids_msms <- all_data$lipid_data %>%
keep_msms <- all_data$lipid_data %>%
filter(!(.data$DotProduct <= 50 &
.data$RevDotProduct <= 50 &
.data$keep == TRUE)) %>%
Expand All @@ -139,14 +139,14 @@ shinyAppServer <- function(input, output, session) {
all_data$lipid_data_filter <- all_data$lipid_data_long %>%
mutate(
keep = case_when(
!(.data$my_id %in% keep_lipids_rsd) ~ FALSE,
!(.data$my_id %in% keep_lipids_msms) ~ FALSE,
!(.data$my_id %in% keep_lipids_class) ~ FALSE,
!(.data$my_id %in% keep_rsd) ~ FALSE,
!(.data$my_id %in% keep_msms) ~ FALSE,
!(.data$my_id %in% keep_class) ~ FALSE,
TRUE ~ TRUE),
comment = case_when(
!(.data$my_id %in% keep_lipids_rsd) ~ "large_rsd",
!(.data$my_id %in% keep_lipids_msms) ~ "no_match",
!(.data$my_id %in% keep_lipids_class) ~ "remove_class",
!(.data$my_id %in% keep_rsd) ~ "large_rsd",
!(.data$my_id %in% keep_msms) ~ "no_match",
!(.data$my_id %in% keep_class) ~ "remove_class",
TRUE ~ "")
)
})
Expand Down Expand Up @@ -455,7 +455,7 @@ shinyAppServer <- function(input, output, session) {

# get the id's to keep lipids which lipid class is selected
keep_lipids_class <- tmp_filter %>%
filter(.data$class_ion %in% class_ion_selected) %>%
filter(.data$class_ion %in% all_data$class_ion_selected) %>%
distinct(.data$my_id) %>%
pull(.data$my_id)

Expand Down Expand Up @@ -1319,8 +1319,7 @@ shinyAppServer <- function(input, output, session) {
#### Analysis part

observe({
req(all_data$lipid_data_filter,
all_data$samples_selected)
req(all_data$lipid_data_filter)

# remove samples for the analysis part
if(!is.null(all_data$samples_selected)) {
Expand Down Expand Up @@ -1366,16 +1365,35 @@ shinyAppServer <- function(input, output, session) {
#### end heatmap

#### compare samples
test_result <- reactive({
req(all_data$analysis_data,
input$test_group1,
input$test_group2,
input$select_test,
input$select_test_normalization,
input$select_test_transformation)

results_test <- do_stat_test(lipid_data = isolate(all_data$analysis_data),
group = input$test_select_group,
group1_name = input$test_group1,
group2_name = input$test_group2,
normalization = input$select_test_normalization,
transformation = input$select_test_transformation,
test = input$select_test)

return(results_test)
})

# create some ui output
output$test_group_selection <- renderUI({
req(all_data$analysis_data)
req(all_data$meta_data)

if(all_data$merged_data == TRUE & !is.null(input$select_group_column)) {
tagList(
selectInput(inputId = "test_select_group",
label = "Select a group:",
choices = c("none", input$select_group_column),
selected = "none"),
choices = input$select_group_column,
selected = input$select_group_column[1]),
uiOutput(outputId = "test_vs_groups")
)
}
Expand Down Expand Up @@ -1409,73 +1427,13 @@ shinyAppServer <- function(input, output, session) {

updateSelectInput(inputId = "test_group1",
label = "Group 1:",
choices = c("none", group_options))
choices = group_options,
selected = group_options[1])

updateSelectInput(inputId = "test_group2",
label = "Group 2:",
choices = c("none", group_options))
}
})

test_result <- eventReactive({
input$test_group1
input$test_group2
input$select_test
input$select_test_normalization
input$select_test_transformation
}, {
req(input$test_group1,
input$test_group2,
input$select_test,
input$select_test_normalization,
input$select_test_transformation)

# check if something is selected and not the same thing
if(input$test_group1 != "none" &
input$test_group2 != "none" &
input$test_group1 != input$test_group2) {
# get the column name
my_column <- input$test_select_group
# get the normalization
normalization <- input$select_test_normalization
# get the transformation
transformation <- input$select_test_transformation

# prepare the data for the testing
prep_test_data <- all_data$analysis_data %>%
rename(my_group_info = !!sym(my_column)) %>%
filter(.data$my_group_info == input$test_group1 |
.data$my_group_info == input$test_group2) %>%
select(.data$my_id, .data$ShortLipidName, .data$LipidClass, .data$sample_name, .data$my_group_info, .data$area) %>%
# total area normalisation
group_by(.data$sample_name) %>%
mutate(norm_area = .data$area / sum(.data$area)) %>%
ungroup() %>%
# select which normalization to use for PCA
mutate(value = case_when(
normalization == "raw" ~ .data$area,
normalization == "tot_area" ~ .data$norm_area
)) %>%
# do transformations and select which transformation to keep
mutate(value = case_when(
transformation == "none" ~ .data$value,
transformation == "log10" ~ log10(.data$value + 1) # the +1 is correct for any zero's
)) %>%
# remove the 2 area columns
select(-.data$area, -.data$norm_area) %>%
nest(test_data = c(.data$sample_name, .data$my_group_info, .data$value)) %>%
mutate(fc = map_dbl(.x = .data$test_data,
.f = ~ mean(.x$value[.x$my_group_info == input$test_group1]) / mean(.x$value[.x$my_group_info == input$test_group2])),
fc_log2 = log2(.data$fc))

# what test to do
results_test <- switch(input$select_test,
"ttest" = do_ttest(lipid_data = prep_test_data),
"mwtest" = do_mwtest(lipid_data = prep_test_data))

return(results_test)
} else {
return(NULL)
choices = group_options,
selected = group_options[2])
}
})

Expand Down Expand Up @@ -1522,14 +1480,12 @@ shinyAppServer <- function(input, output, session) {
req(all_data$analysis_data,
input$select_pca_observations,
input$select_pca_normalization,
# input$select_num_components,
input$select_pca_scaling,
input$select_pca_transformation)

data_pca <- do_pca(lipid_data = isolate(all_data$analysis_data),
observations = input$select_pca_observations,
normalization = input$select_pca_normalization,
# num_pc = input$select_num_components,
scaling = input$select_pca_scaling,
transformation = input$select_pca_transformation)

Expand Down Expand Up @@ -1739,4 +1695,4 @@ shinyAppServer <- function(input, output, session) {
# req(filter_result)
# filter_result()$filter_data
# })
}
}
2 changes: 1 addition & 1 deletion R/shinyAppUI.R
Original file line number Diff line number Diff line change
Expand Up @@ -403,7 +403,7 @@ shinyAppUI <- fluidPage(
mainPanel(width = 10,
column(width = 6,
shinycssloaders::withSpinner(plotlyOutput(outputId = "volcano_plot",
height = "900px"),
height = "800px"),
type = 5)),
column(width = 6,
shinycssloaders::withSpinner(plotlyOutput(outputId = "test_boxplot"),
Expand Down
40 changes: 40 additions & 0 deletions man/do_stat_test.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 8931eb2

Please sign in to comment.