R/daily_measures.R

Defines functions calculate_daily_sleep_measures calculate_daily_activity_measures single_file_measures folder_measures

Documented in calculate_daily_activity_measures calculate_daily_sleep_measures folder_measures single_file_measures

#' Daily Measures for Data Folder
#' @details Wrapper to process and output daily measures for all bin files in the data folder
#'
#' @param data_folder Folder that contains raw data bin files to process or path to single bin file.
#' @param measure_type The type of daily measure summary to generate (sleep, activity, or both).
#' @param minimum_valid_hours Minimum hours of wear time in a 24-hour day to be considered a valid day for reported measures.
#' @param include_participant_info Appends participant information extracted from the bin file to both the activity and sleep measures.
#' @param identifier_mapping_record File path of the exported identifier_mapping_record CSV file.
#' @returns Daily aggregated measures in CSV format
#' @export
folder_measures <- function(data_folder,
                            measure_type = c("activity", "sleep", "both"),
                            minimum_valid_hours = 22,
                            include_participant_info = FALSE,
                            identifier_mapping_record = NULL) {
  if (file.info(data_folder)$isdir) {
    data_files <- list.files(data_folder, pattern = "(?i)\\.bin$")
    if (length(data_files) == 0) {
      stop(sprintf("No .bin files found in directory: %s", data_folder))
    }
  } else {
    if (!grepl("(?i)\\.bin$", data_folder)) {
      stop(sprintf("The file '%s' does not have a .bin extension.", data_folder))
    }
    # Process a single file
    data_files <- basename(data_folder)
    data_folder <- dirname(data_folder)
  }
  mpi_summary <- MPI_summary(data_folder)
  if (!all(is.na(mpi_summary))) {
    total_files <- length(data_files)
    for (seq in 1:total_files) {
      project <- gsub("\\.bin", "", basename(data_files[seq]))
      output_folder <- file.path(data_folder, project)

      UniqueBinFileIdentifier <- mpi_summary$UniqueBinFileIdentifier[mpi_summary$BinfileName == data_files[seq]]

      single_file_measures(
        output_folder,
        UniqueBinFileIdentifier,
        measure_type,
        minimum_valid_hours,
        include_participant_info,
        identifier_mapping_record
      )
    }
  } else {
    warning(sprintf("Bin files in '%s' have not yet been processed by GENEAcore. Run geneacore parts 1-3 first.", data_folder))
  }
}

