---
title: 'mMARCH.AC module 7a: Extracts Features of Domains of Physical Activity, Sleep and Circadian Rhythmicity '
author: "Wei Guo"
date: '`r format(Sys.Date(), "%B %d, %Y")`' 
output: 
    html_document:
        code_folding: hide
        number_sections: true
        toc: true
        toc_float: true
        toc_collapsed: true
    toc_depth: 3
    number_sections: true
theme: lumen
---

**mMARCH.AC version: `r packageVersion("mMARCH.AC")`**  

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# {r, results="hide"} - The chunks is run but all results are hidden. The code shows in the doc,  
# {r, include=FALSE} - the code is run but neither the code or the results are shown
# {r, echo=FLASE} - The code is not shown, but results are
# bug= colaus has some NA in newID column on 9660 with csv data but no part2summary
# bug2=fragmentation can not take character id, will output NA in id column.
# after fix bug2, output change to a list.
 

```
 

# Please Install: actigraphy, r.jive, SpatioTemporal

This R program extracts multiple commonly used features from minute-level actigraphy data using the R package `actigraphy` (Di et al., 2019), with a few modifications.

For GeneActiv ENMO, we use `1000 * ENMO` as the counts data.

```{r c0, error=F,warning=F,message=F} 
currentdir_xxx 
studyname_xxx 
outputdir_xxx 
epochIn_xxx
epochOut_xxx 
log.multiplier_xxx 
PA.threshold_xxx
PA.threshold2_xxx
RemoveDaySleeper_xxx  
library(xlsx) 
setwd(currentdir) 
 
#  PA.threshold = c(217,645,1811 )   # for 217=<counts<645 philips counts data
#  PA.threshold = c(50,100,400 )     #   part5FN="WW_L50M100V400_T5A5" 
#     nimhTwoDev_actiwatch	nimhTwoDev_geneactiv
#       348	 40.00000	 
#  	438	50.00000	 
#  	826	99.99943	 
# 	1747	399.88206	 
#   	1810	499.96095 

summaryFN1<-paste(currentdir,"/summary/",studyname,"_ggir_output_summary.xlsx",sep="")
summaryP2<-read.xlsx( summaryFN1,head=0,sheetName = "2_fileSummary")  
ggirV<-as.character(gsub("X","",summaryP2[1,1]))  
 
enmoFN<-paste("./data/impu.flag_All_",studyname,"_ENMO.data.", epochOut,"s.GGIR",ggirV,".csv",sep="")  
foutFN<-function(x,studyname) paste("module7a_",studyname,"_new_features_page",x,".csv",sep="")  
outenmoFN<-paste("./data/clean.impu.flag_All_",studyname,"_ENMO.data.",epochOut,"s.csv",sep="")  
outsleepFN<-paste("./data/clean.impu.flag_All_",studyname,"_ENMO.data.",epochOut,"s.sleepmatrix.csv",sep="")  
M10windowFN<-paste("./data/clean.impu.flag_All_",studyname,"_ENMO.data.",epochOut,"s.M10windowMatrix.csv",sep="")  

# I modified the "actigraphy" package on (1) log(log.multiplier*X +1) (2) modify bouts function (3) use imputated data and set wear=1. Wear matrix: Integer vector with 1's for wear time minutes and 0's for non-wear time minutes.
```
  

**Note.** The physical activity (PA) measure, for example `sed_dur_24h_C2`, was also calculated using `PA.threshold2`, which may also impact fragmentation calculations.

# Pre-analysis Questions for Feature Calculation 

- Do you want to remove day-sleeper nights that may lead to outliers in sleep features and metrics such as L5 time, M10 time, and PCs? Set `RemoveDaySleeper = FALSE` if you do not want to remove day sleepers. This mainly impacts subject-level features. In this run, `RemoveDaySleeper = `r RemoveDaySleeper``.
- Do you want to remove sleep windows when calculating light/moderate/vigorous activity duration during waking hours within a day?
- Do you want to calculate light/moderate/vigorous activity duration within the M10 window, waking hours, or over 24 hours? All options are included in this program.

```{r c1read,error=F,warning=F,message=F} 
# 0a) read data-------------------------- 

library(xlsx)   
library(knitr) 
library(dplyr)  # %>%
library(cosinor)   
library(mMARCH.AC) 
library(zoo) #for RA 
library(ActCR)
library(ActFrag) 
library(survival)
library(ineq)
library(mMARCH.AC) 

setwd(currentdir)  

# Prepare count/wear data for JIVE
 
D1<-read.csv(enmoFN,head=1,nrow=-1,stringsAsFactors=F)
Ctop<-which(colnames(D1)=="X00.00.00")-1
table(D1[,c("KEEP","remove16h7day")]) 
if (nrow(D1)>nrow(unique(D1[,1:2])) ) {temp<-paste(D1[,1],D1[,2],sep=" ")  
                                       s<-which(duplicated(temp))
                                       print(unique(D1[s,1]))
                                       print(temp[s]) 
                                       stop("Found duplicate days in ENMO data")} 


D2<-D1[which(D1[,"KEEP"]=="keep" &!is.na(D1[,"newID"])),]

