Import light head/glasses

Author

Johannes Zauner

Preface

This is a work-in-progress descriptive analysis of the GuidolinEtAl2025 dataset.

Overview

Data import: wearable data

The first step is the import of wearable data from the head position (mounted on glasses).

#regex to extract participant Id and wearing position
# pattern <- "[A-Z]+_S[0-9]{3}_[hcw]"
#regex to extract participant Id
pattern <- "^([0-9]{3})_"

files <- filefinder("actlumus", continuous = TRUE, negate = "Report")

data <- import$ActLumus(files, tzs[site], auto.id = pattern)


Successfully read in 1'579'496 observations across 26 Ids from 26 ActLumus-file(s).
Timezone set is Europe/Berlin.
Observations in the following 2 file(s) and 2 Id(s) cross to or from daylight savings time (DST): 
File: 221_actlumus_Log_1607_20231030121531432, Group:221
File: 222_actlumus_Log_1020_20231030140039534, Group:222
Please make sure that the timestamps in the source files correctly reflect these changes from DST<>ST. 
To adjust datetimes after a jump, set `dst_adjustment = TRUE` or see `?dst_change_handler` for manual adjustment.

First Observation: 2023-08-14 10:55:21
Last Observation: 2023-11-13 11:24:55
Timespan: 91 days

Observation intervals: 
   Id    interval.time             n pct  
 1 201   10s                   60042 100% 
 2 202   10s                   59957 100% 
 3 204   10s                   61980 100% 
 4 205   10s                   61015 100% 
 5 206   10s                   60691 100% 
 6 206   23s                       1 0%   
 7 206   59575s (~16.55 hours)     1 0%   
 8 208   10s                   59853 100% 
 9 209   10s                   60084 100% 
10 210   10s                   60701 100% 
# ℹ 35 more rows

Regularizing data

In the first step, we will trim the data by the study time.

path_study_dates <- paste0("../data/Study_dates_MeLiDos_", site, ".xlsx")

#import table with study times
Study_dates <- read_excel(path_study_dates)
#gather the important information
Study_dates <-
  Study_dates |> 
    rename(Id = subjectID_device, start = datetime_trial_start, end = datetime_trial_end) |> 
    select(Id, start, end) |> 
    mutate(across(c(start, end), \(x) force_tz(x, tzs[site])),
           trial = TRUE,
           Id = factor(Id)) |> 
  group_by(Id)

#add the trim information to the dataset and filter by it
data <- 
  data |> 
  add_states(Study_dates) |> 
  dplyr::filter(trial) |> 
  select(-trial)

data |> gg_overview()

data |> has_gaps()

[1] TRUE

data |> has_irregulars()

[1] FALSE

data |> gg_gaps(group.by.days = TRUE, show.irregulars = TRUE, full.days = FALSE)

data_cleaned <- data |> gap_handler(full.days = TRUE)
data_cleaned |> gap_table(MEDI) |> cols_hide(ends_with("_n"))

	Data					Missing
Summary of available and missing data
Variable: melanopic EDI
	Regular		Irregular	Range	Interval	Gaps				Implicit		Explicit
	Time	%	n^1,2	Time	Time	N	ø	Time	%	Time	%	Time	%
Overall	25w 2d 12m	85.1%³	0	29w 5d 2h	10	54	2w 1d 3h 29m 40s	4w 3d 1h 48m	14.9%³	0s	0.0%³	4w 3d 1h 48m	14.9%³
201
	6d 20h 23m	85.6%	0	1w 1d	10s	2	13h 48m 30s	1d 3h 37m	14.4%	0s	0.0%	1d 3h 37m	14.4%
202
	6d 19h 42m	85.3%	0	1w 1d	10s	2	14h 9m	1d 4h 18m	14.7%	0s	0.0%	1d 4h 18m	14.7%
204
	1w 46m	87.9%	0	1w 1d	10s	2	11h 37m	23h 14m	12.1%	0s	0.0%	23h 14m	12.1%
205
	6d 18h 26m	84.6%	0	1w 1d	10s	2	14h 47m	1d 5h 34m	15.4%	0s	0.0%	1d 5h 34m	15.4%