#' Daily Measures for Single Bin File
#' @details Wrapper to process and output daily measures for a single bin file
#'
#' @param output_folder Path to the folder containing GENEAcore run outputs and Measurement Period Information (MPI) files.
#' @param UniqueBinFileIdentifier The Unique Bin File Identifier of a bin file.
#' @param measure_type The type of daily measure summary to generate (sleep, activity, or both).
#' @param minimum_valid_hours Minimum hours of wear time in a 24-hour day to be considered a valid day for reported measures.
#' @param include_participant_info Appends participant information extracted from the bin file to both the activity and sleep measures.
#' @param identifier_mapping_record File path of the exported identifier_mapping_record CSV file.
#' @returns Daily aggregated measures in CSV format
#' @export
#' @keywords internal
#' @importFrom utils write.table
single_file_measures <- function(output_folder,
                                 UniqueBinFileIdentifier,
                                 measure_type = c("activity", "sleep", "both"),
                                 minimum_valid_hours = 22,
                                 include_participant_info = FALSE,
                                 identifier_mapping_record = NULL) {
  measure_type <- match.arg(measure_type)

  mpi_filepath <- file.path(output_folder, paste0(UniqueBinFileIdentifier, "_MPI.rds"))
  MPI <- readRDS(mpi_filepath)

  # Option 1: Create measures from daily bouts
  daily_bouts_files <- list.files(output_folder,
    pattern = paste0(UniqueBinFileIdentifier, "_day[0-9]+_bouts\\.rds"),
    recursive = TRUE
  )

  # Option 2: Create measures from aggregated bouts file
  aggregated_bouts_file <- list.files(output_folder,
    pattern = paste0(UniqueBinFileIdentifier, "_bouts\\.rds"),
    full.names = TRUE
  )

  if (length(daily_bouts_files) > 0) {
    daily_bouts_reader <- function(day_number) {
      pattern <- paste0(UniqueBinFileIdentifier, "_day", day_number, "_bouts\\.rds")
      f <- daily_bouts_files[grepl(pattern, daily_bouts_files)]
      if (length(f) == 0) {
        return(NULL)
      }
      readRDS(file.path(output_folder, f[1]))
    }
  } else if (length(aggregated_bouts_file) > 0) {
    all_bouts <- readRDS(aggregated_bouts_file[1])

    daily_bouts_reader <- function(day_number) {
      b <- all_bouts[all_bouts$DayNumber == day_number, , drop = FALSE]
      if (nrow(b) == 0) {
        return(NULL)
      }
      b
    }
  } else {
    warning(sprintf("'%s' has no bouts outputs", output_folder))
    return(invisible(NULL))
  }

  activity_measures <- NULL
  sleep_measures <- NULL
  daily_measures <- NULL

  if (measure_type %in% c("activity", "both")) {
    activity_measures <- calculate_daily_activity_measures(
      MPI = MPI,
      daily_bouts = daily_bouts_reader,
      minimum_valid_hours = minimum_valid_hours,
      include_participant_info = include_participant_info
    )
  }

  if (measure_type %in% c("sleep", "both")) {
    sleep_measures <- calculate_daily_sleep_measures(
      MPI = MPI,
      daily_bouts = daily_bouts_reader,
      minimum_valid_hours = minimum_valid_hours,
      include_participant_info = include_participant_info
    )
  }

  if (measure_type == "activity") {
    daily_measures <- activity_measures
    output_suffix <- "_daily_activity_summary.csv"
  } else if (measure_type == "sleep") {
    daily_measures <- sleep_measures
    output_suffix <- "_daily_sleep_summary.csv"
  } else if (measure_type == "both") {
    merge_notes <- sapply(1:nrow(activity_measures), function(i) {
      x <- unique(unlist(strsplit(c(activity_measures$Notes[i], sleep_measures$Notes[i]), "\\.\\s*")))
      if (length(x)) paste0(paste(x, collapse = ". "), ".") else ""
    })

    if (include_participant_info) {
      # Merge on participant info columns
      participant_info_cols <- c(
        "StudyID",
        "SiteID",
        "PeriodInfo",
        "ParticipantID",
        "BinfileName",
        "LocalExtractTime",
        "UniqueBinFileIdentifier",
        "MeasurementDeviceID",
        "MeasurementDevice",
        "MeasurementFrequency",
        "MeasurementStartDate",
        "MeasurementDurationSet",
        "WearLocationConfig"
      )
      daily_measures <- cbind(
        activity_measures,
        sleep_measures[, !(names(activity_measures) %in% participant_info_cols), drop = FALSE]
      )

      daily_measures <- daily_measures[
        , c(setdiff(names(daily_measures), participant_info_cols), participant_info_cols),
        drop = FALSE
      ]

      daily_measures$Notes <- trimws(merge_notes)

      cols <- names(daily_measures)

      new_order <- c(
        "NightofDate",
        setdiff(cols, c("NightofDate", "Notes")),
        "Notes"
      )

      daily_measures <- daily_measures[, new_order, drop = FALSE]
    } else {
      daily_measures <- cbind(
        sleep_measures[, names(sleep_measures) != "Notes", drop = FALSE],
        activity_measures
      )
      daily_measures$Notes <- trimws(merge_notes)
    }

    daily_measures$Date <- NULL

    output_suffix <- "_daily_measures_summary.csv"
  }

  dir.create(file.path(dirname(output_folder), "GENEAbout"), showWarnings = FALSE)
  output_location <- file.path(
    dirname(output_folder),
    "GENEAbout",
    paste0(UniqueBinFileIdentifier, output_suffix)
  )

  if (!is.null(identifier_mapping_record)) {
    daily_measures <- identifier_mapping(
      x = daily_measures,
      cols_to_map = c("SiteID", "StudyID", "PeriodInfo", "ParticipantID"),
      identifier_mapping_record = identifier_mapping_record
    )
  }

  write.csv(daily_measures, output_location, row.names = FALSE, na = "")

  invisible(daily_measures)
}