S1.keepdaysleep<- which(is.na(D2[,"daysleeper"]) | D2[,"daysleeper"]==0) 
S1.removedaysleep<- which( D2[,"daysleeper"]==1) 
if (RemoveDaySleeper & length(S1.removedaysleep)>=1) D3<-D2[-S1.removedaysleep,] else D3<-D2
daysleeperM<-D2[S1.removedaysleep,1:Ctop]


idM<-D3[,c("filename","newID","Date")]  
D4<-D3[,(Ctop+1):ncol(D3)]
count<-cbind(D3[,c("filename","Date")],1000*D4) #newID has duplicates

n1440<-ncol(count)-2
n1442<-n1440+2
colnames(count)<-c("ID","Day",paste("MIN",1:n1440,sep=""))
log.count = cbind(count[,1:2], log(log.multiplier*D4 + 1))
colnames(log.count)<-c("ID","Day",paste("MIN",1:n1440,sep=""))

wear<-count 
for (j in 3:ncol(wear)) wear[,j]<-1 

write.csv(D3,file=outenmoFN,row.names=FALSE) 
```

 
# Define Sleep Window for Physical Activity Counts in the Wake Window

- Sleep onset/awake range: 12-36 hours.
- Problem 1: The first night does not have sleep onset/awake information.
- Problem 2: The second day does not have sleep status from 00:00 to sleep onset (e.g., 22:00). Set sleep = 0 for this period.
- `nonsleepMatrix`: sleep = 0, awake = 1.
- Cleaned data and `sleepMatrix` are written to the data folder.


```{r c2, results="hide",warning=FALSE,message=FALSE} 
sleepFull.fn<-paste(outputdir,"/results/QC/part4_nightsummary_sleep_full.csv",sep="")  
sleepCall<-makeSleepDataMatrix(sleepFN=sleepFull.fn,epochOut=60,impute=TRUE,outputFN=outsleepFN)  
```

```{r,include=FALSE} 
sleep.story<-paste("Among ",nrow(D1)," nights, there are ",length(which(D1[,"daysleeper"]==1))," daysleeper nights. For daysleeper nights, it happens on ",paste(names(table(daysleeperM[,"measurementday"])),collapse="/")," th night for ",paste(table(daysleeperM[,"measurementday"]),collapse="/")," times. Second,  subjects with daysleeper nights have ",paste(names(table(table(daysleeperM[,"filename"]))),collapse="/")," such nights for ",paste(table(table(daysleeperM[,"filename"])),collapse="/")," times.",sep="")
```   

  
 
**Messages from the sleep data**
 
```{r c3,echo=FALSE, error=F,warning=F,message=F} 
message<-"" 
library(kableExtra)  

if (length(sleepCall$duplicatedays)>1) {
       rownames(sleepCall$duplicatedays)<-NULL
       kable(sleepCall$duplicatedays,caption="Warning: found duplicate days")  %>% 
             kable_material(c("striped", "hover"))  
}  else message<-sleepCall$duplicatedays
if (length(sleepCall$sleepproblem)>1) {
       rownames(sleepCall$sleepproblem)<-NULL 
       kable(sleepCall$sleepproblem,caption="Warning: found wakeup>=48")  %>% 
             kable_material(c("striped", "hover"))  
} else message<-paste(message,sleepCall$sleepproblem,sep=".    ")
```

`r message`

 
`r sleep.story`   
 
 

```{r c4, error=F,warning=F,message=F} 
# 0c) # Match ids from sleep file-------------------------
sleep<-read.csv(outsleepFN,head=1,stringsAsFactors=F)
sleepH<-sleep[,c("filename","Date")]
sleepT<-sleep[,  which(colnames(sleep)=="MIN1"):ncol(sleep)] 
nonsleep<-cbind(sleepH,1-sleepT) 
colnames(nonsleep)<-c("ID","Day",paste("MIN",1:n1440,sep="")) 
 
 
S1<-NULL
for (i in 1:nrow(count)) {
t<-which( nonsleep[,"ID"]==count[i,"ID"] &  as.character(nonsleep[,"Day"])==as.character(count[i,"Day"]))
if (length(t)==1) S1[i]<-t else S1[i]<-NA
}
indexer.count<-paste(count[,"ID"],count[,"Day"],sep=" ")
indexer.sleep<-paste(nonsleep[,"ID"],nonsleep[,"Day"],sep=" ")
#length(setdiff(indexer.count,indexer.sleep))
#length(which(is.na(S1)))
#length(which(!is.na(S1)))
#length(which(!is.na(unique(S1))))

nonsleepMatrix<-array(NA,dim=c(nrow(count),n1442))
colnames(nonsleepMatrix)<-c("ID","Day",paste("MIN",1:n1440,sep=""))
nonsleepMatrix<-nonsleep[S1,]
S2<-which(is.na(nonsleepMatrix[,1]))
if (length(S2)>=1){
nonsleepMatrix[S2,1:2]<-count[S2,1:2] 
nonsleepMatrix[S2,3:1442]<-1 # missing sleep was treated nonsleep time.
}
indexer.nonsleep<-paste(nonsleepMatrix[,"ID"],nonsleepMatrix[,"Day"],sep=" ")
if (length(which(indexer.count!=indexer.nonsleep))>=1) stop("nonsleepMatrix IDs mismatch with count data")
write.csv(nonsleepMatrix,file="nonsleepMatrix.csv",row.names=FALSE)
nonsleepMatrix<-read.csv("nonsleepMatrix.csv",head=1,stringsAsFactors=FALSE)