206
	6d 18h 51m	84.8%	0	1w 1d	10s	2	14h 34m 30s	1d 5h 9m	15.2%	0s	0.0%	1d 5h 9m	15.2%
208
	6d 19h 31m	85.2%	0	1w 1d	10s	2	14h 14m 30s	1d 4h 29m	14.8%	0s	0.0%	1d 4h 29m	14.8%
209
	6d 18h 14m	84.5%	0	1w 1d	10s	2	14h 53m	1d 5h 46m	15.5%	0s	0.0%	1d 5h 46m	15.5%
210
	6d 17h 3m	83.9%	0	1w 1d	10s	2	15h 28m 30s	1d 6h 57m	16.1%	0s	0.0%	1d 6h 57m	16.1%
212
	6d 19h 1m	84.9%	0	1w 1d	10s	2	14h 29m 30s	1d 4h 59m	15.1%	0s	0.0%	1d 4h 59m	15.1%
213
	6d 17h 58m	84.4%	0	1w 1d	10s	2	15h 1m	1d 6h 2m	15.6%	0s	0.0%	1d 6h 2m	15.6%
214
	6d 18h 6m	84.4%	0	1w 1d	10s	2	14h 57m	1d 5h 54m	15.6%	0s	0.0%	1d 5h 54m	15.6%
215
	6d 21h 45m	86.3%	0	1w 1d	10s	2	13h 7m 30s	1d 2h 15m	13.7%	0s	0.0%	1d 2h 15m	13.7%
216
	6d 21h 59m	86.4%	0	1w 1d	10s	2	13h 30s	1d 2h 1m	13.6%	0s	0.0%	1d 2h 1m	13.6%
218
	6d 21h 4m	86.0%	0	1w 1d	10s	2	13h 28m	1d 2h 56m	14.0%	0s	0.0%	1d 2h 56m	14.0%
219
	6d 20h 20m	85.6%	0	1w 1d	10s	2	13h 50m	1d 3h 40m	14.4%	0s	0.0%	1d 3h 40m	14.4%
221
	6d 21h 38m	85.8%	0	1w 1d 1h	10s	3	9h 7m 20s	1d 3h 22m	14.2%	0s	0.0%	1d 3h 22m	14.2%
222
	6d 19h 56m	84.9%	0	1w 1d 1h	10s	3	9h 41m 20s	1d 5h 4m	15.1%	0s	0.0%	1d 5h 4m	15.1%
223
	6d 19h 26m	85.1%	0	1w 1d	10s	2	14h 17m	1d 4h 34m	14.9%	0s	0.0%	1d 4h 34m	14.9%
224
	6d 19h 36m	85.2%	0	1w 1d	10s	2	14h 12m	1d 4h 24m	14.8%	0s	0.0%	1d 4h 24m	14.8%
225
	6d 17h 55m	84.3%	0	1w 1d	10s	2	15h 2m 30s	1d 6h 5m	15.7%	0s	0.0%	1d 6h 5m	15.7%
226
	6d 16h 26m	83.6%	0	1w 1d	10s	2	15h 47m	1d 7h 34m	16.4%	0s	0.0%	1d 7h 34m	16.4%
227
	6d 15h 16m	83.0%	0	1w 1d	10s	2	16h 22m	1d 8h 44m	17.0%	0s	0.0%	1d 8h 44m	17.0%
228
	6d 20h 47m	85.8%	0	1w 1d	10s	2	13h 36m 30s	1d 3h 13m	14.2%	0s	0.0%	1d 3h 13m	14.2%
229
	6d 20h 28m	85.7%	0	1w 1d	10s	2	13h 46m	1d 3h 32m	14.3%	0s	0.0%	1d 3h 32m	14.3%
230
	6d 18h 58m	84.9%	0	1w 1d	10s	2	14h 31m	1d 5h 2m	15.1%	0s	0.0%	1d 5h 2m	15.1%
231
	6d 16h 37m	83.7%	0	1w 1d	10s	2	15h 41m 30s	1d 7h 23m	16.3%	0s	0.0%	1d 7h 23m	16.3%
¹ If n > 0: it is possible that the other summary statistics are affected, as they are calculated based on the most prominent interval.
² Number of (missing or actual) observations
³ Based on times, not necessarily number of observations

Exporting values