#' Calculate Daily Activity Measures
#'
#' @details Function that calculates daily activity measures only
#' @param MPI Measurement Period Information.
#' @param daily_bouts Function used to read daily bouts or extract them from the aggregated bouts file.
#' @param minimum_valid_hours Minimum hours of wear time in a 24-hour day to be considered a valid day for reported measures.
#' @param include_participant_info Appends participant information extracted from the bin file to both the activity and sleep measures.
#' @returns Activity measures data frame
#' @keywords internal
calculate_daily_activity_measures <- function(MPI,
                                              daily_bouts,
                                              minimum_valid_hours = 22,
                                              include_participant_info = FALSE) {
  time_offset <- MPI$file_data$TimeOffset

  cut_time_24hr <- MPI$file_data[["CutTime24Hr"]]
  cut_times <- get_cut_times(cut_time_24hr, MPI)
  cut_time_24hr_offset <- 60 * (60 * as.numeric(unlist(strsplit(cut_time_24hr, ":"))[1]) + as.numeric(unlist(strsplit(cut_time_24hr, ":"))[2]))

  date_range <- get_date_range(cut_times)
  number_days <- date_range$day

  nonwear_by_day <- valid_day_nonwear(MPI[["non_movement"]][["non_wear"]], date_range, minimum_valid_hours, cut_time_24hr)
  valid_days <- as.integer(nonwear_by_day$valid_day$day[nonwear_by_day$valid_day$valid_day])

  Date <- format(as.POSIXct(date_range$start + time_offset - cut_time_24hr_offset, tz = "GMT", origin = "1970-01-01"), "%d-%b-%Y")
  DayNumber <- number_days
  TotalStepsDay <- WearDurationDay <- NonWearDurationDay <- SleepDurationDay <- ActiveDurationDay <-
    SedentaryDurationDay <- LightDurationDay <- ModerateDurationDay <- VigorousDurationDay <-
    MVPADurationDay <- ActiveVolumeDay <- ActiveVolumeDayMET <- ActiveIntensityDay <-
    M6MinIntensity <- M6MinTime <- M5HrIntensity <- M5HrTime <- L5HrIntensity <- L5HrTime <-
    M10HrIntensity <- M10HrTime <- L10HrIntensity <- L10HrTime <- METMinutesDay <- EEDay <-
    SlowStepsDay <- FastStepsDay <- WalkingDurationDay <- MeanCadenceDay <- Cadence95Day <-
    RunningStepsDay <- RunningDurationDay <- SitStandTransitionsDay <- NumberBoutsDay <- rep(NA_real_, length(number_days))
  Notes <- rep("", length(number_days))

  ## Setting active rules ##
  # Taken for MSSE GENEA 2011 paper
  # Average cutpoints
  Sedentary_Threshold <- 0.0625
  Moderate_Threshold <- (644 + 439) / 9600
  Vigorous_Threshold <- (2098 + 1810) / 9600

  for (day_number in seq_len(length(number_days))) {
    bouts <- daily_bouts(number_days[day_number])
    if (is.null(bouts)) {
      Notes[day_number] <- "No bouts for this day."
      next
    }

    bouts$PhysicalActivityLevel <- bouts$Classification

    WearDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel != "non_wear"], na.rm = TRUE)
    NonWearDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "non_wear"], na.rm = TRUE)
    NumberBoutsDay[day_number] <- nrow(bouts)

    if (!number_days[day_number] %in% valid_days) {
      Notes[day_number] <- sprintf("Less than %s hours of wear time.", minimum_valid_hours)
    }

    # Sedentary activity
    # if (length(bouts[bouts$AGSAMean < Sedentary_Threshold &
    #   !bouts$Sleep &
    #   !bouts$NonWear, ][, 1]) != 0) {
    #   bouts[bouts$AGSAMean < Sedentary_Threshold &
    #     !bouts$Sleep &
    #     !bouts$NonWear, ]$PhysicalActivityLevel <- "sedentary" # All sleep remains as sleep
    # }

    # Light activity
    if (length(bouts[bouts$AGSAMean > Sedentary_Threshold &
      bouts$AGSAMean <= Moderate_Threshold &
      !bouts$NonWear, ][, 1]) != 0) {
      bouts[bouts$AGSAMean > Sedentary_Threshold &
        bouts$AGSAMean <= Moderate_Threshold &
        !bouts$NonWear, ]$PhysicalActivityLevel <- "light" # Light Activity
    }

    # Moderate activity
    if (length(bouts[bouts$AGSAMean > Moderate_Threshold &
      bouts$AGSAMean <= Vigorous_Threshold &
      !bouts$NonWear, ][, 1]) != 0) {
      bouts[bouts$AGSAMean > Moderate_Threshold &
        bouts$AGSAMean <= Vigorous_Threshold &
        !bouts$NonWear, ]$PhysicalActivityLevel <- "moderate" # Moderate Activity
    }

    # Vigorous activity
    if (length(bouts[bouts$AGSAMean > Vigorous_Threshold &
      !bouts$NonWear, ][, 1]) != 0) {
      bouts[bouts$AGSAMean > Vigorous_Threshold &
        !bouts$NonWear, ]$PhysicalActivityLevel <- "vigorous" # Vigorous Activity
    }

    idx_active <- bouts$Active & !bouts$NonWear

    SleepDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "sleep"], na.rm = TRUE)
    SedentaryDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "sedentary"], na.rm = TRUE)
    ActiveDurationDay[day_number] <- sum(bouts$Duration[idx_active], na.rm = TRUE)
    LightDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "light"], na.rm = TRUE)
    ModerateDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "moderate"], na.rm = TRUE)
    VigorousDurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel == "vigorous"], na.rm = TRUE)
    MVPADurationDay[day_number] <- sum(bouts$Duration[bouts$PhysicalActivityLevel %in% c("moderate", "vigorous")], na.rm = TRUE)

    # METs
    bouts$MET <- ((bouts$AGSAMean * 60 * 80) / 125.34)^0.6983
    bouts$MET[bouts$PhysicalActivityLevel == "sleep"] <- 0.9
    bouts$MET <- ifelse((bouts$MET < 0.9), 0.9, bouts$MET)
    bouts$METmins <- bouts$MET * bouts$Duration / 60
    METMinutesDay[day_number] <- sum(bouts$METmins, na.rm = TRUE)
    # bouts$EE <- bouts$METmins * as.numeric(MPI$file_data$ParticipantWeight) * 3.5 / 200
    # EEDay[day_number] <- sum(bouts$EE)
    # if (is.na(EEDay[day_number])) {
    #   Notes[day_number] <- paste(Notes[day_number], "Energy expenditure could not be calculated because weight was not provided.")
    # }

    ActiveVolumeDay[day_number] <- weighted_sum(bouts$AGSAMean, bouts$Duration, idx_active)
    ActiveVolumeDayMET[day_number] <- weighted_sum(bouts$MET, bouts$Duration / 60, idx_active)
    ActiveIntensityDay[day_number] <- weighted_mean(bouts$AGSAMean, bouts$Duration, idx_active)

    # M6 Minute
    M6Min <- mx_lx_window(bouts, window = 6 * 60, low = FALSE)
    M6MinIntensity[day_number] <- M6Min$M_intensity
    # M6MinTime[day_number]      = M6Min$M_time
    #
    # # M5Hr & L5Hr
    # M5Hr <- mx_lx_window(bouts, 5*3600, TRUE)
    # M5HrIntensity[day_number] = M5Hr$M_intensity
    # M5HrTime[day_number]      = M5Hr$M_time
    # L5HrIntensity[day_number] = M5Hr$L_intensity
    # L5HrTime[day_number]      = M5Hr$L_time
    #
    # # M10Hr & L10Hr
    # M10Hr <- mx_lx_window(bouts, 10*3600, TRUE)
    # M10HrIntensity[day_number] = M10Hr$M_intensity
    # M10HrTime[day_number]      = M10Hr$M_time
    # L10HrIntensity[day_number] = M10Hr$L_intensity
    # L10HrTime[day_number]      = M10Hr$L_time

    # Steps
    valid_steps_index <- idx_active & bouts$Ambulatory
    TotalStepsDay[day_number] <- sum(bouts$StepCount[idx_active], na.rm = TRUE)
    SlowStepsDay[day_number] <- sum(bouts$StepCount[valid_steps_index & bouts$StepMean < 80], na.rm = TRUE)
    FastStepsDay[day_number] <- sum(bouts$StepCount[valid_steps_index & bouts$StepMean >= 80], na.rm = TRUE)
    WalkingDurationDay[day_number] <- sum(bouts$Duration[valid_steps_index], na.rm = TRUE)
    MeanCadenceDay[day_number] <- ifelse(length(idx_active) == 0 || !any(valid_steps_index, na.rm = TRUE),
      NA,
      60 * sum(bouts$StepCount[valid_steps_index]) / sum(bouts$Duration[valid_steps_index])
    )
    RunningStepsDay[day_number] <- sum(bouts$StepCount[bouts$Classification == "run"], na.rm = TRUE)
    RunningDurationDay[day_number] <- sum(bouts$Duration[bouts$Classification == "run"], na.rm = TRUE)

    # Cadence95
    cadence95 <- bouts[
      valid_steps_index & !is.na(bouts$Duration) & !is.na(bouts$StepMean),
      c("Duration", "StepMean")
    ]
    Cadence95Day[day_number] <- cx_percentile(cadence95, 95)

    SitStandTransitionsDay[day_number] <- sum(bouts$Classification[-length(bouts$Classification)] == "sedentary" &
      bouts$Active[-1] & !bouts$NonWear[-1], na.rm = TRUE)

    if (is.na(ActiveIntensityDay[day_number]) || is.na(MeanCadenceDay[day_number]) || is.na(Cadence95Day[day_number])) {
      Notes[day_number] <- paste(Notes[day_number], "No active bouts in day.")
    }
  }

  activity_measures <- data.frame(
    Date = Date,
    DayNumber = DayNumber,
    RecordedDataDay = WearDurationDay + NonWearDurationDay,
    WearDurationDay = WearDurationDay,
    NonWearDurationDay = NonWearDurationDay,
    ActiveDurationDay = ActiveDurationDay,
    SleepDurationDay = SleepDurationDay,
    SedentaryDurationDay = SedentaryDurationDay,
    LightDurationDay = LightDurationDay,
    ModerateDurationDay = ModerateDurationDay,
    VigorousDurationDay = VigorousDurationDay,
    MVPADurationDay = MVPADurationDay,
    ActiveVolumeDay = round(ActiveVolumeDay, 0),
    ActiveVolumeDayMET = round(ActiveVolumeDayMET, 0),
    ActiveIntensityDay = round(ActiveIntensityDay, 3),
    M6MinIntensity = round(M6MinIntensity, 3),
    # M6MinTime = M6MinTime,
    # M5HrIntensity = M5HrIntensity,
    # M5HrTime = M5HrTime,
    # L5HrIntensity = L5HrIntensity,
    # L5HrTime = L5HrTime,
    # M10HrIntensity = M10HrIntensity,
    # M10HrTime = M10HrTime,
    # L10HrIntensity = L10HrIntensity,
    # L10HrTime = L10HrTime,
    METMinutesDay = round(METMinutesDay, 0),
    # EEDay = round(EEDay, 0),
    TotalStepsDay = TotalStepsDay,
    SlowStepsDay = SlowStepsDay,
    FastStepsDay = FastStepsDay,
    WalkingDurationDay = WalkingDurationDay,
    MeanCadenceDay = round(MeanCadenceDay, 1),
    Cadence95Day = round(Cadence95Day, 1),
    RunningStepsDay = RunningStepsDay,
    RunningDurationDay = RunningDurationDay,
    SitStandTransitionsDay = SitStandTransitionsDay,
    NumberBoutsDay = NumberBoutsDay,
    Notes = trimws(Notes)
  )

  if (include_participant_info) {
    activity_measures <- cbind(activity_measures,
      StudyID = rep(MPI$file_data$StudyID, length(number_days)),
      SiteID = rep(MPI$file_data$SiteID, length(number_days)),
      PeriodInfo = rep(MPI$file_data$PeriodInfo, length(number_days)),
      ParticipantID = rep(MPI$file_data$ParticipantID, length(number_days)),
      BinfileName = rep(MPI$file_data$BinfileName, length(number_days)),
      LocalExtractTime = format(as.POSIXct(rep(MPI$file_data$ExtractTimeUTC, length(number_days)), tz = "GMT", origin = "1970-01-01"), "%d-%b-%Y %H:%M:%S"),
      UniqueBinFileIdentifier = rep(MPI$file_data$UniqueBinFileIdentifier, length(number_days)),
      MeasurementDeviceID = rep(MPI$file_data$MeasurementDeviceID, length(number_days)),
      MeasurementDevice = rep(MPI$file_data$MeasurementDevice, length(number_days)),
      MeasurementFrequency = rep(MPI$file_data$MeasurementFrequency, length(number_days)),
      MeasurementStartDate = rep(MPI$file_data$MeasurementStartDate, length(number_days)),
      MeasurementDurationSet = rep(MPI$file_data$MeasurementDurationSet, length(number_days)),
      WearLocationConfig = rep(MPI$file_data$WearLocationConfig, length(number_days))
    )
  }

  return(activity_measures)
}