#dim(count)

NSam<-function(x) length(setdiff(unique(x),NA))
dim(nonsleepMatrix)
```

 

#  Data

The activity data at the minute level (`r enmoFN`) was stored in a format of `data.frame` of dimension $(\sum_i d_i) \times `r ncol(D1)`$, where $d_i$ is the number of available days for subject $i$. And the order of the `r ncol(D1)` columns (and corresponding column names) was as follows, `r colnames(D1)[1:Ctop]`, "MIN1", ..., "MIN1440".   

     *  Raw data = (`r dim(D1)`), `r length(unique(D1[,"filename"]))` files, `r NSam(D1[,"newID"])` individuals.
     *  Clean data = (`r dim(D2)`), `r length(unique(D2[,"filename"]))` files, `r NSam(D2[,"newID"])` individuals.     
     *  Rm daysleepers = (`r dim(D3)`), `r length(unique(D3[,"filename"]))` files, `r NSam(D3[,"newID"])` individuals.    
     *  Count data = (`r dim(count)`), `r NSam(count[,"ID"])` individuals.    




 

# Feature Extractions

In this version, we focus on the physical activity and circadian rhythmicity domains. We provide R functions to calculate the following features:

- **Physical activity**
  - Total volume: `Tvol2`
  - Time-related features (e.g., sedentary time, MVPA): `PAfun`
  - Fragmentation metrics: `fragmentation_long2`

- **Circadian rhythmicity**
  - Extended cosinor model with anti-logistic transformed cosine curves: `ExtCos`, `ExtCos_long`
  - Intradaily variability: `IV`, `IV_long`
  - Functional PCA: `denseFLMM`  
    (The R package `fpca.face` from `refund` was also applied but is not used in the feature merge step.)

Sleep features (which may rely on addtional algorithms) will be extracted from GGIR output. 

```{r,eval=F,include=F}   
fpca.day<-read.csv(foutFN("4_denseFLMM_day_PCs",studyname), header = TRUE,stringsAsFactors=F)
fpca.subject<-read.csv(foutFN("5_denseFLMM_subject_PCs",studyname), header = TRUE,stringsAsFactors=F) 
```


## Total Volume of Physical Activity

Total volume of physical activity serves as a proxy for the total accumulated activity over a day. Commonly used features include total activity count (TAC) and total log-transformed activity count (TLAC):

- TAC: $TAC = \sum_{wear} y(t)$  
- TLAC: $TLAC = \sum_{wear} \log(`r log.multiplier` \times y(t) + 1)$

The `Tvol` function calculates either TAC or TLAC (depending on the argument `logtransform`) using the count data.


```{r c5,error=F,warning=F,message=F} 
 
tac24 = Tvol2(count.data = count, weartime = wear,logtransform = FALSE)  #wear has all 1s for 24 hours
tlac24 = Tvol2(count.data = log.count,weartime = wear,logtransform = FALSE)  
colnames(tac24)[3]<-"TAC_24h"
colnames(tlac24)[3]<-"TLAC_24h"

tac = Tvol2(count.data = count, weartime = nonsleepMatrix,logtransform = FALSE) #count=1000ENMO
tlac = Tvol2(count.data = log.count,weartime = nonsleepMatrix,logtransform = FALSE) #ID,Day,TAC
colnames(tlac)[3]<-"TLAC"

temp1<-merge(tac24,tlac24,by=c("ID","Day"),all=TRUE) 
temp2<-merge(tac,tlac,by=c("ID","Day"),all=TRUE) 
tac4features<-merge(temp2,temp1,by=c("ID","Day"),all=TRUE)   
```

  * `r paste("dim(tac) = ",dim(tac)[1],"X",dim(tac)[2],sep="")`     
  * `r paste("dim(tlac) = ",dim(tlac)[1],"X",dim(tlac)[2],sep="")`


```{r , echo=FALSE , fig.width=10, fig.height=5} 
par(mfrow=c(1,2))
hist(tac[,3],main="",xlab="tac")
hist(tlac[,3],main="",xlab="tlac") 
``` 
 
 

## Time-related Features

It is often of interest to examine the time spent in different activity states during a day. Common examples include total sedentary time (TST), total active time (TAT), light physical activity (LiPA), and moderate-to-vigorous physical activity (MVPA).

From minute-level count data, activity states are typically defined based on thresholds. The functions `Time` and `Time_long` calculate these time-based features for a single vector and a full dataset, respectively. The argument `smallerthan` controls whether values less than (`TRUE`) or greater than or equal to (`FALSE`) the specified `threshold` are used. For example, for TST, set `smallerthan = TRUE`.

**Note**

- `r paste("Sedentary time (minutes) is defined as ENMO <=", PA.threshold[1], "mg", sep=" ")`
- `r paste("Light activity time (minutes) is defined as", PA.threshold[1], "< ENMO <=", PA.threshold[2], "mg")`
- `r paste("Moderate activity time (minutes) is defined as", PA.threshold[2], "< ENMO <=", PA.threshold[3], "mg")`
- `r paste("Vigorous activity time (minutes) is defined as ENMO >", PA.threshold[3], "mg")`
- The sleep window is excluded from physical activity duration calculations by setting `weartime = nonsleepMatrix` in `Time_long2()`.

```{r c6, error=F,warning=F,message=F,results="hide"} 
 
