What this code is

The following code isolates and returns the mean light exposure/activity counts for a given period during the day (calculated for the whole sampling period. Default is 6AM to 6PM. Then, it plots these data, fits a loess curve (default span is 0.10) , and labels some hypothetical cut-off points to compare means across potential groups of interest.

Note:This code will fail unless you have the ‘Lato’ font package installed.

The code is annotated throughout.

How to use it

This process is designed to take prepared and imputed actigraphy files.

data <- read.csv(file.choose(), header = T) # Used Clinstag_148 for example

nine_morning_to_nine_night <- function(data = data){
  
library(dplyr)
library(tidyverse)
library(lubridate)
  
  data$Date <- dmy(data$Date)
  data$Time <- format(strptime(data$Time, "%I:%M:%S %p"), format="%H:%M:%S")
  
  start_time <-  "06:00:00"
  end_time <- "18:00:00"
  
  only_days <<- data %>%
    filter(data$Time > start_time & data$Time < end_time)
  
  print("Variable 'only_days' has been added to your global environment, which contains only data from 9am to 9pm")
  
}
nine_morning_to_nine_night(data)
## Warning: package 'dplyr' was built under R version 3.4.2
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Warning: package 'tidyr' was built under R version 3.4.2
## Warning: package 'purrr' was built under R version 3.4.2
## Conflicts with tidy packages ----------------------------------------------
## filter(): dplyr, stats
## lag():    dplyr, stats
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
## [1] "Variable 'only_days' has been added to your global environment, which contains only data from 9am to 9pm"
data <- data.frame(only_days)

# Split data frame by dates, and calculate row means to get 24hr summary of sampling period. 
# Have to parse the date values through lubridate beforehand.
split_summary <- data.frame(split(data$data.White.Light, data$Date))
split_summary <- split_summary %>%
  transmute(split_means = rowMeans(split_summary)) 
# split_summary being our summarised Activity level, and added to our dataframe using transmute (dplyr function)

# Transform the time values into numeric. Have to do some wrangling to do that.
data$Time <- sapply(strsplit(data$Time,":"),
                    function(x) {
                      x <- as.numeric(x)
                      x[1]+x[2]/60
                    })

# Condense the numeric time values into one 24hr block
split_time <- data.frame(split(data$Time, data$Date))
split_time <- split_time %>%
  transmute(time_day = rowMeans(split_time))

# Assign 
Activity_Rhythm <- split_summary$split_means
Angle <- split_time$time_day

# Build the smoothing model, and assign the fitted values etc. to 'smoothed50'
loessmod50 <- loess(Activity_Rhythm ~ Angle, span = 0.10)
smoothed50 <- predict(loessmod50, se = T)

# Add an alpha value to a colour
add.alpha <- function(col, alpha=1){
  if(missing(col))
    stop("Please provide a vector of colours.")
  apply(sapply(col, col2rgb)/255, 2, 
        function(x) 
          rgb(x[1], x[2], x[3], alpha=alpha))  
}

pointcols <- add.alpha("blue", alpha = 0.30)
linecols <- add.alpha(81, alpha = 0.6)


# Build the plot
library(extrafont)
## Registering fonts with R
# Axis Labels
labels <- c("6 AM", "8 AM", "10 AM", "12 PM", "2 PM", "4 PM", "6 PM")
position <- c(6, 8, 10, 12, 14, 16, 18)

# Font stuff
loadfonts(device = 'win')
## CM Roman already registered with windowsFonts().
## CM Roman Asian already registered with windowsFonts().
## CM Roman CE already registered with windowsFonts().
## CM Roman Cyrillic already registered with windowsFonts().
## CM Roman Greek already registered with windowsFonts().
## CM Sans already registered with windowsFonts().
## CM Sans Asian already registered with windowsFonts().
## CM Sans CE already registered with windowsFonts().
## CM Sans Cyrillic already registered with windowsFonts().
## CM Sans Greek already registered with windowsFonts().
## CM Symbol already registered with windowsFonts().
## CM Typewriter already registered with windowsFonts().
## CM Typewriter Asian already registered with windowsFonts().
## CM Typewriter CE already registered with windowsFonts().
## CM Typewriter Cyrillic already registered with windowsFonts().
## CM Typewriter Greek already registered with windowsFonts().
## Lato Black already registered with windowsFonts().
## Lato already registered with windowsFonts().
## Lato Hairline already registered with windowsFonts().
## Lato Heavy already registered with windowsFonts().
## Lato Light already registered with windowsFonts().
## Lato Medium already registered with windowsFonts().
## Lato Semibold already registered with windowsFonts().
## Lato Thin already registered with windowsFonts().
par(family = "Lato Semibold")

# Plot Code
plot(y = Activity_Rhythm, x = Angle, main = "Population average daily light exposure and *X* severity", 
     xlab = "Clock time", ylab = " White light exposure (lux)", 
     cex = 0.7, pch = "o", col = pointcols, xaxt = 'n') 
axis(side = 1, at = position, labels = labels)
lines(smoothed50$fit, x = Angle, col = "firebrick3", lwd = 3)
lines(Angle, smoothed50$fit - qt(0.975,smoothed50$df)*smoothed50$se.fit, lty=3, lwd = 0.7)
lines(Angle, smoothed50$fit + qt(0.975,smoothed50$df)*smoothed50$se.fit, lty=3, lwd = 0.7)
# Horizontal Lines
abline(h = 1200, lty = 2, lwd = 1.5, cex = 0.2)
abline(h = 2100, lty = 2, lwd = 1.5, cex = 0.2)
abline(h = 3000, lty = 2, lwd = 1.5, cex = 0.2)
# Text around lines
text(x = 6.5, y = 1450, labels = "Severe")
text(x = 6.5, y = 2350, labels = "Mild")
text(x = 6.5, y = 3250, labels = "Healthy")