R/g.report.part4.R

Defines functions g.report.part4

Documented in g.report.part4

g.report.part4 = function(datadir = c(), metadatadir = c(), loglocation = c(), 
                          f0 = c(), f1 = c(), 
                          data_cleaning_file = c(), sleepwindowType = "SPT", params_output,
                          verbose = TRUE) {
  # description: function to merge generate report from milestone data generated by g.part4 (if store.ms was
  # set to TRUE)
  output = NULL
  ms4.out = "/meta/ms4.out"
  if (file.exists(paste(metadatadir, ms4.out, sep = ""))) {
    if (length(dir(paste(metadatadir, ms4.out, sep = ""))) == 0) {
      try.generate.report = FALSE
    } else {
      try.generate.report = TRUE
    }
  } else {
    try.generate.report = FALSE
  }
  if (try.generate.report == TRUE) {
    resultfolder = metadatadir  #resultfolder = 'Q:/studies/sleep/output_pi_sleep_wrist'
    meta.sleep.folder = paste(metadatadir, "/meta/ms3.out", sep = "")
    if (length(loglocation) > 0) {
      only.use.sleeplog = TRUE
    } else {
      only.use.sleeplog = FALSE
    }
    # ============================================================================ Go through
    # accelerometer datafiles and merge with sleep log data
    fnames = dir(meta.sleep.folder)
    if (f1 > length(fnames)) {
      if (verbose == TRUE) cat(paste0("\nf1 changed from, ", f1, " to ", length(fnames)))
      f1 = length(fnames)
    }
    if (length(f1) == 0 | f1 > length(fnames))
      f1 = length(fnames)
    #-----------------------------------------------------
    colnames_nightsummary2 = c("ID", "night", "sleeponset", "wakeup", "SptDuration", "sleepparam", "guider_onset",
                               "guider_wakeup", "guider_SptDuration", "error_onset", "error_wake", "error_dur", "fraction_night_invalid",
                               "SleepDurationInSpt", "WASO", "duration_sib_wakinghours", "number_sib_sleepperiod", "number_of_awakenings",
                               "number_sib_wakinghours", "duration_sib_wakinghours_atleast15min", "sleeponset_ts", "wakeup_ts", "guider_onset_ts",
                               "guider_wakeup_ts", "sleeplatency", "sleepefficiency", "page", "daysleeper", "weekday", "calendar_date",
                               "filename", "cleaningcode", "sleeplog_used", "sleeplog_ID", "acc_available", "guider", "SleepRegularityIndex", "SriFractionValid",
                               "longitudinal_axis")
    nightsummary2 = as.data.frame(matrix(0, 0, length(colnames_nightsummary2)))
    if (sleepwindowType == "TimeInBed") {
      colnames(nightsummary2) = gsub(replacement = "guider_inbedStart", pattern = "guider_onset", x = colnames(nightsummary2))
      colnames(nightsummary2) = gsub(replacement = "guider_inbedEnd", pattern = "guider_wakeup", x = colnames(nightsummary2))
      colnames(nightsummary2) = gsub(replacement = "guider_inbedDuration", pattern = "guider_SptDuration",
                                     x = colnames(nightsummary2))
    }
    sumi = 1
    sleeplog_used = rep(" ", ((f1 - f0) + 1))
    fnames.ms4 = list.files(paste0(metadatadir, ms4.out), full.names = TRUE)
    if (length(fnames.ms4) < f1)
      f1 = length(fnames.ms4)
    if (verbose == TRUE) cat(" loading all the milestone data from part 4 this can take a few minutes\n")
    myfun = function(x) {
      tail_expansion_log = NULL
      load(file = x)
      cut = which(nightsummary[, 1] == "")
      if (length(cut) > 0 & length(cut) < nrow(nightsummary)) {
        nightsummary = nightsummary[-cut, ]
      }
      if (length(tail_expansion_log) != 0) {
        nightsummary = nightsummary[-which(nightsummary$night == max(nightsummary$night)),] # remove last row because it may not be trustworthy
      }
      if ("GGIRversion" %in% colnames(nightsummary) == FALSE) {
        if (nrow(nightsummary) > 0) {
          nightsummary$GGIRversion = "" #before 3.0-10 this column did not exist
        } else {
          nightsummary[1, ] = NA
          nightsummary$GGIRversion = NA
          nightsummary = nightsummary[0, ]
        }
      }
      out = as.matrix(nightsummary)
    }
    nightsummary2 = as.data.frame(do.call(rbind, lapply(fnames.ms4, myfun)), stringsAsFactors = FALSE)
    nightsummary2$night = as.numeric(gsub(" ", "", nightsummary2$night))
    # ====================================== Add non-wearing during SPT from part 5, if it is availabe:
    ms5.out = "/meta/ms5.out"
    if (file.exists(paste(metadatadir, ms5.out, sep = ""))) {
      if (length(dir(paste(metadatadir, ms5.out, sep = ""))) == 0) {
        try.add.part5.variable = FALSE  #do not run this function if there is no milestone data from g.part5
      } else {
        # check WW windows are calculated in the first file
        load(dir(paste(metadatadir, ms5.out, sep = ""), full.names = T)[1]) # this loads object output
        if ("WW" %in% output$window) { 
          try.add.part5.variable = TRUE
        } else {
          try.add.part5.variable = FALSE #do not run this function if WW windows are not calculated
        }
      }
    } else {
      try.add.part5.variable = FALSE  #do not run this function if there is no milestone data from g.part5
    }
    if (try.add.part5.variable == TRUE) {
      # ====================================================================== loop through meta-files
      fnames.ms5 = list.files(paste0(metadatadir, ms5.out), full.names = TRUE)
      if (f1 > length(fnames.ms5))
        f1 = length(fnames.ms5)
      # cat(' loading all the milestone data from part 5 this can take a few minutes\n')
      myfun5 = function(x) {
        load(file = x) # this loads the content of a RData file that has object output
        cut = which(output[, 1] == "")
        if (length(cut) > 0 & length(cut) < nrow(output)) {
          output = output[-cut, which(colnames(output) != "")]
        }
        WW = which(output[, "window"] == "WW")
        out = as.matrix(output[WW, which(colnames(output) %in% c("ID", "nonwear_perc_spt", "night_number", "window"))])
      }
      outputp5 = as.data.frame(do.call(rbind, lapply(fnames.ms5[f0:f1], myfun5)), stringsAsFactors = FALSE)
      dupl = which(duplicated(outputp5[, c("ID", "night_number")]) == TRUE)
      # Note: another approach to removing duplicates could be to take the average...
      if (length(dupl) > 0) {
        # some days in part 5 can have two SPTs, remove first and keep second SPT
        outputp5 = outputp5[-dupl, ]  #-dupl2[1]
      }
      colnames(outputp5)[which(colnames(outputp5) == "night_number")] = "night"
      # merge should now work, but if ID is numeric and stored as character with a leading zero then
      # part 5 ID will not have this leading zero, so, we need fix this now:
      remove_oldID = FALSE
      if (is.character(nightsummary2$ID) & is.character(outputp5$ID)) {
        options(warn = -1)
        # next line could generate warning about NA creation when content is not numeric this is why
        # we turn of warnings
        testnumeric = !is.na(as.numeric(nightsummary2$ID))
        options(warn = 0)
        if (length(which(testnumeric == TRUE)) > (nrow(nightsummary2) * (2/3))) {
          nightsummary2$ID_old = nightsummary2$ID
          nightsummary2$ID = as.character(as.numeric(nightsummary2$ID))
          remove_oldID = TRUE
        }
      }
      # merge in variable
      outputp5$night = as.numeric(outputp5$night)
      nightsummary2 = base::merge(nightsummary2, outputp5, by = c("ID", "night"), all.x = TRUE)
      if (remove_oldID == TRUE) {
        nightsummary2$ID = nightsummary2$ID_old
        nightsummary2 = nightsummary2[, -which(names(nightsummary2) == "ID_old")]
      }
      nightsummary2 = nightsummary2[order(nightsummary2$ID, nightsummary2$night), ]
      nightsummary2$nonwear_perc_spt = as.numeric(nightsummary2$nonwear_perc_spt)
    }
    # =============
    skip = FALSE
    if (length(nightsummary2) != 0) {
      NumberNotNA = length(which(is.na(nightsummary2[, 3:25]) == FALSE))
      if (NumberNotNA == 0) {
        skip = TRUE
        warning("\nCannot create report part 4 report, because no sleep estimates present in milestone data.", call. = FALSE)
      }
    } else {
      skip = TRUE
      warning("\nCannot create report part 4 report, because no milestone data found for part4.", call. = FALSE)
    }
    if (skip == FALSE) {
      # skip if no data was loaded or if it all rows were NA values
      #----------------
      nightsummary = nightsummary2
      pko = which(nightsummary$sleeponset == 0 & nightsummary$wakeup == 0 & nightsummary$SptDuration == 0)
      if (length(pko) > 0) {
        nightsummary = nightsummary[-pko, ]
      }
      ##################################################### COLLAPSING nightsummary TO A ONELINE
      ##################################################### personsummary PER PARTICIPANT
      if (nrow(nightsummary) == 0) {
        if (verbose == TRUE) cat("report not stored, because no results available")
      } else {
        nightsummary_clean = tidyup_df(nightsummary)
        data.table::fwrite(nightsummary_clean, file = paste(resultfolder, "/results/QC/part4_nightsummary_sleep_full.csv",
                                                   sep = ""), row.names = FALSE, na = "",
                           sep = params_output[["sep_reports"]],
                           dec = params_output[["dec_reports"]])
        nightsummary_bu = nightsummary
      }
      ####
      summarynames_backup = c()
      for (dotwice in 1:2) {
        # store data twice, once full and once cleaned
        if (dotwice == 2) {
          # ignore nights that were derived without sleep log?
          if (only.use.sleeplog == TRUE) {
            del = which(nightsummary$cleaningcode > 0 | nightsummary$sleeplog_used == "FALSE"  |
                          nightsummary$guider == "NotWorn" | nightsummary$guider == "NotWorn+invalid")
          } else {
            # only delete nights with no or no valid accelerometer data or when accelerometer not worn, but consider nights with
            # missing sleep log data
            del = which(nightsummary$cleaningcode > 1 | nightsummary$guider == "NotWorn" | 
                          nightsummary$guider == "NotWorn+invalid")
          }
          if (length(del) > 0) {
            nightsummary = nightsummary_bu[-del, ]
          }
          # Ignore nights based on data_cleaning_file if this is provided include_window = rep(TRUE,
          # nrow(x)) allow for forced relying on guider based on external data_cleaning_file
          if (length(data_cleaning_file) > 0) {
            DaCleanFile = data.table::fread(data_cleaning_file, data.table = FALSE)
            if ("night_part4" %in% colnames(DaCleanFile)) {
              days2exclude = which(paste(nightsummary$ID, nightsummary$night) %in% paste(DaCleanFile$ID, DaCleanFile$night_part4))
              if (length(days2exclude) > 0) {
                nightsummary = nightsummary[-days2exclude, ]
              }
            }
          }
          # ignore also all columns related to error (difference between guider and final estimate,
          # which were mainly used for methodological research
          coldel = which(colnames(nightsummary) %in% c("error_onset", "error_wake", "error_dur") == TRUE)
          if (length(coldel) > 0)
            nightsummary = nightsummary[, -coldel]
        }
        NIDS = max(c(length(unique(nightsummary$filename)), length(unique(nightsummary$ID))))
        NDEF = length(unique(nightsummary$sleepparam))
        uuu = unique(nightsummary$sleepparam)
        rem = which(uuu == 0 | uuu == "0" | is.na(uuu) == TRUE)
        if (length(rem) > 0) {
          uuu = uuu[-rem]
          NDEF = length(uuu)
        }
        if (params_output[["storefolderstructure"]] == TRUE) {
          personSummary = matrix(0, NIDS, ((NDEF * 3 * 22) + 15 + (6 * 3)))
        } else {
          personSummary = matrix(0, NIDS, ((NDEF * 3 * 22) + 13 + (6 * 3)))
        }
        # unique filenames, previously we used unique IDs, but that would not allow
        # for repeated measurements of the same ID to be summarised separately
        uniquefn = unique(nightsummary$filename) 
        if (nrow(nightsummary) > 0) {
          for (i in 1:length(uniquefn)) {
            personSummarynames = c()  #moved here on 3/12/2014
            # fully cleaned from nights that need to be deleted
            this_file = which(nightsummary$filename == uniquefn[i])
            nightsummary.tmp = nightsummary[this_file, ]  #back up
            udef = as.character(unique(nightsummary.tmp$sleepparam))
            if (length(which(as.character(udef) == "0") > 0))
              udef = udef[-c(which(as.character(udef) == "0"))]
            udefn = udef
            #-------------------------------------------
            # general info about file
            personSummary[i, 1] = nightsummary.tmp$ID[1]  #id
            personSummarynames = c(personSummarynames, "ID")
            personSummary[i, 2] = uniquefn[i] #as.character(nightsummary$filename[which(nightsummary$ID == uid[i])][1])  #filename
            if (length(unlist(strsplit(as.character(personSummary[i, 2]), ".RDa"))) > 1)
              personSummary[i, 2] = unlist(strsplit(personSummary[i, 2], ".RDa"))[1]
            personSummarynames = c(personSummarynames, "filename")
            cntt = 2
            personSummary[i, cntt + 1] = as.character(nightsummary$calendar_date[this_file[1]])  #date
            personSummarynames = c(personSummarynames, "calendar_date")
            personSummary[i, cntt + 2] = nightsummary$weekday[this_file[1]]  #date
            personSummarynames = c(personSummarynames, "weekday")
            # sleep log used
            personSummary[i, cntt + 3] = as.character(nightsummary.tmp$sleeplog_used[1])
            personSummarynames = c(personSummarynames, paste("sleeplog_used", sep = ""))
            this_sleepparam = which(nightsummary.tmp$sleepparam == udef[1])
            # sleep log ID
            personSummary[i, cntt + 4] = as.character(nightsummary.tmp$sleeplog_ID[1])
            personSummarynames = c(personSummarynames, paste("sleeplog_ID", sep = ""))
            # total number of nights with acceleration and accelerometer worn
            personSummary[i, cntt + 5] = length(which((nightsummary.tmp$acc_available[this_sleepparam] == "TRUE" |
                                                         nightsummary.tmp$acc_available[this_sleepparam] == "1") &
                                                        nightsummary.tmp$cleaningcode[this_sleepparam] != 2))
            personSummarynames = c(personSummarynames, paste("n_nights_acc", sep = ""))
            # total number of nights with sleep log
            n_nights_sleeplog = length(nightsummary.tmp$night[which(nightsummary.tmp$sleepparam == udef[1] &
                                                                      nightsummary.tmp$guider == "sleeplog")])  # number of nights with sleeplog
            personSummary[i, cntt + 6] = n_nights_sleeplog
            personSummarynames = c(personSummarynames, paste("n_nights_sleeplog", sep = ""))
            # total number of complete weekend and week nights
            th3 = nightsummary.tmp$weekday[this_sleepparam]
            if (only.use.sleeplog == TRUE) {
              validcleaningcode = 0
            } else if (only.use.sleeplog == FALSE) {
              validcleaningcode = 1
            }
            
            personSummary[i, cntt + 7] = length(which(nightsummary.tmp$cleaningcode[this_sleepparam] <= validcleaningcode &
                                                        (th3 == "Friday" | th3 == "Saturday")))
            personSummary[i, cntt + 8] = length(which(nightsummary.tmp$cleaningcode[this_sleepparam] <= validcleaningcode &
                                                        (th3 == "Monday" | th3 == "Tuesday" | th3 == "Wednesday" |
                                                           th3 == "Thursday" | th3 == "Sunday")))
            personSummarynames = c(personSummarynames, paste("n_WE_nights_complete", sep = ""), paste("n_WD_nights_complete",
                                                                                                      sep = ""))
            # number of days with sleep during the day
            personSummary[i, cntt + 9] = length(which(nightsummary.tmp$daysleep[this_sleepparam] == 1 &
                                                        (th3 == "Friday" | th3 == "Saturday")))
            personSummary[i, cntt + 10] = length(which(nightsummary.tmp$daysleep[this_sleepparam] == 1 & 
                                                        (th3 == "Monday" | th3 == "Tuesday" | 
                                                           th3 == "Wednesday" | th3 == "Thursday" |
                                                           th3 == "Sunday")))
            personSummarynames = c(personSummarynames, paste("n_WEnights_daysleeper", sep = ""), paste("n_WDnights_daysleeper",
                                                                                                       sep = ""))
            cnt = cntt + 10
            #-------------------------------------------
            # sleep log summary
            turn_numeric = function(x, varnames) {
              cnx = colnames(x)
              for (i in 1:length(varnames)) {
                if (varnames[i] %in% cnx) {
                  x[, varnames[i]] = as.numeric(x[, varnames[i]])
                }
              }
              return(x)
            }
            if (sleepwindowType == "SPT") {
              gdn = c("guider_SptDuration", "guider_onset", "guider_wakeup")
            } else if (sleepwindowType == "TimeInBed") {
              gdn = c("guider_inbedDuration", "guider_inbedStart", "guider_inbedEnd")
            }
            if (dotwice == 1) {
              nightsummary.tmp = turn_numeric(x = nightsummary.tmp, varnames = gdn)
            }
            varnames_tmp = c("SptDuration", "sleeponset",
                             "wakeup", "WASO", "SleepDurationInSpt",
                             "number_sib_sleepperiod", "duration_sib_wakinghours",
                             "number_of_awakenings", "number_sib_wakinghours", 
                             "duration_sib_wakinghours_atleast15min",
                             "sleeplatency", "sleepefficiency", "number_of_awakenings",
                             "guider_inbedDuration", "guider_inbedStart",
                             "guider_inbedEnd", "guider_SptDuration", "guider_onset",
                             "guider_wakeup", "SleepRegularityIndex",
                             "SriFractionValid")
            nightsummary.tmp = turn_numeric(x = nightsummary.tmp, 
                                            varnames = varnames_tmp)
            weekday = nightsummary.tmp$weekday[this_sleepparam]
            if (dotwice == 1) {
              for (k in 1:3) {
                if (k == 1) {
                  TW = "AD"
                  Seli = 1:length(weekday)
                } else if (k == 2) {
                  TW = "WD"
                  Seli = which(weekday == "Monday" | weekday == "Tuesday" | weekday == "Wednesday" | weekday ==
                                 "Thursday" | weekday == "Sunday")
                } else if (k == 3) {
                  TW = "WE"
                  Seli = which(weekday == "Friday" | weekday == "Saturday")
                }
                relevant_rows = this_sleepparam[Seli]
                if (length(relevant_rows) > 0) {
                  for (gdni in 1:length(gdn)) {
                    personSummary[i, cnt + 1] = mean(nightsummary.tmp[relevant_rows, gdn[gdni]], na.rm = TRUE)
                    personSummary[i, cnt + 2] = sd(nightsummary.tmp[relevant_rows, gdn[gdni]], na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste(gdn[gdni], "_", TW, "_mn", sep = ""),
                                           paste(gdn[gdni], "_", TW, "_sd", sep = ""))
                    cnt = cnt + 2
                  }
                }
                if ("nonwear_perc_spt" %in% colnames(nightsummary.tmp)) {
                  personSummary[i, cnt + 1] = mean(nightsummary.tmp$nonwear_perc_spt[this_sleepparam[Seli]], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("nonwear_perc_spt_", TW, "_mn", sep = ""))
                  cnt = cnt + 1
                }
              }
            }
            nightsummary$cleaningcode = as.numeric(nightsummary$cleaningcode)
            nightsummary$ID = as.character(nightsummary$ID)
            # uid = as.character(uid)
            #-------------------------------------------
            # accelerometer summary
            #----------------------------------------------
            if (only.use.sleeplog == FALSE) {
              # when sleep log is not available
              if (dotwice == 2) {
                CRIT = which(nightsummary$filename == uniquefn[i] & (nightsummary$cleaningcode == 0 | nightsummary$cleaningcode ==
                                                            1))
              } else {
                CRIT = which(nightsummary$filename == uniquefn[i])
              }
            } else {
              CRIT = which(nightsummary$filename == uniquefn[i] & nightsummary$cleaningcode == 0)  #when sleep log is available
            }
            personSummarynames_backup = c()
            if (length(CRIT) > 0) {
              # summarise data if there is data
              #-----------------------------------------------
              for (j in 1:length(udef)) {
                weekday = nightsummary.tmp$weekday[which(nightsummary.tmp$sleepparam == udef[j])]
                for (k in 1:3) {
                  if (ncol(personSummary) < (cnt + 50)) {
                    # expand personSummary matrix if there is a change that is not big enough
                    expansion = matrix(NA, nrow(personSummary), 50)
                    if (nrow(expansion) != nrow(personSummary))
                      expansion = t(expansion)
                    personSummary = cbind(personSummary, expansion)
                  }
                  if (k == 1) {
                    TW = "AD"
                    Seli = 1:length(weekday)
                  } else if (k == 2) {
                    TW = "WD"
                    Seli = which(weekday == "Monday" | weekday == "Tuesday" | weekday == "Wednesday" | weekday ==
                                   "Thursday" | weekday == "Sunday")
                  } else if (k == 3) {
                    TW = "WE"
                    Seli = which(weekday == "Friday" | weekday == "Saturday")
                  }
                  indexUdef = which(nightsummary.tmp$sleepparam == udef[j])[Seli]
                  personSummary[i, (cnt + 1)] = mean(nightsummary.tmp$SptDuration[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 2)] = sd(nightsummary.tmp$SptDuration[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("SptDuration_", TW, "_", udefn[j], "_mn",
                                                                   sep = ""), paste("SptDuration_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 3)] = mean(nightsummary.tmp$SleepDurationInSpt[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 4)] = sd(nightsummary.tmp$SleepDurationInSpt[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("SleepDurationInSpt_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("SleepDurationInSpt_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 5)] = mean(nightsummary.tmp$WASO[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 6)] = sd(nightsummary.tmp$WASO[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("WASO_", TW, "_", udefn[j], "_mn", sep = ""),
                                         paste("WASO_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 7)] = mean(nightsummary.tmp$duration_sib_wakinghours[indexUdef],
                                                     na.rm = TRUE)
                  personSummary[i, (cnt + 8)] = sd(nightsummary.tmp$duration_sib_wakinghours[indexUdef],
                                                   na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("duration_sib_wakinghours_", TW, "_",
                                                                   udefn[j], "_mn", sep = ""), paste("duration_sib_wakinghours_", TW, "_", udefn[j], "_sd",
                                                                                                     sep = ""))
                  personSummary[i, (cnt + 9)] = mean(nightsummary.tmp$number_sib_sleepperiod[indexUdef],
                                                     na.rm = TRUE)
                  personSummary[i, (cnt + 10)] = sd(nightsummary.tmp$number_sib_sleepperiod[indexUdef],
                                                    na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("number_sib_sleepperiod_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("number_sib_sleepperiod_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 11)] = mean(nightsummary.tmp$number_of_awakenings[indexUdef],
                                                      na.rm = TRUE)
                  personSummary[i, (cnt + 12)] = sd(nightsummary.tmp$number_of_awakenings[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("number_of_awakenings_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("number_of_awakenings_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 13)] = mean(nightsummary.tmp$number_sib_wakinghours[indexUdef],
                                                      na.rm = TRUE)
                  personSummary[i, (cnt + 14)] = sd(nightsummary.tmp$number_sib_wakinghours[indexUdef],
                                                    na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("number_sib_wakinghours_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("number_sib_wakinghours_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 15)] = mean(nightsummary.tmp$duration_sib_wakinghours_atleast15min[indexUdef],
                                                      na.rm = TRUE)
                  personSummary[i, (cnt + 16)] = sd(nightsummary.tmp$duration_sib_wakinghours_atleast15min[indexUdef],
                                                    na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("duration_sib_wakinghours_atleast15min_",
                                                                   TW, "_", udefn[j], "_mn", sep = ""), paste("duration_sib_wakinghours_atleast15min_",
                                                                                                              TW, "_", udefn[j], "_sd", sep = ""))
                  # average sibd during the day
                  AVEsibdDUR = c(nightsummary.tmp$duration_sib_wakinghours[indexUdef]/nightsummary.tmp$number_sib_wakinghours[indexUdef])
                  if (length(which(nightsummary.tmp$number_sib_wakinghours[indexUdef] == 0))) {
                    AVEsibdDUR[which(nightsummary.tmp$number_sib_wakinghours[indexUdef] == 0)] = 0
                  }
                  personSummary[i, (cnt + 17)] = mean(AVEsibdDUR, na.rm = TRUE)
                  personSummary[i, (cnt + 18)] = sd(AVEsibdDUR, na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("average_dur_sib_wakinghours_", TW, "_",
                                                                   udefn[j], "_mn", sep = ""), paste("average_dur_sib_wakinghours_", TW, "_", udefn[j],
                                                                                                     "_sd", sep = ""))
                  NDAYsibd = length(which(nightsummary.tmp$number_sib_wakinghours[indexUdef] > 0))
                  if (length(NDAYsibd) == 0) NDAYsibd = 0
                  personSummary[i, (cnt + 19)] = NDAYsibd
                  personSummarynames = c(personSummarynames, paste("n_days_w_sib_wakinghours_", TW, "_",
                                                                   udefn[j], sep = ""))
                  personSummary[i, (cnt + 20)] = mean(nightsummary.tmp$sleeponset[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 21)] = sd(nightsummary.tmp$sleeponset[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("sleeponset_", TW, "_", udefn[j], "_mn",
                                                                   sep = ""), paste("sleeponset_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 22)] = mean(nightsummary.tmp$wakeup[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 23)] = sd(nightsummary.tmp$wakeup[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("wakeup_", TW, "_", udefn[j], "_mn",
                                                                   sep = ""), paste("wakeup_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 24)] = mean(nightsummary.tmp$SleepRegularityIndex[indexUdef],
                                                      na.rm = TRUE)
                  personSummary[i, (cnt + 25)] = sd(nightsummary.tmp$SleepRegularityIndex[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("SleepRegularityIndex_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("SleepRegularityIndex_", TW, "_", udefn[j], "_sd", sep = ""))
                  personSummary[i, (cnt + 26)] = mean(nightsummary.tmp$SriFractionValid[indexUdef], na.rm = TRUE)
                  personSummary[i, (cnt + 27)] = sd(nightsummary.tmp$SriFractionValid[indexUdef], na.rm = TRUE)
                  personSummarynames = c(personSummarynames, paste("SriFractionValid_", TW, "_", udefn[j],
                                                                   "_mn", sep = ""), paste("SriFractionValid_", TW, "_", udefn[j], "_sd", sep = ""))
                  cnt = cnt + 27
                  if (sleepwindowType == "TimeInBed") {
                    personSummary[i, (cnt + 1)] = mean(nightsummary.tmp$sleepefficiency[indexUdef], na.rm = TRUE)
                    personSummary[i, (cnt + 2)] = sd(nightsummary.tmp$sleepefficiency[indexUdef], na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste("sleep_efficiency_", TW, "_", udefn[j],
                                                                     "_mn", sep = ""), paste("sleep_efficiency_", TW, "_", udefn[j], "_sd", sep = ""))
                    personSummary[i, (cnt + 3)] = mean(nightsummary.tmp$sleeplatency[indexUdef], na.rm = TRUE)
                    personSummary[i, (cnt + 4)] = sd(nightsummary.tmp$sleeplatency[indexUdef], na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste("sleeplatency_", TW, "_", udefn[j],
                                                                     "_mn", sep = ""), paste("sleeplatency_", TW, "_", udefn[j], "_sd", sep = ""))
                    personSummary[i, (cnt + 5)] = mean(nightsummary.tmp$guider_inbedStart[indexUdef], na.rm = TRUE)
                    personSummary[i, (cnt + 6)] = sd(nightsummary.tmp$guider_inbedStart[indexUdef], na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste("guider_inbedStart_", TW, "_", udefn[j],
                                                                     "_mn", sep = ""), paste("guider_inbedStart_", TW, "_", udefn[j], "_sd", sep = ""))
                    personSummary[i, (cnt + 7)] = mean(nightsummary.tmp$guider_inbedEnd[indexUdef], na.rm = TRUE)
                    personSummary[i, (cnt + 8)] = sd(nightsummary.tmp$guider_inbedEnd[indexUdef], na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste("guider_inbedEnd_", TW, "_", udefn[j],
                                                                     "_mn", sep = ""), paste("guider_inbedEnd_", TW, "_", udefn[j], "_sd", sep = ""))
                    personSummary[i, (cnt + 9)] = mean(nightsummary.tmp$guider_inbedDuration[indexUdef],
                                                       na.rm = TRUE)
                    personSummary[i, (cnt + 10)] = sd(nightsummary.tmp$guider_inbedDuration[indexUdef],
                                                      na.rm = TRUE)
                    personSummarynames = c(personSummarynames, paste("guider_inbedDuration_", TW, "_", udefn[j],
                                                                     "_mn", sep = ""), paste("guider_inbedDuration_", TW, "_", udefn[j], "_sd", sep = ""))
                    cnt = cnt + 10
                  }
                }
              }
              personSummary[i, cnt + 1] = as.character(nightsummary$GGIRversion[this_file[1]])
              cnt = cnt + 1
              personSummarynames = c(personSummarynames, "GGIRversion")
              personSummarynames_backup = personSummarynames
            }
          }
          # replace matrix values 'NA' and 'NaN' by empty cells
          for (colli in 1:ncol(personSummary)) {
            missingv = which(is.na(personSummary[, colli]) == TRUE |
                               personSummary[, colli] == "NA" |
                               personSummary[, colli] == "NaN")
            if (length(missingv) > 0) {
              personSummary[missingv, colli] = ""
            }
          }
          personSummary = as.data.frame(personSummary, stringsAsFactors = TRUE)
          if (length(personSummarynames) != ncol(personSummary)) {
            if (length(personSummarynames_backup) > 0) {
              names(personSummary) = personSummarynames_backup
            } else {
              if (length(personSummarynames) > ncol(personSummary)) {
                names(personSummary)[1:length(personSummarynames)] = personSummarynames
              } else {
                names(personSummary) = personSummarynames[1:ncol(personSummary)]
              }
            }
          } else {
            names(personSummary) = personSummarynames
          }
          # remove empty columns in personpersonSummary, if any
          emptycolumns = which(is.na(colnames(personSummary)) == TRUE)
          if (length(emptycolumns) > 0) {
            personSummary = personSummary[, -emptycolumns]
          }
        }
        #######################################################
        if (nrow(nightsummary) == 0) {
          if (verbose == TRUE) cat("\nreport not stored, because no results available")
        } else {
          nightsummary_clean = tidyup_df(nightsummary)
          personSummary_clean = tidyup_df(personSummary)
          if (dotwice == 1) {
            data.table::fwrite(nightsummary_clean, file = paste(resultfolder, "/results/QC/part4_nightsummary_sleep_full.csv",
                                                       sep = ""), row.names = FALSE, na = "",
                               sep = params_output[["sep_reports"]],
                               dec = params_output[["dec_reports"]])
            data.table::fwrite(personSummary_clean, file = paste(resultfolder, "/results/QC/part4_summary_sleep_full.csv",
                                                        sep = ""), row.names = FALSE, na = "",
                               sep = params_output[["sep_reports"]],
                               dec = params_output[["dec_reports"]])
          } else {
            data.table::fwrite(nightsummary_clean, file = paste(resultfolder, "/results/part4_nightsummary_sleep_cleaned.csv",
                                                       sep = ""), row.names = FALSE, na = "",
                               sep = params_output[["sep_reports"]],
                               dec = params_output[["dec_reports"]])
            data.table::fwrite(personSummary_clean, file = paste(resultfolder, "/results/part4_summary_sleep_cleaned.csv",
                                                        sep = ""), row.names = FALSE, na = "",
                               sep = params_output[["sep_reports"]],
                               dec = params_output[["dec_reports"]])
          }
        }
      }
    }
  }
}

Try the GGIR package in your browser

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

GGIR documentation built on Sept. 11, 2024, 8:59 p.m.