ra_all = RA_long2(count.data = count, window=(ncol(count)-2)/1440, method = "average",noon2noon=FALSE) # one minute window  
ra_M10<-ra_all[,c("ID","Day","M10TIME")]
ra_M10[,"M10TIME"] <-ra_M10[,"M10TIME"]-5 #back to start time of M10 as before

quantile(ra_M10[,"M10TIME"])  
dim(ra_M10)
dim(wear)
indexer.M10<-paste(ra_M10[,"ID"],ra_M10[,"Day"],sep=" ")
indexer.wear<-paste(wear[,"ID"],wear[,"Day"],sep=" ")
if (length(which(indexer.wear!=indexer.M10))>=1) Stop("Found mismatch IDs in wear and RA output matrix")

M10windowMatrix<-wear 
n60=60*60/epochOut
n600=10*60*60/epochOut  # M10 ends after 10 hours 
n599=n600-1     
for (i in 1:nrow(M10windowMatrix)){ #error for 841~1440 window for 30s data 
                                    # as.integer(ra_M10[65,"M10TIME"]*n60)=0 in nimh data
start3<- as.integer(round(ra_M10[i,"M10TIME"]*n60,0))   
end3<-start3+n599   
  
ra_M10[i,"start"]<-start3
ra_M10[i,"end"]<-end3
M10windowMatrix[i,3:ncol(M10windowMatrix)]<-0
M10windowMatrix[i,2+start3:end3]<-1   
if (end3-start3!=n599 | end3>n1440 | sum(M10windowMatrix[i,3:ncol(M10windowMatrix)])!=n600) stop(paste("Found wrong M10 window at ",indexer.M10[i],sep=""))  
} 
dim(M10windowMatrix)
head(M10windowMatrix) 
write.csv(M10windowMatrix,file=M10windowFN,row.names=FALSE)
```
 
**Calculation of Activity Duration Based on Daytime (Non-sleep), M10 Window, and 24 Hours** 

```{r c7,error=F,warning=F,message=F} 
  
sed_allA<-PAfun(count.data=count,weartime = nonsleepMatrix,PA.threshold) 
sed_allB<-PAfun(count.data=count,weartime = M10windowMatrix,PA.threshold) 
sed_allC<-PAfun(count.data=count,weartime = wear,PA.threshold)  

sed_all<-merge(sed_allA,sed_allB,by=c("ID","Day"),all=TRUE,suffix=c("","_M10"))
sed_all<-merge(sed_all,sed_allC,by=c("ID","Day"),all=TRUE,suffix=c("","_24h")) 
``` 

  - `r paste("dim(sed_all) = ",dim(sed_all)[1],"X",dim(sed_all)[2],sep="")`     
 
**Calculation of Activity Duration (_C2 as cutoff2) Based on PA.threshold2=`r paste(PA.threshold2,collapse=",")` as well** 

```{r c8,error=F,warning=F,message=F} 
  
sed_allA2<-PAfun(count.data=count,weartime = nonsleepMatrix,PA.threshold2) 
sed_allB2<-PAfun(count.data=count,weartime = M10windowMatrix,PA.threshold2) 
sed_allC2<-PAfun(count.data=count,weartime = wear,PA.threshold2)  

sed_all2<-merge(sed_allA2,sed_allB2,by=c("ID","Day"),all=TRUE,suffix=c("","_M10"))
sed_all2<-merge(sed_all2,sed_allC2,by=c("ID","Day"),all=TRUE,suffix=c("","_24h")) 
colnames(sed_all2)[-c(1,2)]<-paste(colnames(sed_all2)[-c(1,2)],"_C2",sep="") #new cutoff 
``` 

  * `r paste("dim(sed_all2) = ",dim(sed_all2)[1],"X",dim(sed_all2)[2],sep="")`    


```{r c9, echo=FALSE , fig.width=10, fig.height=3}  
par(mfrow=c(1,6)) 
for (j in 3:ncol(sed_all)) hist(sed_all[,j],main="",xlab=colnames(sed_all)[j]) 
# dim(sed_allA)
# dim(sed_allB)
# dim(sed_allC)
# dim(sed_all)

