inst/doc/tscR.R

In tscR: A time series clustering package combining slope and Frechet distances

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
options(knitr.table.format = "html")

## ----setup, include=FALSE, comment=FALSE, echo=FALSE--------------------------
library(tscR)
library(dplyr)
library(grid)
library(ggplot2)
library(latex2exp)
library(dtw)

## ----warning=F, fig.cap= "Figure 1. Three different trajectories at four times to exemplify the possible relationships or classifications of the data.", echo=FALSE, fig.align='left'----

a <- c(10, 15, 17, 25)
b <- c(5, 8, 6, 9 )
c <- c(-19, -14, -12, -4)
x <- c(1, 2, 3, 4)

df <- as.data.frame(cbind(x,a,b,c))

ggplot(df, aes(x=x))+ 
  geom_line(aes(y=a), color = "red")+
  geom_point(y=a, col="red")+
  geom_line(aes(y=b))+
  geom_point(y=b)+
  geom_line(aes(y=c), color = "steelblue")+
  geom_point(y=c, color="steelblue")+
  geom_label(aes(x=1.5, y=14, label = TeX("$S_{a1}$", output="character")), parse=TRUE   ) +
  geom_label(aes(x=2.5, y=17, label = TeX("$S_{a2}$", output="character")), parse=TRUE  ) +
  geom_label(aes(x=3.5, y=23, label = TeX("$S_{a3}$", output="character")), parse=TRUE  ) +
  geom_label(aes(x=1.5, y=7.5, label = TeX("$S_{b1}$", output="character")), parse=TRUE  ) +
  geom_label(aes(x=2.5, y=8, label = TeX("$S_{b2}$)", output="character")), parse=TRUE  ) +
  geom_label(aes(x=3.5, y=9, label = TeX("$S_{b3}$", output="character")), parse=TRUE  ) + 
  geom_label(aes(x=1.5, y=-15, label = TeX("$S_{c1}$", output="character")), parse=TRUE  ) +
  geom_label(aes(x=2.5, y=-12, label = TeX("$S_{c2}$", output="character")), parse=TRUE  ) +
  geom_label(aes(x=3.5, y=-7, label = TeX("$S_{c3}$", output="character")), parse=TRUE  ) +
  geom_text(aes(x=1, y=12, label = "Traject. a"))+
  geom_text(aes(x=1, y=4, label = "Traject. b"))+
  geom_text(aes(x=1, y=-17, label = "Traject. c"))+
  theme(legend.position = "none")+
  xlab("") + ylab("")


## ----echo=FALSE---------------------------------------------------------------
dfx <- as.matrix(rbind(a,b,c))
dsE <- round( dist(dfx, method = "euclidean", diag = FALSE, upper = FALSE), 3)

## ----echo=FALSE---------------------------------------------------------------
time <- c(1,2,3,4)
dF <- tscR::frechetDistC(dfx, time)

## ----echo=FALSE---------------------------------------------------------------
dt1 <- dtwDist(matrix(c(a,b), byrow = TRUE, nrow = 2))
dt2 <- dtwDist(matrix(c(a,c), byrow = TRUE, nrow = 2))
dt3 <- dtwDist(matrix(c(b,c), byrow = TRUE, nrow = 2))

## ----echo=FALSE, fig.align='left', fig.cap="Figure 2. Different possibilities of classifying the tracks from the whole data set (a) according to its Fréchet distances (b), according to its slopes (c) or a combination of both (d)."----

df <- data.frame(T1 = c(140,100,75,35), T2=c(120,120,50,48), T3 = c(100,140,35,70))

df1 <- matrix(NA, nrow=10, ncol=3)
df2 <- matrix(NA, nrow=10, ncol=3)
df3 <- matrix(NA, nrow=10, ncol=3)
df4 <- matrix(NA, nrow=10, ncol=3)
for(i in seq(1,10)){
  df1[i,] <- jitter(as.numeric(df[1,]), factor = 1.5)
  df2[i,] <- jitter(as.numeric(df[2,]), factor = 1.5)
  df3[i,] <- jitter(as.numeric(df[3,]), factor = 1.5)
  df4[i,] <- jitter(as.numeric(df[4,]), factor = 1.5)
  }
df <- as.data.frame(rbind(df1,df2,df3,df4))
names(df) <- c("T1","T2","T3")

df <- as.data.frame.table(t(df))
df$Var3 <- rep(c("A","B","C","D"), each=30)