#' Calculate Daily Sleep Measures
#'
#' @details Function that calculates daily sleep measures only
#' @param MPI Measurement Period Information.
#' @param daily_bouts Function used to read daily bouts or extract them from the aggregated bouts file.
#' @param minimum_valid_hours Minimum hours of wear time in a 24-hour day to be considered a valid day for reported measures.
#' @param include_participant_info Appends participant information extracted from the bin file to both the activity and sleep measures.
#' @returns Sleep measures data frame
#' @keywords internal
calculate_daily_sleep_measures <- function(MPI,
                                           daily_bouts,
                                           minimum_valid_hours = 22,
                                           include_participant_info = FALSE) {
  time_offset <- MPI$file_data$TimeOffset

  cut_time_24hr <- MPI$file_data[["CutTime24Hr"]]
  cut_times <- get_cut_times(cut_time_24hr, MPI)
  cut_time_24hr_offset <- 60 * (60 * as.numeric(unlist(strsplit(cut_time_24hr, ":"))[1]) + as.numeric(unlist(strsplit(cut_time_24hr, ":"))[2]))

  date_range <- get_date_range(cut_times)
  number_days <- date_range$day

  nonwear_by_day <- valid_day_nonwear(MPI[["non_movement"]][["non_wear"]], date_range, minimum_valid_hours, cut_time_24hr)
  valid_days <- as.integer(nonwear_by_day$valid_day$day[nonwear_by_day$valid_day$valid_day])

  rest_intervals <- MPI[["non_movement"]][["rest_intervals"]]

  NightofDate <- format(as.POSIXct(date_range$start + time_offset - cut_time_24hr_offset, tz = "GMT", origin = "1970-01-01"), "%d-%b-%Y")
  WearDurationDay <- NonWearDurationDay <- RestStartTime <- RestEndTime <- RestIntervalDuration <-
    SleepOnsetTime <- SleepEndTime <- SleepIntervalDuration <- TotalSleepDuration <- SleepEfficiency <-
    SleepOnsetLatency <- SleepOffsetDuration <- WakeAfterSleepOnsetDuration <- WakeAfterSleepOnsetCount <-
    TotalNapDuration <- MidsleepTime <- MeanNapDuration <- NapsCountDay <- NumberBoutsDay <- rep(NA, length(number_days))
  Notes <- rep("", length(number_days))

  for (day_number in seq_len(length(number_days))) {
    bouts <- daily_bouts(number_days[day_number])
    if (is.null(bouts)) {
      Notes[day_number] <- "No bouts for this day."
      next
    }

    WearDurationDay[day_number] <- sum(bouts$Duration[bouts$Classification != "non_wear"], na.rm = TRUE)
    NonWearDurationDay[day_number] <- sum(bouts$Duration[bouts$Classification == "non_wear"], na.rm = TRUE)
    NumberBoutsDay[day_number] <- nrow(bouts)

    if (!number_days[day_number] %in% rest_intervals$day_number) {
      Notes[day_number] <- "No primary rest interval."
      next
    }
    if (!number_days[day_number] %in% valid_days) {
      Notes[day_number] <- sprintf("Less than %s hours of wear time.", minimum_valid_hours)
    }

    # Rest Start Time (Auto)
    RestStartTime[day_number] <- rest_intervals$start_time[rest_intervals$day_number == number_days[day_number]]

    # Rest Interval Duration
    RestIntervalDuration[day_number] <- rest_intervals$duration[rest_intervals$day_number == number_days[day_number]]

    # Rest End Time (Auto)
    RestEndTime[day_number] <- RestStartTime[day_number] + RestIntervalDuration[day_number]

    bouts_tmp <- bouts

    if (RestEndTime[day_number] > bouts$TimeUTC[nrow(bouts)] + bouts$Duration[nrow(bouts)]) {
      bouts_nextday <- daily_bouts(day_number + 1)
      bouts_tmp <- rbind(bouts, bouts_nextday)
      Notes[day_number] <- paste(Notes[day_number], "Rest interval extends into the following day.")
    }

    # Sleep
    bouts_tmp <- bouts_tmp[which(bouts_tmp$TimeUTC < RestEndTime[day_number] & bouts_tmp$TimeUTC + bouts_tmp$Duration > RestStartTime[day_number]), ]
    sleep_index <- which(bouts_tmp$Sleep & !bouts_tmp$NonWear & bouts_tmp$Rest)
    if (length(sleep_index) > 0) {
      sleep_interval <- bouts_tmp[min(sleep_index):max(sleep_index), ]
      SLEEP <- sleep_interval$Sleep & !sleep_interval$NonWear
      NONSLEEP <- !sleep_interval$Sleep & !sleep_interval$NonWear

      # Sleep Onset Time
      SleepOnsetTime[day_number] <- sleep_interval$TimeUTC[1]

      # Sleep End Time
      SleepEndTime[day_number] <- sleep_interval$TimeUTC[nrow(sleep_interval)] + sleep_interval$Duration[nrow(sleep_interval)]

      # Sleep Interval Duration
      SleepIntervalDuration[day_number] <- SleepEndTime[day_number] - SleepOnsetTime[day_number]

      # Total Sleep Duration
      if (length(sleep_index) > 1) {
        TotalSleepDuration[day_number] <- sum(sleep_interval$Duration[SLEEP])
      } else {
        TotalSleepDuration[day_number] <- sleep_interval$Duration[1]
      }

      # Non-wear in sleep
      nw <- sum(sleep_interval$Duration[sleep_interval$Classification == "non_wear"])
      if (nw / TotalSleepDuration[day_number] > 0.75) {
        Notes[day_number] <- paste(Notes[day_number], "Insufficient valid data in sleep interval to report sleep measures.")
        next
      }

      # Check Rest Intervals
      RestStartTime[day_number] <- ifelse(bouts_tmp$Rest[1] & bouts_tmp$Classification[1] == "sleep", bouts_tmp$TimeUTC[1],
        ifelse(!bouts_tmp$Rest[1] & bouts_tmp$Classification[1] == "sleep", bouts_tmp$TimeUTC[1] + bouts_tmp$Duration[1],
          RestStartTime[day_number]
        )
      )

      RestEndTime[day_number] <- ifelse(bouts_tmp$Rest[nrow(bouts_tmp)] & bouts_tmp$Classification[nrow(bouts_tmp)] == "sleep", bouts_tmp$TimeUTC[nrow(bouts_tmp)] + bouts_tmp$Duration[nrow(bouts_tmp)],
        ifelse(!bouts_tmp$Rest[nrow(bouts_tmp)] & bouts_tmp$Classification[nrow(bouts_tmp)] == "sleep", bouts_tmp$TimeUTC[nrow(bouts_tmp)],
          RestEndTime[day_number]
        )
      )

      RestIntervalDuration[day_number] <- RestEndTime[day_number] - RestStartTime[day_number]

      # Sleep Onset Latency
      SleepOnsetLatency[day_number] <- SleepOnsetTime[day_number] - RestStartTime[day_number]
      if (SleepOnsetLatency[day_number] < 0) {
        SleepOnsetTime[day_number] <- RestStartTime[day_number]
        SleepIntervalDuration[day_number] <- SleepEndTime[day_number] - SleepOnsetTime[day_number]
        SleepOnsetLatency[day_number] <- 0
      }

      # Sleep Offset Duration
      SleepOffsetDuration[day_number] <- RestEndTime[day_number] - SleepEndTime[day_number]
      if (SleepOffsetDuration[day_number] < 0) {
        SleepEndTime[day_number] <- RestEndTime[day_number]
        SleepIntervalDuration[day_number] <- SleepEndTime[day_number] - SleepOnsetTime[day_number]
        SleepOffsetDuration[day_number] <- 0
      }

      # Sleep Efficiency
      SleepEfficiency[day_number] <- 100 * TotalSleepDuration[day_number] / RestIntervalDuration[day_number]

      # Wake After Sleep Onset Duration
      WakeAfterSleepOnsetDuration[day_number] <- sum(sleep_interval$Duration[NONSLEEP])

      # Wake After Sleep Onset Count
      WakeAfterSleepOnsetCount[day_number] <- max(0, sum(diff(SLEEP) == 1))

      # Midsleep Time
      MidsleepTime[day_number] <- SleepOnsetTime[day_number] + floor(SleepIntervalDuration[day_number] / 2)

    } else {
      RestStartTime[day_number] <- RestEndTime[day_number] <- RestIntervalDuration[day_number] <- NA
      Notes[day_number] <- paste(Notes[day_number], "No sleep bouts within the primary rest interval.")
    }

    # Naps
    naps <- which(bouts$Sleep & !bouts$NonWear & !bouts$Rest)
    NapsCountDay[day_number] <- length(naps)
    if (NapsCountDay[day_number] > 0) {
      # Total Nap Duration
      TotalNapDuration[day_number] <- sum(bouts$Duration[naps])

      # Mean Nap Duration
      MeanNapDuration[day_number] <- TotalNapDuration[day_number] / NapsCountDay[day_number]
    } else {
      TotalNapDuration[day_number] <- 0
      MeanNapDuration[day_number] <- 0
    }
  }

  sleep_measures <- data.frame(
    NightofDate = NightofDate,
    RecordedDataDay = WearDurationDay + NonWearDurationDay,
    WearDurationDay = WearDurationDay,
    NonWearDurationDay = NonWearDurationDay,
    RestStartTime = ifelse(is.na(RestStartTime), NA_character_, format(as.POSIXct(RestStartTime + time_offset, tz = "GMT", origin = "1970-01-01"), "%H:%M:%S")),
    RestEndTime = ifelse(is.na(RestEndTime), NA_character_, format(as.POSIXct(RestEndTime + time_offset, tz = "GMT", origin = "1970-01-01"), "%H:%M:%S")),
    RestIntervalDuration = RestIntervalDuration,
    SleepOnsetTime = ifelse(is.na(SleepOnsetTime), NA_character_, format(as.POSIXct(SleepOnsetTime + time_offset, tz = "GMT", origin = "1970-01-01"), "%H:%M:%S")),
    SleepEndTime = ifelse(is.na(SleepEndTime), NA_character_, format(as.POSIXct(SleepEndTime + time_offset, tz = "GMT", origin = "1970-01-01"), "%H:%M:%S")),
    SleepIntervalDuration = SleepIntervalDuration,
    TotalSleepDuration = TotalSleepDuration,
    SleepEfficiency = round(SleepEfficiency, 1),
    SleepOnsetLatency = SleepOnsetLatency,
    SleepOffsetDuration = SleepOffsetDuration,
    WakeAfterSleepOnsetDuration = WakeAfterSleepOnsetDuration,
    WakeAfterSleepOnsetCount = WakeAfterSleepOnsetCount,
    NapsCountDay = NapsCountDay,
    TotalNapDuration = TotalNapDuration,
    MidsleepTime = ifelse(is.na(MidsleepTime), NA_character_, format(as.POSIXct(MidsleepTime + time_offset, tz = "GMT", origin = "1970-01-01"), "%H:%M:%S")),
    MeanNapDuration = round(MeanNapDuration, 0),
    NumberBoutsDay = NumberBoutsDay,
    Notes = trimws(Notes)
  )

  if (include_participant_info) {
    sleep_measures <- cbind(sleep_measures,
      StudyID = rep(MPI$file_data$StudyID, length(number_days)),
      SiteID = rep(MPI$file_data$SiteID, length(number_days)),
      PeriodInfo = rep(MPI$file_data$PeriodInfo, length(number_days)),
      ParticipantID = rep(MPI$file_data$ParticipantID, length(number_days)),
      BinfileName = rep(MPI$file_data$BinfileName, length(number_days)),
      LocalExtractTime = format(as.POSIXct(rep(MPI$file_data$ExtractTimeUTC, length(number_days)), tz = "GMT", origin = "1970-01-01"), "%d-%b-%Y %H:%M:%S"),
      UniqueBinFileIdentifier = rep(MPI$file_data$UniqueBinFileIdentifier, length(number_days)),
      MeasurementDeviceID = rep(MPI$file_data$MeasurementDeviceID, length(number_days)),
      MeasurementDevice = rep(MPI$file_data$MeasurementDevice, length(number_days)),
      MeasurementFrequency = rep(MPI$file_data$MeasurementFrequency, length(number_days)),
      MeasurementStartDate = rep(MPI$file_data$MeasurementStartDate, length(number_days)),
      MeasurementDurationSet = rep(MPI$file_data$MeasurementDurationSet, length(number_days)),
      WearLocationConfig = rep(MPI$file_data$WearLocationConfig, length(number_days))
    )
  }

  return(sleep_measures)
}

Try the GENEAcore package in your browser

Any scripts or data that you put into this service are public.

GENEAcore documentation built on Oct. 22, 2026, 5:09 p.m.