par(mfrow=c(1,4)) 
X<-colnames(sed_allA)[-(1:2)] #(sed_time,ligth_time,...,activity_time)
for (j in 1:4){
Y<-paste(X[j],c("_24h","_M10",""),sep="") 
C<-NULL;for (t in 1:3) C[t]<-which(colnames(sed_all)==Y[t]) 
plot(sed_all[,C[1]],sed_all[,C[2]],xlab= Y[1] ,ylab=Y[3],ylim=c(0,max(sed_all[,-c(1,2)])),col="red")
points(sed_all[,C[1]],sed_all[,C[3]],col="blue")
legend("topleft", legend=c("M10", "daytime"), col = c("red","blue"),pch=20 )
}
``` 

 


## Fragmentation Metrics Using `sed.threshold = `r PA.threshold[1]``

Fragmentation metrics characterize the accumulation patterns of sedentary time (TST) and total active time (TAT) by quantifying the duration of bouts and the frequency of transitions between sedentary and active states. The following fragmentation metrics are available:

- Average bout duration (bout/minute)
- Transition probability (reciprocal of average bout duration)
- Gini index (absolute variability normalized by average bout duration)
- Average hazard
- Power-law distribution parameter

These metrics can be calculated for both sedentary and active bouts. [Details about fragmentation metrics](https://www.biorxiv.org/content/early/2017/08/31/182337)

The functions `fragmentation` and `fragmentation_long` calculate fragmentation features for a single vector and a full dataset, respectively. The argument `metrics` (e.g., `"mean_bout"`, `"TP"`, `"Gini"`, `"hazard"`, `"power"`, or `"all"`) specifies which metrics to compute; `"all"` computes all available metrics.

Given activity data and wear/non-wear flags for the full dataset, users can calculate fragmentation at the daily level or aggregate bouts across all available days by setting the argument `by` to `"day"` or `"subject"`.


```{r c10,warning=FALSE,message=FALSE}
frag_by_subject = fragmentation_long2(count, weartime = wear,thresh=PA.threshold[1], metrics = "all",by = "subject")
frag_by_day = fragmentation_long2(count, weartime = wear,thresh=PA.threshold[1], metrics ="all",by = "day")
```

```
    `r paste("dim(frag_by_subject) = ",dim(frag_by_subject)[1],"X",dim(frag_by_subject)[2],sep="")`    
    `r paste("dim(frag_by_day) = ",dim(frag_by_day)[1],"X",dim(frag_by_day)[2],sep="")`     
``` 

```{r c11, echo=FALSE , fig.width=10, fig.height=8} 
par(mfrow=c(2,10)) 
par(mai=c(0.82,0.42,0.42,0 )) # bottom,left,up,right

for (j in 2:ncol(frag_by_subject)) boxplot(as.numeric(as.character(frag_by_subject[,j])),xlab=colnames(frag_by_subject)[j])
for (j in 3:ncol(frag_by_day)) boxplot(as.numeric(as.character(frag_by_day[,j])),xlab=colnames(frag_by_day)[j])
 
``` 
The upper panel is for subject-level and the lower panel is for day-level.
  

 

## Cosinor Model

The classic cosinor model is defined as:
\[
r(t) = mes + amp \times c(t),
\]
where
\[
c(t) = \cos\left(\frac{(t - \phi) 2\pi}{24}\right).
\]

Here, \( mes \) is the mesor, \( amp \) is the amplitude, and \( \phi \) is the acrophase. It is often recommended to apply a log transformation to the activity curve before fitting the model.

### Subject-level cosinor model (_S)

**Note:** When `daylevel = FALSE`, the cosinor model is fitted using all days combined for each subject, producing subject-level estimates. 

 
```{r c12,results="hide",error=F,warning=F,message=F} 
# Use Cosinor Model Results Instead of ExtCos Due to an Issue
minuteW=(ncol(count)-2)/1440  #window size (Number of columuns) for one minute
Cos = ActCosinor_long2( count.data = count, window=minuteW,daylevel=FALSE)  
Cos.log = ActCosinor_long2( count.data = log.count, window=minuteW,daylevel=FALSE)   
extcos = ActExtendCosinor_long2(count.data = count, window=minuteW,daylevel=FALSE)   
extcos.log = ActExtendCosinor_long2(count.data = log.count, window=minuteW,daylevel=FALSE)  
   
colnames(Cos)<-c("ID","ndays","mesor","amp","acro","acrotime")
colnames(Cos.log)<-c("ID","ndays","mesor_L","amp_L","acro_L","acrotime_L")
colnames(extcos)<-gsub(paste("_",minuteW,sep=""),"_ext",colnames(extcos))
colnames(extcos.log)<-gsub(paste("_",minuteW,sep=""),"_ext_L",colnames(extcos.log))

cosinormodel.1<-merge(Cos,Cos.log,by=c("ID","ndays"),all=TRUE) 
cosinormodel.2<-merge(extcos,extcos.log,by=c("ID","ndays"),all=TRUE) 
cosinormodel<-merge(cosinormodel.1[,-2],cosinormodel.2[,-2],by="ID",all=TRUE)  
colnames(cosinormodel)[-1]<-paste(colnames(cosinormodel)[-1],"_S",sep="")

```
 
  * `r paste("dim(cosinormodel) = ",dim(cosinormodel)[1],"X",dim(cosinormodel)[2],sep="")` 
 
###  Day-level cosinor model

**Note:** When `daylevel = TRUE`, the model is fitted separately for each day, producing day-level estimates and allowing assessment of day-to-day variability.

```{r c13,results="hide",error=F,warning=F,message=F} 
  
