## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = FALSE ) ## ----------------------------------------------------------------------------- # library(gp3tools) # # data("gazepoint_example_master") # data("gazepoint_example_pupil_windows") # # master <- gazepoint_example_master # pupil_windows <- gazepoint_example_pupil_windows ## ----------------------------------------------------------------------------- # export_dir <- system.file( # "extdata", # "gazepoint_realistic_demo_exports", # package = "gp3tools" # ) # output_dir <- "C:/Users/YourName/Desktop/gp3_outputs" # # results <- run_gazepoint_workflow( # export_dir = export_dir, # output_dir = output_dir, # prefix = "study1", # save_plots = TRUE, # create_report = TRUE # ) # # all_gaze <- results$all_gaze # master <- create_gazepoint_master(all_gaze) ## ----------------------------------------------------------------------------- # master_audit <- audit_gazepoint_master(master) # # validation <- validate_gazepoint_master(master) # # master_audit$overview # validation$summary # validation$checks ## ----------------------------------------------------------------------------- # pupil_summary <- summarise_gazepoint_pupil(master) # # flagged_pupil <- flag_gazepoint_pupil( # master, # pupil_col = "pupil" # ) # # interpolated_pupil <- interpolate_gazepoint_pupil( # flagged_pupil, # pupil_col = "pupil_for_preprocessing", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # baseline_corrected <- baseline_correct_gazepoint_pupil( # interpolated_pupil, # pupil_col = "pupil_interpolated", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global"), # baseline_window = c(0, 200), # min_baseline_samples = 1 # ) # # smoothed_pupil <- smooth_gazepoint_pupil( # baseline_corrected, # pupil_col = "pupil_baseline_corrected", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global"), # window_samples = 5, # method = "mean", # align = "center", # min_points = 2 # ) ## ----------------------------------------------------------------------------- # pupil_windows <- summarise_gazepoint_pupil_windows( # smoothed_pupil, # pupil_col = "pupil_smoothed", # time_col = "time", # windows = c(0, 500, 1000, 2000, 5000), # group_cols = c("subject", "MEDIA_ID", "trial_global", "condition"), # min_valid_samples = 1 # ) # # pupil_windows ## ----------------------------------------------------------------------------- # registry <- create_gazepoint_preprocessing_registry( # blink_padding_ms = 50, # interpolation_max_gap_ms = 150, # smoothing_window_samples = 5, # baseline_window = c(0, 200) # ) # # artifact_pupil <- flag_gazepoint_pupil_artifacts( # master, # registry = registry, # pupil_col = "pupil", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # interpolated_artifact_pupil <- interpolate_gazepoint_pupil( # artifact_pupil, # pupil_col = "pupil_clean", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # baseline_artifact_pupil <- baseline_correct_gazepoint_pupil( # interpolated_artifact_pupil, # pupil_col = "pupil_interpolated", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global"), # baseline_window = c(0, 200), # min_baseline_samples = 1 # ) # # smoothed_artifact_pupil <- smooth_gazepoint_pupil( # baseline_artifact_pupil, # pupil_col = "pupil_baseline_corrected", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global"), # window_samples = 5, # method = "mean", # align = "center", # min_points = 2 # ) # # pupil_windows_conservative <- summarise_gazepoint_pupil_windows( # smoothed_artifact_pupil, # pupil_col = "pupil_smoothed", # time_col = "time", # windows = c(0, 500, 1000, 2000, 5000), # group_cols = c("subject", "MEDIA_ID", "trial_global", "condition"), # min_valid_samples = 1 # ) ## ----------------------------------------------------------------------------- # gap_audit <- audit_gazepoint_pupil_gaps( # interpolated_artifact_pupil, # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # baseline_audit <- audit_gazepoint_pupil_baseline( # baseline_artifact_pupil, # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # imbalance_audit <- audit_gazepoint_pupil_imbalance( # smoothed_artifact_pupil, # group_cols = "condition" # ) # # drift_audit <- audit_gazepoint_pupil_drift( # smoothed_artifact_pupil, # pupil_col = "pupil_smoothed", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # overlap_audit <- audit_gazepoint_pupil_overlap_risk( # master, # time_col = "time", # event_col = "event_label", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # gap_audit$overview # baseline_audit$overview # imbalance_audit$overview # drift_audit$overview # overlap_audit$overview ## ----------------------------------------------------------------------------- # pupil_reliability <- audit_gazepoint_pupil_reliability( # pupil_windows_conservative, # subject_col = "subject", # outcome_col = "mean_pupil", # condition_col = "condition" # ) # # pchip_pupil <- interpolate_gazepoint_pupil_pchip( # artifact_pupil, # pupil_col = "pupil_clean", # time_col = "time", # group_cols = c("subject", "MEDIA_ID", "trial_global") # ) # # hampel_pupil <- flag_gazepoint_pupil_hampel( # smoothed_artifact_pupil, # pupil_col = "pupil_smoothed", # time_col = "time", # grouping_cols = c("subject", "MEDIA_ID", "trial_global"), # window_size_samples = 7, # k = 3, # min_valid_samples = 3, # corrected_col = "pupil_hampel_corrected" # ) # # pupil_reliability$overview # attr(pchip_pupil, "gp3_pchip_overview") # attr(hampel_pupil, "gp3_hampel_overview") ## ----------------------------------------------------------------------------- # pupil_window_model_data <- prepare_gazepoint_pupil_window_model_data( # pupil_windows_conservative, # outcome_col = "mean_pupil", # subject_col = "subject", # condition_col = "condition", # window_col = "window_label", # trial_col = "trial_global", # valid_samples_col = "n_valid_samples", # total_samples_col = "n_samples", # min_valid_samples = 1 # ) # # dplyr::count( # pupil_window_model_data, # pupil_window_condition, # pupil_window_label, # pupil_window_model_status # ) ## ----------------------------------------------------------------------------- # pupil_window_lmm <- fit_gazepoint_pupil_window_lmm( # pupil_window_model_data, # random_window_slopes = FALSE, # use_weights = TRUE, # REML = FALSE # ) # # pupil_window_lmm$model_status # pupil_window_lmm$formula # pupil_window_lmm$fixed_effects # pupil_window_lmm$comparison ## ----------------------------------------------------------------------------- # pupil_window_sensitivity <- fit_gazepoint_pupil_window_sensitivity( # pupil_window_model_data, # model_types = c( # "unweighted_lmm", # "weighted_lmm", # "fixed_lm", # "weighted_lm" # ), # include_condition = TRUE, # include_window = TRUE, # include_interaction = TRUE # ) # # pupil_window_sensitivity$comparison # pupil_window_sensitivity$fixed_effects ## ----------------------------------------------------------------------------- # pupil_gamm_data <- prepare_gazepoint_pupil_gamm_data( # smoothed_artifact_pupil, # pupil_col = "pupil_smoothed", # time_col = "time", # subject_col = "subject", # condition_col = "condition", # trial_col = "trial_global", # bin_width_ms = 50, # min_valid_samples = 1 # ) ## ----------------------------------------------------------------------------- # pupil_gamm_fit <- fit_gazepoint_pupil_gamm( # pupil_gamm_data, # n_time_basis = 10, # discrete = TRUE # ) # # pupil_gamm_fit$model_status # pupil_gamm_fit$formula ## ----------------------------------------------------------------------------- # pupil_pfe_fit <- fit_gazepoint_pupil_pfe_gamm( # pupil_gamm_data, # n_time_basis = 10, # n_position_basis = 8, # discrete = TRUE # ) # # pupil_pfe_fit$sensitivity_status # pupil_pfe_fit$comparison ## ----------------------------------------------------------------------------- # pupil_gca_data <- prepare_gazepoint_gca_data( # pupil_gamm_data, # pupil_col = "mean_pupil", # time_col = "time_bin_center_ms", # subject_col = "subject", # condition_col = "condition", # degree = 3, # orthogonal = TRUE, # valid_samples_col = "n_valid_samples", # min_valid_samples = 1 # ) # # pupil_gca_fit <- fit_gazepoint_gca( # pupil_gca_data, # REML = FALSE # ) # # pupil_gca_fit$model_status # pupil_gca_fit$comparison ## ----------------------------------------------------------------------------- # cluster_data <- prepare_gazepoint_cluster_data( # pupil_gamm_data, # outcome_col = "mean_pupil", # time_col = "time_bin_center_ms", # subject_col = "subject", # condition_col = "condition" # ) # # cluster_results <- run_gazepoint_cluster_permutation( # cluster_data, # condition_levels = c("control", "treatment"), # n_permutations = 1000, # seed = 123 # ) # # cluster_summary <- summarise_gazepoint_clusters(cluster_results) # # cluster_summary$overview # cluster_summary$significant_clusters ## ----------------------------------------------------------------------------- # divergence <- estimate_gazepoint_divergence_point( # data = pupil_gamm_data, # outcome_col = "mean_pupil", # time_col = "time_bin_center_ms", # condition_col = "condition", # participant_col = "subject", # comparison = c("control", "treatment"), # bootstrap_unit = "participant", # n_boot = 1000, # consecutive_points = 2, # seed = 123 # ) # # divergence$overview # divergence$divergence_point ## ----------------------------------------------------------------------------- # pupil_diagnostics <- diagnose_gazepoint_glmm( # pupil_window_lmm, # model_name = "pupil_window_lmm", # use_dharma = FALSE # ) # # pupil_model_summary <- tidy_gazepoint_model_summary( # pupil_window_lmm, # model_name = "pupil_window_lmm" # ) # # pupil_diagnostics$overview # pupil_model_summary$fixed_effects ## ----------------------------------------------------------------------------- # reporting <- create_gazepoint_reporting_checklist( # data = master, # objects = list( # validation = validation, # gap_audit = gap_audit, # baseline_audit = baseline_audit, # pupil_model = pupil_window_lmm, # diagnostics = pupil_diagnostics # ), # analysis_type = "pupil", # study_title = "Gazepoint pupil study" # ) # # reporting$overview # reporting$checklist