data_cleaned <- 
  data_cleaned |> 
  mutate(position = "glasses",
         Id = paste0("MPI_S", Id)
  )

light_glasses_1min <- 
data_cleaned |> 
  aggregate_Datetime("1 minute", numeric.handler = \(x) mean(x, na.rm = TRUE)) |> 
  remove_partial_data(MEDI, threshold.missing = "3 hours", by.date = TRUE)

This dataset has irregular or singular data. Singular data will automatically be removed. If you are uncertain about irregular data, you can check them with `gap_finder`, `gap_table`, and `gg_gaps`.

light_glasses <- data_cleaned

save(light_glasses_1min, file = "../data/imported/light/light_glasses_1minute.RData")
save(light_glasses, file = "../data/imported/light/light_glasses.RData")

Visualization

prefix <- paste0(site, "_")

data_cleaned |> 
  mutate(Id = Id |> fct_relabel(\(x) str_remove(x, prefix))) |> 
grand_overview(coordinates[[site]], cities[[site]], countries[[site]], 
               country_colors[[site]], photoperiod_sequence = 1)

ggsave("../output/figures/Figure_1.png", width = 17, height = 10, scale = 2, units = "cm")
ggsave("../output/figures/Figure_1.jpeg", width = 17, height = 10, scale = 2, units = "cm")

Stats

Summary table

table_summary <-
summary_table(
  data_cleaned, 
  coordinates = coordinates[[site]], 
  location = cities[[site]], 
  site = countries[[site]], 
  color = country_colors[[site]],
  histograms = TRUE
)

table_summary

Overview
Summary table
Tübingen, Germany, 48.5°N, 9.1°E, TZ: Europe/Berlin
Participants	Participants	26
Participant-days	Participant-days	208 (8 - 8)
Days ≥80% complete	Days ≥80% complete	156 (6 - 6)
Missing/irregular	Missing/Irregular	15.0% (12.0% - 17.0%)
Photoperiod	Photoperiod	12h 32m (10h 27m - 15h 35m)	¹
Metrics²
Dose	D (lx·h)	7,475 ±9,743 (173 - 68,218)
Duration above 250 lx	TAT₂₅₀	2h 44m ±2h 32m (0s - 10h 38m)
Duration within 1-10 lx	TWT_1-10	3h 45m ±2h 31m (33m - 16h)
Duration below 1 lx	TBT₁	9h 17m ±2h 24m (12m 50s - 17h 46m)
Period above 250 lx	PAT₂₅₀	35m 19s ±40m 46s (0s - 4h 14m)
Duration above 1000 lx	TAT₁₀₀₀	1h 3m ±1h 18m (0s - 6h 52m)
First timing above 250 lx	FLiT₂₅₀	09:09 ±02:34 (00:07 - 15:01)	¹
Mean timing above 250 lx	MLiT₂₅₀	13:27 ±01:41 (08:03 - 17:48)	¹
Last timing above 250 lx	LLiT₂₅₀	18:31 ±02:42 (11:09 - 23:59)	¹
Brightest 10h midpoint	M10_midpoint	13:50 ±01:34 (09:32 - 18:59)	¹
Darkest 5h midpoint	L5_midpoint	03:21 ±01:42 (02:00 - 20:54)	¹
Brightest 10h mean³	M10_mean (lx)	149.7 ±208.2 (2.1 - 1,161.4)
Darkest 5h mean³	L5_mean (lx)	0.0 ±0.2 (0.0 - 2.1)
Interdaily stability	IS	0.330 ±0.100 (0.170 - 0.508)
Intradaily variability	IV	1.159 ±0.377 (0.518 - 1.871)
values show: mean ±sd (min - max) and are all based on measurements of melanopic EDI (lx)
¹ Histogram limits are set from 00:00 to 24:00
² Metrics are calculated on a by-participant-day basis (n=156) with the exception of IV and IS, which are calculated on a by-participant basis (n=26).
³ Values were log 10 transformed prior to averaging, with an offset of 0.1, and backtransformed afterwards

gtsave(table_summary, here("output/tables/table_summary.png"), vwidth = 850, expand = 30)
gtsave(table_summary, here("output/tables/table_summary.pdf"))
gtsave(table_summary |> cols_hide(c(plot)), here("output/tables/table_summary.docx"))