minuteW=(ncol(count)-2)/1440
Cos.day = ActCosinor_long2( count.data = count, window=minuteW,daylevel=TRUE)  
Cos.day.log = ActCosinor_long2( count.data = log.count, window=minuteW,daylevel=TRUE)    
extcos.day = ActExtendCosinor_long2(count.data = count, window=minuteW,daylevel=TRUE)   
extcos.day.log = ActExtendCosinor_long2(count.data = log.count, window=minuteW,daylevel=TRUE)    
colnames(Cos.day)<-c("ID","Day","ndays","mesor","amp","acro","acrotime")
colnames(Cos.day.log)<-c("ID","Day","ndays","mesor_L","amp_L","acro_L","acrotime_L")
colnames(extcos.day)<-gsub(paste("_",minuteW,sep=""),"_ext",colnames(extcos.day))
colnames(extcos.day.log)<-gsub(paste("_",minuteW,sep=""),"_ext_L",colnames(extcos.day.log))

cosinormodel.day.1<-merge(Cos.day,Cos.day.log,by=c("ID","Day","ndays"),all=TRUE) 
cosinormodel.day.2<-merge(extcos.day,extcos.day.log,by=c("ID","Day","ndays"),all=TRUE) 
cosinormodel.day<-merge(cosinormodel.day.1[,-3],cosinormodel.day.2[,-3],by=c("ID","Day"),all=TRUE)   
```
 
  * `r paste("dim(cosinormodel.day) = ",dim(cosinormodel.day)[1],"X",dim(cosinormodel.day)[2],sep="")` 
 

 
```{r c14, echo=FALSE , fig.width=10, fig.height=3} 
par(mfrow=c(1,9) )
if (ncol(cosinormodel)>=4) par(mai=c(0.82,0.42,0.42,0 )) else par(mai=c(0.82,0.42,0.42,0.4 ))  # bottom,left,up,right 
for (j in 2:ncol(cosinormodel)) boxplot(as.numeric(as.character(cosinormodel[,j])),xlab=colnames(cosinormodel)[j])  
``` 

 

 

## Intradaily Variability and Interdaily Stability (Based on 10-Minute Level Activity Data)

Intradaily variability (IV) measures fragmentation in rest-activity rhythms. It is capable of detecting periods of daytime sleep and nocturnal arousal and is calculated as the ratio of the mean squares of successive differences (hourly or minute-level) to the mean squares around the grand mean.

The functions `IV` and `IV_long` calculate IV for a single vector and a full dataset, respectively. The argument `level` specifies whether IV is calculated at the minute or hour level.

Interdaily stability (IS) describes the coupling of the circadian rhythm to external zeitgebers (environmental cues such as light) that entrain the internal biological clock to the 24-hour cycle. IS ranges from 0 (Gaussian noise) to 1, with values closer to 1 indicating stronger coupling to a 24-hour rhythm.

Variable | Meaning
--------|-------------------------------------------------------------------
M10 | Acceleration value (mg) of the lowest acceleration value in highest acceleration 10 hours
L5 |  Acceleration value (mg) of the lowest acceleration 5 hours
L5TIME | Central time of the lowest acceleration value of the lowest acceleration 5 hours (L5<=19+2.5)
M10TIME | Central time of the highest acceleration value of the highest acceleration 10 hours (M10<=14+5)

For a single vector,


```{r c15, error=F,warning=F,message=F,results="hide"}   
iv_all = IV_long2(count.data = count, window=(ncol(count)-2)/144, method = "average") #10 minutes window
colnames(iv_all)[3]<-"IV" 

is_all = IS_long2(count.data = count, window=(ncol(count)-2)/144, method = "average"  )  #10 minute level 
colnames(is_all)[2]<-"IS"  

#ra_all = RA_long2(count.data = count, window=(ncol(count)-2)/1440, method = "average",noon2noon=FALSE) # one minute window for RA,L5,M10,L5time, M10time 
ra_all_NN = RA_long2(count.data = count, window=(ncol(count)-2)/1440, method = "average",noon2noon=TRUE) # one minute window for RA,L5,M10,L5time, M10time 
colnames(ra_all_NN)[-(1:2)]<-paste(colnames(ra_all_NN)[-(1:2)],"_NN",sep="")
                #    Note: ra_all_NN has half missing data for the last day of each subject.
```
 
 
  * `r paste("dim(iv_all) = ",dim(iv_all)[1],"X",dim(iv_all)[2],sep="")`    
  * `r paste("dim(ra_all) = ",dim(ra_all)[1],"X",dim(ra_all)[2],sep="")`     
  * `r paste("dim(is_all) = ",dim(is_all)[1],"X",dim(is_all)[2],sep="")`    

```{r c16, echo=FALSE , fig.width=10, fig.height=4} 
par(mfrow=c(1,7)) 
par(mai=c(0.82,0.42,0.42,0.4 )) # bottom,left,up,right 
boxplot(iv_all[,"IV"],xlab="IV")
boxplot(is_all[,"IS"],xlab="IS")
for (j in 3:ncol(ra_all)) boxplot(ra_all[,j],xlab=colnames(ra_all)[j])
``` 

```{r mergeAll,include=FALSE}
#########################################################
# 3) merge all outputs into one sheet
#########################################################
dim(tac)
dim(tlac)
dim(sed_all)
dim(extcos)
dim(iv_all)
dim(ra_all)
dim(frag_by_subject)
dim(frag_by_day)

