diff --git a/NAMESPACE b/NAMESPACE index e3a9cf9c2..266f6b86b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,7 +35,7 @@ export(g.analyse, g.calibrate, check_params, extract_params, g.imputeTimegaps, g.part5.classifyNaps, tidyup_df, cosinorAnalyses, - detect_nonwear_clipping, + detect_nonwear_clipping, applyCosinorAnalyses, ShellDoc2Vignette, parametersVignette, correctOlderMilestoneData, convertEpochData, appendRecords, extractID, @@ -53,7 +53,7 @@ importFrom("utils", "read.csv", "sessionInfo", "write.csv", importFrom("stats", "aggregate.data.frame", "weighted.mean", "rnorm","median","aggregate","C", "lm.wfit", "quantile", "sd","coef", "lm", "embed", "na.pass", - "residuals", "fitted") + "residuals", "fitted", "cor") import(data.table) importFrom("methods", "is") importFrom("utils", "available.packages", "packageVersion", "help", "read.table") diff --git a/NEWS.md b/NEWS.md index 97f3fa416..f26c91b47 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# CHANGES IN GGIR VERSION 2.10-5 + +- Part 2: Move cosinor analysis code to its own function in order to ease re-using it in both part 2 and part 6. + +- Part2: Expand cosinor analysis with R2 + # CHANGES IN GGIR VERSION 2.10-4 - Part 4: Now better able to handle nights without sustained inactivity bouts (rest) #911 diff --git a/R/applyCosinorAnalyses.R b/R/applyCosinorAnalyses.R new file mode 100644 index 000000000..24dbb4a64 --- /dev/null +++ b/R/applyCosinorAnalyses.R @@ -0,0 +1,72 @@ +applyCosinorAnalyses = function(ts, qcheck, midnightsi, epochsizes) { + # qcheck - vector of length ts to indicate invalid values + ws2 = epochsizes[2] + ws3 = epochsizes[1] + # Re-derive Xi but this time include entire time series + # Here, we ignore duplicated values (when clock moves backward due to DST) + handleDST = !duplicated(ts) + qcheck = qcheck[handleDST] + Xi = ts[handleDST, grep(pattern = "time", x = colnames(ts), invert = TRUE)] + Nlong_epochs_day = (1440 * 60) / ws2 # this is 96 by default + dstgap = which(diff(midnightsi) != Nlong_epochs_day) + if (length(dstgap) > 0) { + # Time moved forward due to DST + gaplocation = ((midnightsi[dstgap[1]] * ws2) / ws3) + (2 * (3600/ws3)) + # Insert NA values + Xi = c(Xi[1:gaplocation], rep(NA, 3600/ws3), Xi[(gaplocation + 1):length(Xi)]) + qcheck = c(qcheck[1:gaplocation], rep(NA, 3600/ws3), qcheck[(gaplocation + 1):length(qcheck)]) + } + + # Xi = log((Xi * 1000) + 1) # log transformed to be more robust against peaks in the data + # set non-wear to missing values, because for Cosinor fit + # it seems more logical to only fit with real data + # this comes at the price of not being able to extract F_pseudo + firstvalid = 1 + if (length(which(qcheck == 1)) > 0) { + is.na(Xi[which(qcheck == 1)]) = TRUE + # ignore invalid start of recording (if applicable) + # such that 24 hour blocks start from first valid value + firstvalid = which(qcheck == 0)[1] + if (is.na(firstvalid) == FALSE) { + if (firstvalid != 1) { + Xi = Xi[firstvalid:length(Xi)] + } + } + } + if (length(which(is.na(Xi) == FALSE)) > (1440 * (60/ws3))) { # Only attempt cosinor analyses if there is more than 24 hours of data + midnightsi_ws3 = (midnightsi - 1) * (ws2 / ws3) + timeOffsetHours = (midnightsi_ws3[which(midnightsi_ws3 >= firstvalid - 1)[1]] - (firstvalid - 1)) / (3600 / ws3) + if (ws3 < 60) { + # If epochsize < 1 minute then aggregate to 1 minute by taking average value + # but keep NA values + XTtime = rep(1:length(Xi), each = 60 / ws3) + XT = data.frame(Xi = Xi, time = XTtime[1:length(Xi)]) + custommean = function(x) { + y = NA + if (length(x) > 0) { + if (length(which(is.na(x) == FALSE) ) > 0) { + y = mean(x, na.rm = TRUE) + } + } + return(y) + } + XT = aggregate(x = XT, by = list(XT$time), FUN = custommean) + if (length(which(is.nan(XT$Xi) == TRUE)) > 0) { + is.na(XT$Xi[which(is.nan(XT$Xi) == TRUE)]) = TRUE + } + Xi = XT$Xi + epochsize = 60 + } else { + epochsize = ws3 + } + # log transform of data in millig + notna = !is.na(Xi) + Xi[notna] = log((Xi[notna]*1000) + 1) + + cosinor_coef = cosinorAnalyses(Xi = Xi, epochsize = epochsize, timeOffsetHours = timeOffsetHours) + cosinor_coef$timeOffsetHours = timeOffsetHours + } else { + cosinor_coef = c() + } + return(cosinor_coef) +} \ No newline at end of file diff --git a/R/cosinorAnalyses.R b/R/cosinorAnalyses.R index eb7d93702..c66c54972 100644 --- a/R/cosinorAnalyses.R +++ b/R/cosinorAnalyses.R @@ -30,5 +30,16 @@ cosinorAnalyses = function(Xi, epochsize = 60, timeOffsetHours = 0) { IVIS_acc_threshold = log(20 + 1), IVIS_per_daypair = TRUE) # take log, because Xi is logtransformed with offset of 1 + coefext$params$R2 = cor(coefext$cosinor_ts$original, coefext$cosinor_ts$fittedYext)^2 + coef$params$R2 = cor(coefext$cosinor_ts$original, coefext$cosinor_ts$fittedY)^2 + + # # this should equal: https://en.wikipedia.org/wiki/Coefficient_of_determination + # yi = coefext$cosinor_ts$original + # fi = coefext$cosinor_ts$fittedY + # meanY = mean(coefext$cosinor_ts$original) + # SSres = sum((yi - fi)^2) + # SStot = sum((y - meanY)^2) + # R2 = 1 - (SSres / SStot) + invisible(list(coef = coef, coefext = coefext, IVIS = IVIS)) } \ No newline at end of file diff --git a/R/g.analyse.avday.R b/R/g.analyse.avday.R index 935914749..b2874c6a1 100644 --- a/R/g.analyse.avday.R +++ b/R/g.analyse.avday.R @@ -117,75 +117,9 @@ g.analyse.avday = function(doquan, averageday, M, IMP, t_TWDI, quantiletype, #---------------------------------- # (Extended) Cosinor analysis if (params_247[["cosinor"]] == TRUE) { - # Re-derive Xi but this time include entire time series - # Here, we ignore duplicated values (when clock moves backward due to DST) - handleDST = !duplicated(IMP$metashort) - qcheck = qcheck[handleDST] - Xi = IMP$metashort[handleDST, acc.metric] - Nlong_epochs_day = (1440 * 60) / ws2 # this is 96 by default - dstgap = which(diff(midnightsi) != Nlong_epochs_day) - if (length(dstgap) > 0) { - # Time moved forward due to DST - gaplocation = ((midnightsi[dstgap[1]] * ws2) / ws3) + (2 * (3600/ws3)) - # Insert NA values - Xi = c(Xi[1:gaplocation], rep(NA, 3600/ws3), Xi[(gaplocation + 1):length(Xi)]) - qcheck = c(qcheck[1:gaplocation], rep(NA, 3600/ws3), qcheck[(gaplocation + 1):length(qcheck)]) - } - - # Xi = log((Xi * 1000) + 1) # log transformed to be more robust against peaks in the data - # set non-wear to missing values, because for Cosinor fit - # it seems more logical to only fit with real data - # this comes at the price of not being able to extract F_pseudo - firstvalid = 1 - if (length(which(qcheck == 1)) > 0) { - is.na(Xi[which(qcheck == 1)]) = TRUE - # ignore invalid start of recording (if applicable) - # such that 24 hour blocks start from first valid value - firstvalid = which(qcheck == 0)[1] - if (is.na(firstvalid) == FALSE) { - if (firstvalid != 1) { - Xi = Xi[firstvalid:length(Xi)] - } - } - } - if (length(which(is.na(Xi) == FALSE)) > (1440 * (60/ws3))) { # Only attempt cosinor analyses if there is more than 24 hours of data - midnightsi_ws3 = (midnightsi - 1) * (ws2 / ws3) - timeOffsetHours = (midnightsi_ws3[which(midnightsi_ws3 >= firstvalid - 1)[1]] - (firstvalid - 1)) / (3600 / ws3) - if (ws3 < 60) { - # If epochsize < 1 minute then aggregate to 1 minute by taking maximum value - # but keep NA values - XTtime = rep(1:length(Xi), each = 60 / ws3) - XT = data.frame(Xi = Xi, time = XTtime[1:length(Xi)]) - custommean = function(x) { - y = NA - if (length(x) > 0) { - if (length(which(is.na(x) == FALSE) ) > 0) { - y = mean(x, na.rm = TRUE) - } - } - return(y) - } - XT = aggregate(x = XT, by = list(XT$time), FUN = custommean) - if (length(which(is.nan(XT$Xi) == TRUE)) > 0) { - is.na(XT$Xi[which(is.nan(XT$Xi) == TRUE)]) = TRUE - } - # experimental: clip all peaks above Xth percentile? - # Q9 = quantile(x = XT$Xi, probs = 0.75, na.rm = TRUE) - # XT$Xi[which(XT$Xi >= Q9)] = Q9 - - # log transform of data in millig - notna = !is.na(XT$Xi) - XT$Xi[notna] = log((XT$Xi[notna]*1000) + 1) - Xi = XT$Xi - epochsize = 60 - } else { - epochsize = ws3 - } - cosinor_coef = cosinorAnalyses(Xi = Xi, epochsize = epochsize, timeOffsetHours = timeOffsetHours) - cosinor_coef$timeOffsetHours = timeOffsetHours - } else { - cosinor_coef = c() - } + cosinor_coef = applyCosinorAnalyses(ts = IMP$metashort[, c("timestamp", acc.metric)], + qcheck = qcheck, + midnightsi, epochsizes = c(ws3, ws2)) } else { cosinor_coef = c() } diff --git a/R/g.analyse.perfile.R b/R/g.analyse.perfile.R index 7f0c89546..23c51118a 100644 --- a/R/g.analyse.perfile.R +++ b/R/g.analyse.perfile.R @@ -156,15 +156,16 @@ g.analyse.perfile = function(I, C, metrics_nav, filesummary[vi] = c(cosinor_coef$timeOffsetHours) s_names[vi] = c("cosinor_timeOffsetHours") vi = vi + 1 - try(expr = {filesummary[vi:(vi + 4)] = as.numeric(c(cosinor_coef$coef$params$mes, + try(expr = {filesummary[vi:(vi + 5)] = as.numeric(c(cosinor_coef$coef$params$mes, cosinor_coef$coef$params$amp, cosinor_coef$coef$params$acr, cosinor_coef$coef$params$acrotime, - cosinor_coef$coef$params$ndays))}, silent = TRUE) - s_names[vi:(vi + 4)] = c("cosinor_mes", "cosinor_amp", "cosinor_acrophase", - "cosinor_acrotime", "cosinor_ndays") - vi = vi + 5 - try(expr = {filesummary[vi:(vi + 9)] = c(cosinor_coef$coefext$params$minimum, + cosinor_coef$coef$params$ndays, + cosinor_coef$coef$params$R2))}, silent = TRUE) + s_names[vi:(vi + 5)] = c("cosinor_mes", "cosinor_amp", "cosinor_acrophase", + "cosinor_acrotime", "cosinor_ndays", "cosinor_R2") + vi = vi + 6 + try(expr = {filesummary[vi:(vi + 10)] = c(cosinor_coef$coefext$params$minimum, cosinor_coef$coefext$params$amp, cosinor_coef$coefext$params$alpha, cosinor_coef$coefext$params$beta, @@ -173,16 +174,19 @@ g.analyse.perfile = function(I, C, metrics_nav, cosinor_coef$coefext$params$DownMesor, cosinor_coef$coefext$params$MESOR, cosinor_coef$coefext$params$ndays, - cosinor_coef$coefext$params$F_pseudo)}, silent = TRUE) - s_names[vi:(vi + 9)] = c("cosinorExt_minimum", "cosinorExt_amp", "cosinorExt_alpha", + cosinor_coef$coefext$params$F_pseudo, + cosinor_coef$coefext$params$R2)}, silent = TRUE) + s_names[vi:(vi + 10)] = c("cosinorExt_minimum", "cosinorExt_amp", "cosinorExt_alpha", "cosinorExt_beta", "cosinorExt_acrotime", "cosinorExt_UpMesor", "cosinorExt_DownMesor", "cosinorExt_MESOR", - "cosinorExt_ndays", "cosinorExt_F_pseudo") - vi = vi + 10 + "cosinorExt_ndays", "cosinorExt_F_pseudo", "cosinorExt_R2") + vi = vi + 11 filesummary[vi:(vi + 1)] = c(cosinor_coef$IVIS$InterdailyStability, cosinor_coef$IVIS$IntradailyVariability) s_names[vi:(vi + 1)] = c("cosinorIS", "cosinorIV") vi = vi + 2 + } else { + vi = vi + 20 } # Variables per metric - summarise with stratification to weekdays and weekend days diff --git a/R/g.part4.R b/R/g.part4.R index 5e85254d5..2a49d46d2 100644 --- a/R/g.part4.R +++ b/R/g.part4.R @@ -62,11 +62,15 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, # initialize output variable names colnamesnightsummary = 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", + "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") + "longitudinal_axis") # + + if (params_output[["storefolderstructure"]] == TRUE) { colnamesnightsummary = c(colnamesnightsummary, "filename_dir", "foldername") } @@ -344,10 +348,10 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, # initialize dataframe to hold sleep period overview: spocum = data.frame(nb = numeric(0), start = numeric(0), end = numeric(0), dur = numeric(0), def = character(0)) - + spocumi = 1 # counter for sleep periods # continue now with the specific data of the night - + guider.df2 = guider.df[which(guider.df$night == j), ] # ================================================================================ get # sleeplog (or HDCZA or L5+/-6hr algorithm) onset and waking time and assess whether it @@ -457,6 +461,7 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, } else { acc_available = TRUE } + if (nrow(sleepdet) == 0) next ki = which(sleepdet$definition == k) if (length(ki) == 0) next @@ -681,13 +686,13 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, } delta_t1 = diff(as.numeric(spocum.t$end)) spocum.t$dur = correct01010pattern(spocum.t$dur) - + #---------------------------- nightsummary[sumi, 1] = accid nightsummary[sumi, 2] = j #night # remove double rows spocum.t = spocum.t[!duplicated(spocum.t), ] - + #------------------------------------ # ACCELEROMETER if (length(which(as.numeric(spocum.t$dur) == 1)) > 0) { @@ -868,6 +873,7 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, spocum.t.dur_sibd = 0 spocum.t.dur_sibd_atleast15min = 0 } + nightsummary[sumi, 14] = spocum.t.dur.noc #total nocturnalsleep /accumulated sleep duration nightsummary[sumi, 15] = nightsummary[sumi, 5] - spocum.t.dur.noc #WASO nightsummary[sumi, 16] = spocum.t.dur_sibd #total sib (sustained inactivty bout) duration during wakinghours @@ -1043,11 +1049,10 @@ g.part4 = function(datadir = c(), metadatadir = c(), f0 = f0, f1 = f1, if (length(nnights.list) == 0) { # if there were no nights to analyse nightsummary[sumi, 1:2] = c(accid, 0) - nightsummary[sumi, 3:30] = NA + nightsummary[sumi, c(3:30, 34, 36:39)] = NA nightsummary[sumi, 31] = fnames[i] nightsummary[sumi, 32] = 4 #cleaningcode = 4 (no nights of accelerometer available) - nightsummary[sumi, c(33,35)] = c(FALSE, TRUE) #sleeplog_used acc_available - nightsummary[sumi, 36:39] = NA + nightsummary[sumi, c(33, 35)] = c(FALSE, TRUE) #sleeplog_used acc_available if (params_output[["storefolderstructure"]] == TRUE) { nightsummary[sumi, 40:41] = c(ffd[i], ffp[i]) #full filename structure and use the lowest foldername as foldername name } diff --git a/R/g.report.part4.R b/R/g.report.part4.R index 5e9158125..b6adb02a3 100644 --- a/R/g.report.part4.R +++ b/R/g.report.part4.R @@ -295,13 +295,18 @@ g.report.part4 = function(datadir = c(), metadatadir = c(), loglocation = c(), 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 = 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")) + varnames = varnames_tmp) weekday = nightsummary.tmp$weekday[this_sleepparam] if (dotwice == 1) { for (k in 1:3) { @@ -428,8 +433,7 @@ g.report.part4 = function(datadir = c(), metadatadir = c(), loglocation = c(), 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 + if (length(NDAYsibd) == 0) NDAYsibd = 0 personSummary[i, (cnt + 19)] = NDAYsibd personSummarynames = c(personSummarynames, paste("n_days_w_sib_wakinghours_", TW, "_", udefn[j], sep = "")) diff --git a/R/g.report.part5.R b/R/g.report.part5.R index c93c8b60e..1469b4efd 100644 --- a/R/g.report.part5.R +++ b/R/g.report.part5.R @@ -139,7 +139,7 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c stringsAsFactors = FALSE) # Find columns filled with missing values - cut = which(sapply(outputfinal, function(x) all(x == "")) == TRUE) + cut = which(sapply(outputfinal, function(x) all(x == "")) == TRUE) if (length(cut) > 0) { outputfinal = outputfinal[,-cut] } @@ -210,10 +210,8 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c CN = colnames(outputfinal) outputfinal2 = outputfinal colnames(outputfinal2) = CN - delcol = which(colnames(outputfinal2) == "TRLi" | - colnames(outputfinal2) == "TRMi" | - colnames(outputfinal2) == "TRVi" | - colnames(outputfinal2) == "sleepparam") + delcol = grep(pattern = "window|TRLi|TRMi|TRVi|sleepparam", + x = colnames(outputfinal2)) if (uwi[j] != "Segments") { delcol = c(delcol, which(colnames(outputfinal2) == "window")) } @@ -250,10 +248,10 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c window = "MM") { # function to take both the weighted (by weekday/weekendday) and plain average of all numeric variables # df: input data.frame (OF3 outside this function) - ignorevar = c("daysleeper", "cleaningcode", "night_number", - "sleeplog_used", "ID", "acc_available", "window_number", - "window", "boutcriter.mvpa", "boutcriter.lig", - "boutcriter.in", "bout.metric") + + ignorevar = c("daysleeper", "cleaningcode", "night_number", "sleeplog_used", + "ID", "acc_available", "window_number", + "boutcriter.mvpa", "boutcriter.lig", "boutcriter.in", "bout.metric") # skip cosinor variables for (ee in 1:ncol(df)) { # make sure that numeric columns have class numeric nr = nrow(df) if (nr > 30) nr = 30 @@ -344,8 +342,8 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c # missing columns, add these: NLUXseg = length(LUX_day_segments) if (length(weeksegment) > 0) { - LUX_segment_vars_expected = paste0("LUX_", LUXmetrics, "_", - LUX_day_segments[1:(NLUXseg - 1)], + LUX_segment_vars_expected = paste0("LUX_", LUXmetrics, "_", + LUX_day_segments[1:(NLUXseg - 1)], "-", LUX_day_segments[2:(NLUXseg)], "hr_day_", weeksegment) } else { @@ -459,6 +457,7 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c # Calculate, weighted and plain mean of all variables # add column to define what are weekenddays and weekdays as needed for function agg_plainNweighted # before processing OF3, first identify which days have enough monitor wear time + validdaysi = getValidDayIndices(x = OF3, window = uwi[j], params_cleaning = params_cleaning) if (length(validdaysi) > 0) { # do not attempt to aggregate if there are no valid days @@ -466,8 +465,10 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c OF4 = agg_plainNweighted(df = OF3[validdaysi,], filename = "filename", daytype = "daytype", window = uwi[j]) # calculate additional variables - columns2keep = c("filename","night_number","daysleeper","cleaningcode","sleeplog_used","guider", - "acc_available","nonwear_perc_day","nonwear_perc_spt","daytype","dur_day_min", + columns2keep = c("filename", "night_number", "daysleeper", + "cleaningcode","sleeplog_used","guider", + "acc_available", "nonwear_perc_day", "nonwear_perc_spt", + "daytype", "dur_day_min", "dur_spt_min") if (uwi[j] == "Segments") { columns2keep = c(columns2keep, "window") @@ -627,7 +628,6 @@ g.report.part5 = function(metadatadir = c(), f0 = c(), f1 = c(), loglocation = c } } } - } } } diff --git a/man/GGIR.Rd b/man/GGIR.Rd index 670d23aa1..d3278919a 100755 --- a/man/GGIR.Rd +++ b/man/GGIR.Rd @@ -1249,7 +1249,6 @@ GGIR(mode = 1:5, over which L5M5 needs to be calculated. Now this is done with argument qwindow.} \item{cosinor}{ - Argument depricated after version 1.5-24. Boolean (default = FALSE). Whether to apply the cosinor analysis from the ActCR package.} } diff --git a/man/applyCosinorAnalyses.Rd b/man/applyCosinorAnalyses.Rd new file mode 100644 index 000000000..90109af20 --- /dev/null +++ b/man/applyCosinorAnalyses.Rd @@ -0,0 +1,30 @@ +\name{applyCosinorAnalyses} +\alias{applyCosinorAnalyses} +\title{ + Apply Cosinor Analyses to time series +} +\description{ + Wrapper function around \link{cosinorAnalyses} that first prepares the time series + before applying the cosinorAnlayses +} +\usage{ + applyCosinorAnalyses(ts, qcheck, midnightsi, epochsizes) +} +\arguments{ + \item{ts}{ + Data.frame with timestamps and acceleration metric. + } + \item{qcheck}{ + Vector of equal length as number of rows in ts with value 1 for invalid + timestamps, 0 otherwise. + } + \item{midnightsi}{ + Indices for midnights in the time series + } + \item{epochsizes}{ + Epoch size for ts and qcheck respectively + } +} +\author{ + Vincent T van Hees +} \ No newline at end of file diff --git a/tests/testthat/test_cosinor.R b/tests/testthat/test_cosinor.R index a4fce97d0..11537498d 100644 --- a/tests/testthat/test_cosinor.R +++ b/tests/testthat/test_cosinor.R @@ -48,6 +48,7 @@ test_that("cosinorAnalyses provides expected output", { expect_equal(coef60$coefext$params$UpMesor, 19.52358, tolerance = 0.01) expect_equal(coef60$coefext$params$DownMesor, 16.47642, tolerance = 0.01) expect_equal(coef60$coefext$params$MESOR, 3.622534, tolerance = 0.01) + expect_equal(coef60$coefext$params$R2, 0.8976208, tolerance = 0.01) # IV IS expect_equal(coef60$IVIS$InterdailyStability, 0.9945789, tolerance = 0.01)