p1 <- df %>% 
ggplot( aes_(~Var1, ~Freq, group=~Var2) ) + 
  geom_line() + 
    theme(legend.position = "none", plot.title = element_text(hjust = 0.5)) + 
  xlab("(A)") + ylab("") + ggtitle(label = "Raw trajectories")

p2 <- df %>%
  mutate(Var4 = recode(Var3, "B" = "A")) %>%
  mutate(Var4 = recode(Var4, "D" = "C")) %>% 
ggplot( aes_(~Var1, ~Freq, group=~Var2, colour=~Var4) ) + 
  geom_line() +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5)) + 
  xlab("(B)") + ylab("") + ggtitle(label = "Fréchet based cluster")

p3 <- df %>%
  mutate(Var4 = recode(Var3, "C" = "A")) %>%
  mutate(Var4 = recode(Var4, "D" = "B")) %>% 
ggplot( aes_(~Var1, ~Freq, group=~Var2, colour=~Var4) ) + 
  geom_line() +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5)) + 
  xlab("(C)") + ylab("") + ggtitle(label = "Slope based cluster")

p4 <- df %>%
ggplot( aes_(~Var1, ~Freq, group=~Var2, colour=~Var3) ) + 
  geom_line() +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5)) + 
  xlab("(D)") + ylab("") + ggtitle(label = "Combined clusters")


gridExtra::grid.arrange(p1,p2,p3,p4, nrow=2)


## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  if (!requireNamespace("BiocManager"))
#  install.packages("BiocManager")
#  BiocManager::install("tscR")

## ----eval = FALSE, echo=TRUE--------------------------------------------------
#  devtools::install_github("fpsanz/tscR")

## ----eval = TRUE--------------------------------------------------------------
library(tscR)

## ----eval =FALSE--------------------------------------------------------------
#  browseVignettes("tscR")

## ----eval = TRUE, echo = TRUE, results='asis'---------------------------------
data(tscR)
df <- tscR

## ----eval=TRUE, echo=FALSE, results='asis'------------------------------------
knitr::kable(head(round(df,3)), 
             caption = "Table 1. First six rows from the example data matrix at three different times that have been studied for one sample.",
             align = c('c', 'c', 'c'), format="html") %>%
  gsub("<caption>",'<caption style="text-align:left;">', .)

## ----echo = F, eval=TRUE, fig.align="left", fig.cap="Figure 3. Set ot 300 example trajectories that tscR package includes to work with."----
matplot(t(df), type = "l", col = "gray30", lty = 1, ylab = "")

## ----eval = TRUE, echo = TRUE-------------------------------------------------
time <- c(1,2,3)
sDist <- slopeDist(df, time)

## ----eval=TRUE, echo=TRUE-----------------------------------------------------
sclust <- getClusters(sDist, k = 3)

## ----eval=T, echo=T-----------------------------------------------------------
plotCluster(data = df,
            clust = sclust,
            ncluster = "all")

## ----eval=T, echo=T-----------------------------------------------------------
plotCluster(df, sclust, 1)

## ----eval=T, echo=T-----------------------------------------------------------
plotCluster(df, sclust, c(1:2))

## ----eval = TRUE, echo = TRUE-------------------------------------------------
fdist <- frechetDistC(df, time)
fclust <- getClusters(fdist, 3)
plotCluster(df, fclust, "all")

## ----eval = TRUE, echo = TRUE-------------------------------------------------
ccluster <- combineCluster(sclust, fclust)
plotCluster(df, ccluster, c(1:6))
plotCluster(df, ccluster, "all")

## ----eval=T, echo=T-----------------------------------------------------------
data( "tscR" )
bigDF <- tscR
senators <- imputeSenators( bigDF, k = 100 )

## -----------------------------------------------------------------------------
sdistSen <- frechetDistC(senators$senatorData,
                          time = c( 1, 2, 3 ) ) 

cSenators <- getClusters( sdistSen, k = 4 )

## -----------------------------------------------------------------------------
plotCluster(senators$senatorData,
            cSenators, "all")

plotCluster(senators$senatorData,
            cSenators, c(1,2,3,4))

## -----------------------------------------------------------------------------
endCluster <- imputeSenatorToData(senators,
                                  cSenators)

## -----------------------------------------------------------------------------
plotClusterSenator(endCluster, "all")
plotClusterSenator(endCluster, c(1,2,3,4))

## ----echo=FALSE, out.width='100%', fig.cap="Figure 4. Two options of how the summarizedexperiment object can be introduced to extract the data matrix for later analysis.", fig.align='left'----
knitr::include_graphics('./tscR.svg')

## -----------------------------------------------------------------------------
sessionInfo()