output<-tac4features 
output<-merge(output,sed_all,by=c("ID","Day"),all=TRUE) 
output<-merge(output,sed_all2,by=c("ID","Day"),all=TRUE) 
output<-merge(output,frag_by_day,by=c("ID","Day"),all=TRUE) 
output<-merge(output,iv_all,by=c("ID","Day"),all=TRUE) 
output<-merge(output,ra_all,by=c("ID","Day"),all=TRUE)
output<-merge(output,ra_all_NN,by=c("ID","Day"),all=TRUE)
output<-merge(output,cosinormodel.day,by=c("ID","Day"),all=TRUE)

 
# subject level 
output[,"SubjectLevel"]<-1
output<-merge(output,is_all,by="ID",all=TRUE)  
output<-merge(output,frag_by_subject,by=c("ID"),suffix=c("","_S"),all=TRUE) 
output<-merge(output,cosinormodel,by=c("ID"),all=TRUE)   
output<-merge(idM,output,by.x=c("filename","Date"),by.y=c("ID","Day"),all=TRUE) 
output<-output[,c(1,3,2,4:ncol(output))] 
dim(output)
head(output)


#write.xlsx(output, file=foutFN, sheetName = "1_features",   col.names = TRUE, row.names = FALSE)  
write.csv(output, file=foutFN("1_features",studyname),   col.names = TRUE, row.names = FALSE)  
```
  
  * `r paste("Write to ",foutFN("1_features",studyname), " with dimension = ",dim(output)[1],"X",dim(output)[2],sep="")`    
  
 

## Functional Principal Component Analysis

In contrast to the cosinor/extCosinor model, functional principal component analysis (FPCA) is a data-driven technique that makes no parametric 
assumptions about the functional form of diurnal patterns. FPCA represents diurnal activity patterns using L2-orthogonal functional principal 
components, and the resulting principal component scores can be used as features.

Here, FPCA is performed using the `fpca.face` function from the `refund` package. It is recommended to apply a log transformation to reduce 
skewness in count data by setting `logtransform = TRUE`. 

Note that, for simplicity and interpretability, we average data across all valid days for each subject. Therefore, within-subject correlation 
is not accounted for. To incorporate within-subject correlation, multilevel FPCA can be performed using the `denseFLMM` function from 
the `denseFLMM` package.

The output from `denseFLMM` is included in the merged feature list.

```{r c17, error=F,warning=F,message=F,results="hide"}  
 
library(refund)
# Functional PCA Input

X=log.count[,-c(1,2)]
X <- t(t(X) - colMeans(X, na.rm = TRUE))
dim(X)  
mean(X) 

avg.count=aggregate(.~ID,data=count[,-2], mean,na.rm=T) 
avgX=avg.count[,-c(1 )]
log.avgX<-log(log.multiplier*avgX + 1)  
dmean.log.avgX <- t(t(log.avgX) - colMeans(log.avgX, na.rm = TRUE))
dim(dmean.log.avgX)  
mean(dmean.log.avgX) 
idM.avg<-unique(idM[,-3])
S1<-NULL
for (i in 1:nrow(avg.count)) S1[i]<-which(idM.avg[,"filename"]==avg.count[i,"ID"])
idM.avg<-idM.avg[S1,]

#------------------------------------------------------------
# Method 1: single level, using fpca.face in refund package

fit.fpca <- fpca.face(X, knots = 35)
Phi <- fit.fpca$efunctions
eigenvalues <- fit.fpca$evalues
scores <- fit.fpca$scores
colnames(scores)<-paste("PC",1:ncol(scores),sep="")

perc.var <- 100*round(eigenvalues/sum(eigenvalues), digits = 3)
sum(perc.var) 
sum(perc.var[1:4])  
face_day_PCs<-cbind(idM,scores)


scores2<-array(NA,dim=c(nrow(idM.avg),10))
colnames(scores2)<-paste("PC",1:ncol(scores2),sep="")
fit.fpca2 <- try( fpca.face(dmean.log.avgX, knots = 35))
if (attr(fit.fpca2,"class")!="try-error" ){
Phi2 <- fit.fpca2$efunctions
eigenvalues2 <- fit.fpca2$evalues
scores2 <- fit.fpca2$scores 
perc.var2 <- 100*round(eigenvalues2/sum(eigenvalues2), digits = 3)
sum(perc.var2) 
sum(perc.var2[1:4])  
if (length(eigenvalues2)==1) scores2<-data.frame(PC1=scores2) else colnames(scores2)<-paste("PC",1:ncol(scores2),sep="")  #5-27-22 bug: sqrt(Eigen$values) : NaNs produced

}  
face_subject_PCs<-cbind(idM.avg,scores2)  

write.csv(face_day_PCs, file=foutFN("2_face_day_PCs", studyname),  col.names = TRUE, row.names = FALSE )
write.csv(face_subject_PCs, file=foutFN("3_face_subject_PCs", studyname),  col.names = TRUE, row.names = FALSE )

# some errors when write to xlsx
#write.xlsx(face_day_PCs, file=foutFN, sheetName = "2_face_day_PCs",   col.names = TRUE, row.names = FALSE,append=TRUE)
#write.xlsx(face_subject_PCs, file=foutFN, sheetName = "3_face_subject_PCs",   col.names = TRUE, row.names = FALSE,append=TRUE)
#------------------------------------------------------------
# Method 2: multilevel(2 levels) FPCA seperating subject-level effect and day-level effect
library(denseFLMM)

