Skip to content

Commit

Permalink
Merge pull request #8 from sistm/master
Browse files Browse the repository at this point in the history 
Master
  • Loading branch information
@SalebHet
SalebHet authored Jan 30, 2024
2 parents 6d5836f + 4b702d8 commit 51200a0
Show file tree
Hide file tree
Showing 6 changed files with 161 additions and 138 deletions.
11 changes: 7 additions & 4 deletions R/boxplot_VICI.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,17 +19,19 @@
#'@import ggpubr
#'@import RColorBrewer

boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE, baseline=NULL){

boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE, baseline=NULL,fill=FALSE){

if(!is.numeric(data_df$response)){
data_df$response <- as.numeric(data_df$response)
}
p <- NULL
#browser()
if(inter){
#browser()
data_df$arm <- relevel(data_df$arm, ref=input$selectRefArmInter)
suppressWarnings(
if(input$jiter == "None"){
p <- ggboxplot(na.omit(data_df), x="stim", y="response", color= "arm", palette = "RdGy",#c("Red","Blue","Black"),#"RdBu",
p <- ggboxplot(na.omit(data_df), x="stim", y="response", color= "arm", palette = "RdGy",fill = "stim",#c("Red","Blue","Black"),#"RdBu",
#fill="white",#"arm",
alpha=0.3,)+
#theme_bw() +
Expand All @@ -47,7 +49,8 @@ boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE,
subtitle = "p-values taking into account background response levels through bivariate modeling") +
labs(caption = "made with VICI")
}else{
p <- ggboxplot(na.omit(data_df), x="stim", y="response", color= "arm", palette = "RdGy",#c("Red","Blue","Black"),#"RdBu",
p <- ggboxplot(na.omit(data_df), x="stim", y="response", color= "arm", palette = "RdGy",fill = "stim",#c("Red","Blue","Black"),#"RdBu",

#fill="white",#"arm",
alpha=0.3,
add="jitter",
Expand Down
3 changes: 3 additions & 0 deletions R/intraarm_fit.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,11 @@ intraarm_fit <- function(transformed_data, tested_time, input,resp){
res_error <- NULL

bkg_inter_mat <- model.matrix(data = stats::na.omit(transformed_data), ~ -1 + stim:bkg)[, -1, drop=FALSE]
#browser()
colnames(bkg_inter_mat) <- gsub(":", "_", colnames(bkg_inter_mat), fixed = TRUE)
colnames(bkg_inter_mat) <- gsub(" ","",colnames(bkg_inter_mat), fixed = TRUE)
transformed_data <- cbind.data.frame(stats::na.omit(transformed_data), bkg_inter_mat)
#browser()
myformul <- as.formula(paste0("response ~ -1 + stim", "+", paste(colnames(bkg_inter_mat), collapse = " + ")))

mgls <- mygls(myformul,
Expand Down
3 changes: 2 additions & 1 deletion R/intraarm_postprocessres.R
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
intraarm_postprocessres <- function(data_df, fit_res){
#browser()
m2resloglik <- sapply(fit_res, function(x){-2*x$mgls$logLik})
s_mgls <- lapply(fit_res, function(x){summary(x$mgls)})
aic <- sapply(s_mgls, "[[", "AIC")
Expand All @@ -22,7 +23,7 @@ intraarm_postprocessres <- function(data_df, fit_res){
colnames(temp)[1:2] <- c("Stimulation", "Timepoint")
return(temp)
})

#browser()
pval_2plot <- make_nice_pvals(do.call(rbind.data.frame, res_2plot), data_df, auxvar = "time")
#maybe TODO compute group2 correctly when more than 2 Timepoints
#pval_2plot <- do.call(rbind, pval_2plot)
Expand Down
5 changes: 5 additions & 0 deletions R/make_nice_pvals.R
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,13 @@
make_nice_pvals <- function(res_2plot, data_df, auxvar = "arm"){
#browser()
data_df$stim <- as.factor(as.numeric(data_df$stim))
pval_2plot <- res_2plot
naux <- nlevels(data_df[, auxvar])
nstim <- nlevels(data_df$stim)
#browser()
if(!is.numeric(data_df$response)){
data_df$response <- as.numeric(data_df$response)
}
pval_2plot$y.position <- as.vector(by(data_df$response, INDICES = data_df$stim, FUN = max, na.rm=TRUE)) +
0.05*max(data_df$response, na.rm = TRUE)
pval_2plot$group1 <- 1:nlevels(data_df$stim) - (naux-1)*0.4/naux
Expand Down
66 changes: 38 additions & 28 deletions R/mod_modelfit.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,17 +93,17 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
responses_res[[response]]$res_error <- NULL
responses_res[[response]]$postprocess_res <- interarm_postprocessres(data_df, fit_res)

boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response, input = parent)

# if(parent$plot == "boxplot"){
# boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
# response_name = response, input = parent)
# }
# if(parent$plot == "histogram"){
# boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
# response_name = response, input = parent)
# }

if(parent$plot == "boxplot"){
boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response, input = parent)
}
if(parent$plot == "histogram"){
boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response, input = parent)
}
#browser()
heatmap_data2plot[[response]] <- responses_res[[response]]$postprocess_res$res_2plot
heatmap_data2plot[[response]]$response <- response
Expand Down Expand Up @@ -139,7 +139,15 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
origin$output$res_error <- reactive(paste0("Too many observation in time point ", parent$selectRefTimeIntra,
"... Perhaps the Arm to analyzed was not specified"))
}else{
#browser()
for(i in ncol(transformed_data):3){
#browser()
if(!is.numeric(transformed_data[, 3])){
transformed_data[, 3] <- as.numeric(transformed_data[, 3])
}
if(!is.numeric(transformed_data[, i])){
transformed_data[, i] <- as.numeric(transformed_data[, i])
}
transformed_data[, i] <- (transformed_data[, i] - transformed_data[, 3])
}

Expand Down Expand Up @@ -177,26 +185,26 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
responses_res[[response]]$postprocess_res <- intraarm_postprocessres(data_df, fit_res)
#res_data <<- responses_res[[response]]$postprocess_res
#responses_res[[response]]$postprocess_res$pval_2plot <- do.call(rbind, responses_res[[response]]$postprocess_res$pval_2plot)
boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response,
input = parent,
inter = FALSE,
baseline = parent$selectRefTimeIntra)
# boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
# response_name = response,
# input = parent,
# inter = FALSE,
# baseline = parent$selectRefTimeIntra)

# if(parent$plot == "boxplot"){
# boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
# response_name = response,
# input = parent,
# inter = FALSE,
# baseline = parent$selectRefTimeIntra)
# }
# if(parent$plot == "histogram"){
# boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
# response_name = response,
# input = parent,
# inter = FALSE,
# baseline = parent$selectRefTimeIntra)
# }
if(parent$plot == "boxplot"){
boxplot_print[[response]] <- boxplot_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response,
input = parent,
inter = FALSE,
baseline = parent$selectRefTimeIntra)
}
if(parent$plot == "histogram"){
boxplot_print[[response]] <- histogram_VICI(data_df, responses_res[[response]]$postprocess_res$pval_2plot,
response_name = response,
input = parent,
inter = FALSE,
baseline = parent$selectRefTimeIntra)
}
#browser()
responses_res[[response]]$res_tab <- do.call(rbind, lapply(fit_res, "[[", "res_tab"))
heatmap_data2plot[[response]] <- responses_res[[response]]$postprocess_res$res_2plot
Expand All @@ -206,8 +214,10 @@ mod_modelfit_server <- function(input, output, session, datas,parent,origin){
breaks = c(0, 0.001, 0.01, 0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 1),
right = FALSE)
}

heatmap_data2plot[[response]] <- do.call(rbind.data.frame,
heatmap_data2plot[[response]])
#browser()
#output$res_tab <- renderTable(fit_res$res_tab, rownames = TRUE, digits=5)
}
}
Expand Down
Loading

0 comments on commit 51200a0

Please sign in to comment.