R/vizualization.R

In fdrennan/test: What the Package Does (One Line, Title Case)

#' test_plot_theme
#' @export test_plot_theme
test_plot_theme <- function(x) {
  theme(
    axis.text.x = element_text(angle = 45, vjust = 0.75, hjust = 0.75, size = 12),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text = element_text(size = 14),
    axis.title = element_text(size = 14),
    strip.text = element_text(size = 14),
    plot.title = element_text(size = 20),
    axis.title.y = element_text(margin = margin(t = 0, r = 30, b = 0, l = 0)),
    axis.title.x = element_text(margin = margin(t = 30, r = 0, b = 0, l = 0))
  )
}

#' vizualization
#' @export vizualization
vizualization <- function(transformed_data, power = 1, endpoint, baseline, transformation) {
  transform_table <- data.frame(
    power = c(2, 1, 0.5, 0, -0.5, -1),
    transform_name = c(
      "Squared", "Identity",
      "Square Root", "Log",
      "Inverse Square Root",
      "Inverse"
    )
  )

  if (!transformation | power == 1) {
    transformed_data <- transformed_data %>%
      select(-c(Response_Transformed, Baseline_Transformed)) %>%
      rename(
        Baseline_Transformed = Baseline,
        Response_Transformed = Response
      )
    ylabel <- paste(endpoint)
  } else {
    ylabel <- paste(
      transform_table$transform_name[power == transform_table$power],
      "Transformed", endpoint
    )
  }

  if (!baseline) {
    times <- unique(as.character(transformed_data$Time))
    transformed_data <- transformed_data %>%
      mutate(
        Baseline_Transformed = as.numeric(Baseline_Transformed),
        Response_Transformed = as.numeric(Response_Transformed)
      ) %>%
      pivot_wider(names_from = "Time", values_from = "Response_Transformed") %>%
      pivot_longer(
        cols = c("Baseline_Transformed", times), values_to = "Response_Transformed",
        names_to = "Time"
      ) %>%
      mutate(
        Time = as.character(Time),
        Time = if_else(Time == "Baseline_Transformed", "Baseline", Time),
        Time = factor(Time, levels = c("Baseline", times))
      ) %>%
      filter(
        !is.na(Response_Transformed),
        !duplicated(.)
      )
  }

  transformed_data_sum <- transformed_data %>%
    group_by(Treatment, TreatmentNew, Time) %>%
    summarize(
      Mean_Response = mean(Response_Transformed),
      sd_Response = sd(Response_Transformed)
    )


  bar_plot_orig_scale <- ggplot(data = transformed_data_sum, aes(x = Time, y = Mean_Response)) +
    geom_bar(
      stat = "identity", position = "dodge",
      aes(color = Treatment), fill = "white"
    ) +
    geom_errorbar(aes(
      ymin = Mean_Response - sd_Response, ymax = Mean_Response + sd_Response,
      color = Treatment
    ), position = "dodge") +
    geom_point(
      position = position_jitterdodge(dodge.width = 0.85),
      aes(y = Response_Transformed, color = Treatment), show.legend = FALSE,
      data = transformed_data
    ) +
    scale_x_discrete() +
    theme_bw() +
    labs(color = "Treatment") +
    # theme(
    #   axis.text.x = element_text(angle = 45, vjust = 0.75, hjust = 0.75),
    #   panel.grid.major = element_blank(),
    #   panel.grid.minor = element_blank(),
    #   axis.text = element_text(size = 14),
    #   axis.title = element_text(size = 14),
    #   strip.text = element_text(size = 14),
    #   title = element_text(size = 16)
    # ) +
    ylab(ylabel) +
    ggtitle("Bar Plot for Each Group Over Time") +
    test_plot_theme()


  box_plot_transformed <- ggplot(data = transformed_data, aes(x = Time, y = Response_Transformed)) +
    geom_boxplot(aes(color = Treatment), show.legend = FALSE) +
    geom_jitter(width = 0.1, aes(color = Treatment), show.legend = FALSE) +
    theme_bw() +
    labs(color = "Treatment") +
    facet_wrap(Treatment ~ ., nrow = 1) +
    ylab(ylabel) +
    stat_summary(fun = "mean", color = "black", show.legend = FALSE) +
    ggtitle("Box Plot for Each Group Over Time") +
    test_plot_theme()


  sub_line_plot <- ggplot(
    data = transformed_data,
    aes(x = Time, y = Response_Transformed, group = SubjectID)
  ) +
    geom_line(aes(color = Treatment), size = 1.5, show.legend = FALSE) +
    theme_bw() +
    theme(
      legend.position = "bottom",
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      axis.text.x = element_text(
        angle = 45, vjust = 0.75, hjust = 0.75,
        size = 14
      ),
      axis.text.y = element_text(size = 14),
      axis.title = element_text(size = 40),
      strip.text = element_text(size = 14),
      title = element_text(size = 16)
    ) +
    ylab(ylabel) +
    facet_wrap(Treatment ~ ., nrow = 1) +
    ggtitle("Trajectory of Each Subject by Group") +
    test_plot_theme()

  # line_plot <-
  #   ggplot(data = transformed_data_sum,
  #          aes(x = Time, y = Response, color = TreatmentNew)) +
  #   geom_point() +
  #   geom_smooth(method = "lm", alpha = .15, aes(fill = TreatmentNew))
  #   #geom_line(aes(color = TreatmentNew, linetype = TreatmentNew), size = 1.5) +
  #   # facet_wrap(scale ~ ., scales = "free_y") +
  #   theme_bw() +
  #   theme(legend.position = "bottom") +
  #   labs(color = "Treatment", linetype = "Treatment") +
  #   theme(axis.text.x = element_text(angle = 45, vjust = 0.75, hjust = 0.75))

  # Cheng's suggestion 3/8/2022
  line_plot <- ggplot(transformed_data_sum, aes(
    x = Time, y = Mean_Response,
    color = Treatment, group = Treatment
  )) +
    geom_point(size = 1.25, show.legend = F) +
    geom_line(aes(
      x = Time, y = Mean_Response,
      color = Treatment, linetype = Treatment
    ),
    size = 1.25,
    show.legend = T
    ) +
    geom_errorbar(aes(ymin = Mean_Response - sd_Response, ymax = Mean_Response + sd_Response),
      width = .5, show.legend = F
    ) +
    theme_bw() +
    theme(legend.position = "bottom") +
    labs(color = "Treatment", linetype = "Treatment") +
    theme(
      axis.text.x = element_text(angle = 45, vjust = 0.75, hjust = 0.75),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      axis.text = element_text(size = 14),
      axis.title = element_text(size = 14),
      strip.text = element_text(size = 14),
      title = element_text(size = 16),
      legend.text = element_text(size = 14),
      legend.title = element_text(size = 16)
    ) +
    ylab(ylabel) +
    ggtitle("Mean and Standard Error Bars for Each Group Over Time") +
    guides(colour = guide_legend(override.aes = list(size = 10))) +
    test_plot_theme()


  # ggplotly(line_plot) #Interactive plots
  # ggplotly(box_plot) #Interactive plots
  # #Combine plots into one

  # combined_plot <- ggarrange(
  #   plotlist = list(box_plot_transformed,
  #                   line_plot,
  #                   bar_plot_orig_scale,
  #                   sub_line_plot),
  #   common.legend = TRUE, legend = "bottom")
  # #, labels = 'AUTO')


  # Has not been implemented yet
  return(list(
    box = box_plot_transformed,
    group_line = line_plot,
    bar = bar_plot_orig_scale,
    sub_line = sub_line_plot
  ))
}