id.groups<-unique(log.count[,"ID"])   
groups<-NULL
for (i in 1:nrow(log.count)) groups[i]<-which(id.groups==log.count[i,"ID"])  
groups<-as.matrix(groups)
G=1 
Zvars<-lapply(seq(len=G),function(g) matrix(1,nrow(log.count),1))
data<-as.matrix(X) #X=demean-log(enmo)

idM.avg<-unique(idM[,-3])
S2<-NULL
for (i in 1:length(id.groups)) S2[i]<-which(idM.avg[,"filename"]==id.groups[i])
idM.avg2<-idM.avg[S2,] 

Z1 <- denseFLMM(data,groups=groups,Zvars=Zvars,smooth = FALSE,NPC=rep(20,G+1))  

Z2 <- denseFLMM(data, gridpoints = 1:ncol(data), 
                       Zlist = NA, 
                       G = G, 
                       Lvec = NA, 
                       groups = groups, 
                       Zvars = Zvars, 
                       L = NA, 
                       NPC=rep(20, G+1), 
                       smooth = FALSE, 
                       bf = 20, 
                       smoothalg = "gamm")

dim(Z2$xi[[1]]) ; dim(Z2$xi[[2]]) 
dim(Z2$phi[[1]]); dim(Z2$phi[[2]])
  
  
#Calculating the percentage of variance explained by each componet for the subject-level PCs and Day-level PCs.
pervar_sub<-100*Z2$nu[[1]]/sum(Z2$nu[[1]])
pervar_day<-100*Z2$nu[[2]]/sum(Z2$nu[[2]])
pervar_sub
pervar_day
#Calculating the relative variance explained by subject heterogeneity out of total variability
sum(Z2$nu[[1]])/Z2$totvar 
#Calculating the relative variance explained by day-to-day variance out of total variability
sum(Z2$nu[[2]])/Z2$totvar 
#Calculating the residual variance/noises out of total variability
n1440*Z2$sigma2/Z2$totvar 

Z2$totvar
subject_PCs<-cbind(idM.avg2,Z2$xi[[1]]  ) 
day_PCs<-cbind(idM,Z2$xi[[2]]  )
colnames(subject_PCs)[(ncol(idM.avg2)+1): ncol(subject_PCs)]<-paste("PC",1:ncol(Z2$xi[[1]]),sep="")
colnames(day_PCs)[(ncol(idM)+1): ncol(day_PCs)]<-paste("PC",1:ncol(Z2$xi[[2]]),sep="")

write.csv(day_PCs, file=foutFN("4_denseFLMM_day_PCs", studyname),  col.names = TRUE, row.names = FALSE )
write.csv(subject_PCs, file=foutFN("5_denseFLMM_subject_PCs",studyname), col.names = TRUE, row.names = FALSE )


#write.xlsx(day_PCs, file=foutFN, sheetName = "4_denseFLMM_day_PCs",   col.names = TRUE, row.names = FALSE,append=TRUE)
#write.xlsx(subject_PCs, file=foutFN, sheetName = "5_denseFLMM_subject_PCs",   col.names = TRUE, row.names = FALSE,append=TRUE)


```

**Subject-Level Functional Principal Components (First 4 PCs from denseFLMM)**

```{r c18, echo=F ,error=F,warning=F,message=F} 
#first 4 subject-level PCs----------------------------
 
m<-4
my.ylim<-range(Z2$phi[[1]][,m:1])*1.4
op=par(mai=c(.6, .8, .3, 0.1),omi=c(0, 0, 0, 0))
matplot(Z2$phi[[1]][,m:1],type='l',ylab='PC',xlab='',xaxt='n',yaxt='n',main='',lwd=c(.7,.7,2,2),ylim=my.ylim,col=m:1)
title(xlab = "Hour", line=1.8)
title(main = paste("Subject-specific Effect (", 
                   round(sum(Z2$nu[[1]])/Z2$totvar,digits=3)*100,'% of Total)',sep=''),line=0.5)
axis(1,at=(0:12)*2*60,labels=(0:12)*2,cex.axis=1)
axis(2,las=1,cex.axis=1)
#axis(2,at=(1:3)*0.01,labels=(1:3)*0.01, las=1,cex.axis=1)
legend('topleft',co=1:4,
       legend=paste(paste('PC',1:m,' (',sep=''),sprintf("%.1f",round(pervar_sub[1:m],digits=1)),'%)',sep=''),
       lty=1,
       horiz=FALSE,
       lwd=2 ,
       bg='transparent',cex=0.725,text.font=1.5,box.col='transparent',
       ncol=2)
 
``` 

- **Note**
  - `_L`: log-transformation
  - `_S`: subject-level calculations using all days of data for a subject
 

- **Reference**

  - Di J, Spira A, Bai J, et al. *Joint and individual representation of domains of physical activity, sleep, and circadian rhythmicity.* Stat Biosci. 2019;11(2):371-402. doi:10.1007/s12561-019-09236-4

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

**How to run this?**
 