--- a +++ b/vignettes/vignette.R @@ -0,0 +1,193 @@ +## ---- echo = FALSE----------------------------------------------------------- +knitr::opts_chunk$set(eval = TRUE, + echo = TRUE, + fig.align = "center", + warning = FALSE, + message = FALSE) + +## ---- message=FALSE, warning=FALSE-------------------------------------------- +library(timeOmics) + +## ---- message=F--------------------------------------------------------------- +library(tidyverse) + +## ----------------------------------------------------------------------------- +data("timeOmics.simdata") +sim.data <- timeOmics.simdata$sim + +dim(sim.data) +head(sim.data[,1:6]) + +## ----------------------------------------------------------------------------- +remove.low.cv <- function(X, cutoff = 0.5){ + # var.coef + cv <- unlist(lapply(as.data.frame(X), + function(x) abs(sd(x)/mean(x)))) + return(X[,cv > cutoff]) +} + +data.filtered <- remove.low.cv(sim.data, 0.5) + +## ---- message=FALSE----------------------------------------------------------- +# numeric vector containing the sample time point information +time <- timeOmics.simdata$time +head(time) + +## ----eval=FALSE--------------------------------------------------------------- +# # example of lmms +# lmms.output <- lmms::lmmSpline(data = data.filtered, time = time, +# sampleID = rownames(data.filtered), deri = FALSE, +# basis = "p-spline", numCores = 4, timePredict = 1:9, +# keepModels = TRUE) +# modelled.data <- t(slot(lmms.output, 'predSpline')) + +## ---- warning=FALSE, message=FALSE-------------------------------------------- +lmms.output <- timeOmics.simdata$lmms.output +modelled.data <- timeOmics.simdata$modelled + +## ----------------------------------------------------------------------------- +# gather data +data.gathered <- modelled.data %>% as.data.frame() %>% + rownames_to_column("time") %>% + mutate(time = as.numeric(time)) %>% + pivot_longer(names_to="feature", values_to = 'value', -time) + +# plot profiles +ggplot(data.gathered, aes(x = time, y = value, color = feature)) + geom_line() + + theme_bw() + ggtitle("`lmms` profiles") + ylab("Feature expression") + + xlab("Time") + +## ----------------------------------------------------------------------------- +filter.res <- lmms.filter.lines(data = data.filtered, + lmms.obj = lmms.output, time = time) +profile.filtered <- filter.res$filtered + +## ----------------------------------------------------------------------------- +# run pca +pca.res <- pca(X = profile.filtered, ncomp = 5, scale=FALSE, center=FALSE) + +# tuning ncomp +pca.ncomp <- getNcomp(pca.res, max.ncomp = 5, X = profile.filtered, + scale = FALSE, center=FALSE) + +pca.ncomp$choice.ncomp +plot(pca.ncomp) + +## ----------------------------------------------------------------------------- +# final model +pca.res <- pca(X = profile.filtered, ncomp = 2, scale = FALSE, center=FALSE) + +## ----------------------------------------------------------------------------- +# extract cluster +pca.cluster <- getCluster(pca.res) +head(pca.cluster) + +## ----------------------------------------------------------------------------- +plotIndiv(pca.res) + +## ----------------------------------------------------------------------------- +plotVar(pca.res) + +## ----------------------------------------------------------------------------- +plotLoadings(pca.res) + +## ----------------------------------------------------------------------------- +plotLong(pca.res, scale = FALSE, center = FALSE, + title = "PCA longitudinal clustering") + +## ----------------------------------------------------------------------------- +tune.spca.res <- tuneCluster.spca(X = profile.filtered, ncomp = 2, + test.keepX = c(2:10)) +# selected features in each component +tune.spca.res$choice.keepX +plot(tune.spca.res) + +## ----------------------------------------------------------------------------- +# final model +spca.res <- spca(X = profile.filtered, ncomp = 2, + keepX = tune.spca.res$choice.keepX, scale = FALSE) +plotLong(spca.res) + +## ----------------------------------------------------------------------------- +X <- profile.filtered +Y <- timeOmics.simdata$Y + +pls.res <- pls(X,Y, ncomp = 5, scale = FALSE) +pls.ncomp <- getNcomp(pls.res, max.ncomp = 5, X=X, Y=Y, scale = FALSE) +pls.ncomp$choice.ncomp +plot(pls.ncomp) + +## ----------------------------------------------------------------------------- +# final model +pls.res <- pls(X,Y, ncomp = 2, scale = FALSE) + +# info cluster +head(getCluster(pls.res)) +# plot clusters +plotLong(pls.res, title = "PLS longitudinal clustering", legend = TRUE) + +## ----------------------------------------------------------------------------- +tune.spls <- tuneCluster.spls(X, Y, ncomp = 2, test.keepX = c(4:10), test.keepY <- c(2,4,6)) + +# selected features in each component on block X +tune.spls$choice.keepX +# selected features in each component on block Y +tune.spls$choice.keepY + +# final model +spls.res <- spls(X,Y, ncomp = 2, scale = FALSE, + keepX = tune.spls$choice.keepX, keepY = tune.spls$choice.keepY) + +# spls cluster +spls.cluster <- getCluster(spls.res) + +# longitudinal cluster plot +plotLong(spls.res, title = "sPLS clustering") + +## ----------------------------------------------------------------------------- +X <- list("X" = profile.filtered, "Z" = timeOmics.simdata$Z) +Y <- as.matrix(timeOmics.simdata$Y) + +block.pls.res <- block.pls(X=X, Y=Y, ncomp = 5, + scale = FALSE, mode = "canonical") +block.ncomp <- getNcomp(block.pls.res,X=X, Y=Y, + scale = FALSE, mode = "canonical") +block.ncomp$choice.ncomp +plot(block.ncomp) + +## ----------------------------------------------------------------------------- +# final model +block.pls.res <- block.pls(X=X, Y=Y, ncomp = 1, scale = FALSE, mode = "canonical") +# block.pls cluster +block.pls.cluster <- getCluster(block.pls.res) + +# longitudinal cluster plot +plotLong(block.pls.res) + +## ----------------------------------------------------------------------------- +test.list.keepX <- list("X" = 4:10, "Z" = c(2,4,6,8)) +test.keepY <- c(2,4,6) + +tune.block.res <- tuneCluster.block.spls(X= X, Y= Y, + test.list.keepX=test.list.keepX, + test.keepY= test.keepY, + scale=FALSE, + mode = "canonical", ncomp = 1) +# ncomp = 1 given by the getNcomp() function + +# selected features in each component on block X +tune.block.res$choice.keepX +# selected features in each component on block Y +tune.block.res$choice.keepY + +# final model +block.pls.res <- block.spls(X=X, Y=Y, + ncomp = 1, + scale = FALSE, + mode = "canonical", + keepX = tune.block.res$choice.keepX, + keepY = tune.block.res$choice.keepY) + +head(getCluster(block.pls.res)) +plotLong(block.pls.res) +