Diff of /vignettes/vignette.R [000000] .. [d79ff0]

Switch to side-by-side view

--- 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)
+