Nothing
#' Pre-prepared plots of PupillometryR data
#'
#' The plot functions are designed to run with just data and pupil selections,
#' with some additional options for fun with plotting. This allows to see
#' raw data as points, grouped by either subject or condition.
#'
#' @param x A PupillometryR dataframe
#' @param pupil Column name of pupil data to be plotted
#' @param group What to group the data by (none, condition, or subject)
#' @param geom Geom to pass to ggplot. Either point, line, or pointrange.
#' @param model Optional argument to plot agains a fitted model
#' @param ... Ignored
#'
#' @examples
#' Sdata <- make_pupillometryr_data(data = pupil_data,
#' subject = ID,
#' trial = Trial,
#' time = Time,
#' condition = Type)
#' Sdata2 <- downsample_time_data(data = Sdata,
#' pupil = LPupil,
#' timebin_size = 100,
#' option = 'median')
#' p <- plot(Sdata2, pupil = LPupil, group = 'subject')
#' p
#'
#' @import ggplot2
#' @import dplyr
#' @import rlang
#' @export
#'
#' @return A ggplot object
plot.PupillometryR <- function(x, pupil, group = c('none', 'condition', 'subject'), geom = c('point', 'line', 'pointrange'), model = NULL, ...){
data <- x
if('PupillometryR' %in% class(data) == FALSE){
stop('Dataframe is not of class PupillometryR. Did you forget to run make_pupillometryr_data? Some tidyverse functions associated with dplyr and tidyr can also interfere with this functionality.')
}
options <- attr(data, 'PupillometryR')
trial <- options$Trial
condition <- options$Condition
subject <- options$Subject
time <- options$Time
pupil <- deparse(substitute(pupil))
if(!is.null(model)){fit <- model$fitted.values}
if(is.null(model)){
if(is.null(group) | length(group) > 1) group = 'none'
if(group == 'condition'){
p <- data %>% ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil, colour = condition, shape = condition))
}
else{
if(group == 'subject'){
p <- data %>% ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil, group = subject))
}
else{
p <- data %>% ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil))
}
}
#Add plot layers
if(is.null(geom) | length(geom) > 1) geom = 'point'
if(geom == 'pointrange'){
q <- p + ggplot2::stat_summary(geom = 'pointrange', fun.data = 'mean_se', size = 0.5, inherit.aes = T, alpha = 0.1) +
ggplot2::ylab('Pupil Size') +
ggplot2::xlab('Time') +
ggplot2::theme(legend.position = c(0.85, 0.85))
}else{
if(geom == 'line'){
q <- p + ggplot2::stat_summary(geom = 'line', fun = 'mean', size = 1, inherit.aes = T) +
ggplot2::ylab('Pupil Size') +
ggplot2::xlab('Time') +
ggplot2::theme(legend.position = c(0.85, 0.85))
}else{
q <- p + ggplot2::stat_summary(geom = 'point', fun = 'mean', size = 1, inherit.aes = T) +
ggplot2::ylab('Pupil Size') +
ggplot2::xlab('Time') +
ggplot2::theme(legend.position = c(0.85, 0.85))
}}
q
}else{
if('gam' %in% class(model)){
data$fit <- fit
if(group == 'condition'){
p <- data %>%
ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil, colour = condition, shape = condition))
}
else{
if(group == 'subject'){
p <- data %>%
ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil, group = subject))
}
else{
p <- data %>%
ggplot2::ggplot(
ggplot2::aes_string(x = time, y = pupil))
}
}
#Add plot layers
q <- p + ggplot2::stat_summary(geom = 'pointrange', fun.data = 'mean_se', size = 1, inherit.aes = T, alpha = 0.1) +
ggplot2::stat_summary(inherit.aes = T, ggplot2::aes(y = fit), geom = 'line', fun = 'mean', size = 2) +
ggplot2::ylab('Pupil Size') +
ggplot2::xlab('Time') +
ggplot2::theme(legend.position = c(0.85, 0.85))
q
}
}
}
#' Pre-prepared plots of PupillometryR data
#'
#' The plot functions are designed to run with just data and pupil selections,
#' with some additional options for fun with plotting. To see these plots,
#' you must first use create_window_data.
#'
#' @param x A Pupil_window_data dataframe
#' @param pupil Column name of pupil data to be plotted
#' @param windows Whether you want to include time windows in the plot - logical
#' @param geom violin plots or boxplots. The newest version adds raincloud plots using Ben Marwick's flat violin plot.
#' @param ... Ignored
#'
#' @examples
#' Sdata <- make_pupillometryr_data(data = pupil_data,
#' subject = ID,
#' trial = Trial,
#' time = Time,
#' condition = Type)
#' regressed_data <- regress_data(data = Sdata, pupil1 = RPupil, pupil2 = LPupil)
#' mean_data <- calculate_mean_pupil_size(data = regressed_data,
#' pupil1 = RPupil, pupil2 = LPupil)
#' base_data <- baseline_data(data = mean_data, pupil = mean_pupil, start = 0, stop = 100)
#' window <- create_window_data(data = base_data,pupil = mean_pupil)
#' p <-plot(window, pupil = mean_pupil, windows = FALSE, geom = 'boxplot')
#' p
#'
#' @import dplyr
#' @import rlang
#' @import ggplot2
#' @export
#'
#' @return A ggplot object
plot.Pupil_window_data <- function(x, pupil, windows = c(FALSE, TRUE), geom = c('raincloud', 'violin', 'boxplot'), ...){
data <- x
if('Pupil_window_data' %in% class(data) == FALSE){
stop('Dataframe is not of class Pupil_window_data. Did you forget to run create_window_data? Some tidyverse functions associated with dplyr and tidyr can also interfere with this functionality.')
}
pupil <- deparse(substitute(pupil))
options <- attr(data, 'Pupil_window_data')
subject <- options$Subject
trial <- options$Trial
window <- options$Window
condition <- options$Condition
other <- options$Other
if(windows == TRUE){
if(is.null(window)){
stop('This data frame has no time windows included. Try running create_time_windows and rerun.')
}
p <- ggplot2::ggplot(data = data,
ggplot2::aes_string(x = window, y = pupil, colour = condition, fill = condition))
if(geom == 'boxplot'){
q <- p + ggplot2::geom_boxplot(alpha = 0.2)
}else{
if(geom == 'violin'){
q <- p + ggplot2::geom_violin(alpha = 0.2) +
ggplot2::stat_summary(geom = 'pointrange', fun.data = 'mean_se', position = ggplot2::position_dodge(1))
}else{ #raincloud
q <- p + geom_flat_violin(position = ggplot2::position_nudge(x = .2, y = 0), alpha = .5, colour = NA) +
ggplot2::geom_boxplot(width = .2, outlier.shape = NA, alpha = 0.2) +
ggplot2::geom_point(position = ggplot2::position_jitter(width = .15), size = .8, alpha = 0.8)
}
}
}else{
p <- ggplot2::ggplot(data = data,
ggplot2::aes_string(x = condition, y = pupil, colour = condition, fill = condition))
if(geom == 'boxplot'){
q <- p + ggplot2::geom_boxplot(alpha = 0.2)
}
else{
if(geom == 'violin'){
q <- p + ggplot2::geom_violin(alpha = 0.2) +
ggplot2::stat_summary(geom = 'pointrange', fun.data = 'mean_se')
}else{
q <- p + geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .5, colour = NA) +
ggplot2::geom_boxplot(width = .2, outlier.shape = NA, alpha = 0.2) +
ggplot2::geom_point(position = position_jitter(width = .15), size = .8, alpha = 0.8)
}
}
}
q + ggplot2::ylab('Change in Pupil Size')
}
#' Pre-prepared plots of PupillometryR data
#'
#' The plot functions are designed to run with just data and pupil selections,
#' with some additional options for fun with plotting. To see these plots,
#' you must first use create_difference_data.
#'
#' @param x A Pupil_difference_data dataframe
#' @param pupil Column name of pupil data to be plotted
#' @param geom string indicating whether made of connected points or a line
#' @param colour string indicating colour of geom, passed to ggplot2
#' @param ... Ignored
#'
#' @examples
#' Sdata <- make_pupillometryr_data(data = pupil_data,
#' subject = ID,
#' trial = Trial,
#' time = Time,
#' condition = Type)
#' regressed_data <- regress_data(data = Sdata, pupil1 = RPupil, pupil2 = LPupil)
#' mean_data <- calculate_mean_pupil_size(data = regressed_data,
#' pupil1 = RPupil, pupil2 = LPupil)
#' base_data <- baseline_data(data = mean_data, pupil = mean_pupil, start = 0, stop = 100)
#' differences <- create_difference_data(data = base_data,
#' pupil = mean_pupil)
#' p <- plot(differences, pupil = mean_pupil, geom = 'line')
#' p
#' @import dplyr
#' @import rlang
#' @import ggplot2
#' @export
#'
#' @return A ggplot object
plot.Pupil_difference_data <- function(x, pupil, geom = c('point', 'line'), colour = 'black', ...){
data <- x
if('Pupil_difference_data' %in% class(data) == FALSE){
stop('Dataframe is not of class Pupil_difference_data. Did you forget to run create_difference_data? Some tidyverse functions associated with dplyr and tidyr can also interfere with this functionality.')
}
pupil <- deparse(substitute(pupil))
options <- attr(data, 'Pupil_difference_data')
subject <- options$Subject
trial <- options$Trial
time <- options$Time
other <- options$Other
p <- ggplot2::ggplot(data = data,
ggplot2::aes_string(x = time, y = pupil))
if(geom == 'line'){
q <- p + ggplot2::stat_summary(geom = 'line', fun = 'mean', size = 1, color = colour)
}
else{
q <- p + ggplot2::stat_summary(geom = 'point', fun = 'mean', size = 1, color = colour)
}
q
}
#' Pre-prepared plots of PupillometryR data
#'
#' The plot functions are designed to run with just data and pupil selections,
#' with some additional options for fun with plotting. To see these plots,
#' you must first use one of the run_functional tests.
#'
#' @param x A Pupil_test_data dataframe
#' @param show_divergence logical indicating whether divergences are to be highlighted
#' @param colour string indicating colour of geom_line, passed to ggplot2
#' @param fill string indicating fill hue of divergence highlights, passed to ggplot2
#' @param ... Ignored
#'
#' @examples
#' Sdata <- make_pupillometryr_data(data = pupil_data,
#' subject = ID,
#' trial = Trial,
#' time = Time,
#' condition = Type)
#' regressed_data <- regress_data(data = Sdata, pupil1 = RPupil, pupil2 = LPupil)
#' mean_data <- calculate_mean_pupil_size(data = regressed_data,
#' pupil1 = RPupil, pupil2 = LPupil)
#' base_data <- baseline_data(data = mean_data, pupil = mean_pupil, start = 0, stop = 100)
#' differences <- create_difference_data(data = base_data,
#' pupil = mean_pupil)
#' spline_data <- create_functional_data(data = differences, pupil = mean_pupil, basis = 10, order = 4)
#' ft_data <- run_functional_t_test(data = spline_data,
#' pupil = mean_pupil)
#' p <- plot(ft_data, show_divergence = TRUE, colour = 'red', fill = 'orange')
#' p
#' @import dplyr
#' @import rlang
#' @import ggplot2
#' @export
#'
#' @return A ggplot object
plot.Pupil_test_data <- function(x, show_divergence = TRUE, colour = 'black', fill = 'grey', ...){
data <- x
if('Pupil_test_data' %in% class(data) == FALSE){
stop('Dataframe is not of class Pupil_test_data. Make the functional data before proceeding. Some tidyverse functions associated with dplyr and tidyr can also interfere with this functionality.')
}
options <- attr(data, 'Pupil_test_data')
subject <- options$Subject
time <- options$Time
other <- options$Other
t <- options$Test
critical <- options$Critical
divergence = options$Divergence
if(show_divergence == T & !(TRUE %in% data[[divergence]])){
show_divergence <- FALSE
message('No divergence to show')
}
if(show_divergence == F){
p <- ggplot2::ggplot(data = data,
ggplot2::aes_string(x = time, y = t))
q <- p + ggplot2::stat_summary(geom = 'line', fun = 'mean', size = 1, color = colour)
}else{
#set up divergences
data2 <- data
data2[['div']] <- ifelse(data2[[divergence]] == T, 1, 0)
data2[['inds']] <- diff(c(0, data2$div))
start <- data2[[time]][data2$inds == 1]
end <- data2[[time]][data2$inds == -1]
if (length(start) > length(end)) end <- c(end, tail(data2[[time]], 1))
rects <- data.frame(start=start, end=end, group=seq_along(start))
min = min(data2[[t]])
max = max(data2[[t]])
p <- ggplot2::ggplot(data = data2,
ggplot2::aes_string(x = time, y = t))
q <- p + ggplot2::stat_summary(geom = 'line', fun = 'mean', size = 1, colour = colour) +
ggplot2::geom_rect(data = rects, inherit.aes = F,
ggplot2::aes(xmin = start, xmax = end,
ymin = -100*max, ymax = 100*max,
group = group),
colour = 'transparent', fill = fill, alpha = 0.3) +
ggplot2::geom_hline(yintercept = critical, linetype = 'dotted') +
ggplot2::geom_hline(yintercept = -critical, linetype = 'dotted') +
ggplot2::coord_cartesian(ylim= c(min, max))
}
q
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.