R/ploting.functions.R

#' Get Linear Model Equation
#'
#'@title Get Linear Model Equation
#'
#'@param m
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@references Helpful Stack Overflow thread \url{https://stackoverflow.com/questions/7549694/adding-regression-line-equation-and-r2-on-graph}
#'
#'@export
#'

lm_eqn <- function(m = lm(y ~ x, df)){
  #m <- lm(y ~ x, df);
  eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2,
                   list(a = format(coef(m)[1], digits = 2),
                        b = format(coef(m)[2], digits = 2),
                        r2 = format(summary(m)$r.squared, digits = 3)))
  as.character(as.expression(eq));
}

#' Show Two Electrode Current Clamp Plots
#'
#'@title Show Two Electrode Current Clamp Plots
#'@param TREATMENT
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export

show_tecc_plots <- function(TREATMENT){
  return.plts <- list()
  # Un-normalized ---------------------------------------------------------------
  return.plts[[1]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = (rc),
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "rc",
         title = paste(TREATMENT, "Coupling Resistance"))+
    theme_cowplot()

  return.plts[[2]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = `Coupling Coefficient`,
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "CC",
         title = paste(TREATMENT, "Coupling Coefficient"))+
    theme_cowplot()

  return.plts[[3]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = `Input Resistance`,
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "Input Resistance",
         title = paste(TREATMENT, "Input Resistance"))+
    theme_cowplot()

  # Normalized ------------------------------------------------------------------
  return.plts[[4]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = (rc/rc.0),
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "Normalized rc",
         title = paste(TREATMENT, "Normalized Coupling Resistance"))+
    theme_cowplot()

  return.plts[[5]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = `Coupling Coefficient`/`Coupling Coefficient.0`,
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "Normalized CC",
         title = paste(TREATMENT, "Normalized Coupling Coefficient"))+
    theme_cowplot()

  return.plts[[6]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT, ], aes(
      x = `Time Exposed`,
      y = `Input Resistance`/`Input Resistance.0`,
      color = interact,
      group = interact
    ))+
    geom_point()+
    geom_line()+
    geom_hline(yintercept = 1, linetype=2)+
    labs(y = "Normalized Input Resistance",
         title = paste(TREATMENT, "Normalized Input Resistance"))+
    theme_cowplot()

  return.plts[[7]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT,], aes(
      x = `Time Exposed`,
      y = `Coupling Coefficient`/`Coupling Coefficient.0`,
      color = interact, group = Condition
    )) +
    geom_point(position = position_jitter(width = 0.1), size = 2) +
    stat_summary(fun.y = mean, geom = "point", pch = 12, size = 5) +
    stat_summary(fun.y = mean, geom = "line", size = 1) +
    labs(color = "interact") +
    labs(title = "Interaction of Treatment:Time \non Coupling Coefficient (normalized)", x = "Time in Minutes", y = "Coupling Coefficient") +
    theme_cowplot()+
    ylim(0,2)

  return.plts[[8]] <-
    ggplot(tecc[tecc$Treatment == TREATMENT,], aes(
      x = Condition,
      y = `Coupling Coefficient`,
      color = interact, group = Condition
    )) +
    geom_boxplot()+
    geom_point(position = position_jitter(width = 0.1), size = 2) +
    labs(title = "Coupling Coefficients over Time", x = "Time in Minutes", y = "Coupling Coefficient") +
    facet_grid(~`Time Exposed`)+
    theme_cowplot()+
    theme(axis.text.x = element_text(angle = 45, hjust = 1))+
    theme(legend.position = "")+
    ylim(0,1)

  return(return.plts)
}

#' Standard Ionic Plots
#'
#' WARNING: unsure why, but the selection here is breaking. To get around it, pass in a pre-selected df.
#'
#'@title Standard Ionic Plots
#'@param current.treatment
#'@param title.prefix
#'@param input.df
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export
#'

standard_ionic_plts <- function(current.treatment = "Small Phase Angle",
                                title.prefix = "HTK Peak",
                                input.df = htk.peak) {

  #urrent.treatment = "Small Phase Angle"
  #title.prefix = "HTK Peak"
  #input.df = a.peak

  plt.list <- list()

  plt.list[[1]] <-
    ggplot(input.df[(round((input.df[input.df$Treatment == current.treatment, "mV"]) / 10) * 10) == 0, ], aes(x = `Time Exposed`, y = nA, color = Condition)) +
    geom_boxplot(aes(group = interaction(`Time Exposed`), fill = Condition)) +
    geom_line(aes(group = interaction(Experiment, Cell), color =interaction(Experiment, Cell))) +
    geom_point(color = "black", size = 2) +
    geom_point(shape = 1, size = 2) +
    labs(title = paste(title.prefix, "Amplitude Over Time"))

  plt.list[[2]] <-
    ggplot(
      input.df[(round((input.df[input.df$Treatment == current.treatment, "mV"]) / 10) * 10) == 0, ],
      aes(
        x = `Time Exposed`,
        y = nA,
        color = Condition, group = Condition
      )
    ) +
    geom_point(position = position_jitter(width = 0.1), size = 2) +
    stat_summary(fun.y = mean, geom = "point", pch = 12, size = 5) +
    stat_summary(fun.y = mean, geom = "line", size = 1) +
    labs(color = "Phase \nAngle") +
    labs(title = paste(title.prefix, "Amplitude Over Time"))

  plt.list[[3]] <-
    ggplot(input.df[input.df$Treatment == current.treatment, ], aes(
      x = mV,
      y = nA,
      color = interact,
      group = Treatment
    )) +
    geom_point(position = position_jitter(width = 0.1), size = 2, shape = 1) +
    geom_smooth(linetype = "dashed", color = "black") +
    facet_grid(~`Time Exposed`) +
    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
    theme(legend.position = "") +
    labs(title = paste(title.prefix, "I/V Over Time")) +
    theme(legend.position = "")

  return(plt.list)
}

#' Standard Ionic Plots One Condition
#'
#'@title Standard Ionic Plots One Condition
#'@param current.treatment
#'@param title.prefix
#'@param input.df
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export
#'

standard_ionic_plts_1c <- function(current.treatment = "Small Phase Angle",
                                   title.prefix = "HTK Peak",
                                   input.df = htk.peak) {

  #urrent.treatment = "Small Phase Angle"
  #title.prefix = "HTK Peak"
  #input.df = a.peak

  plt.list <- list()

  plt.list[[1]] <-
    ggplot(input.df[(round((input.df[input.df$Treatment == current.treatment, "mV"]) / 10) * 10) == 0, ], aes(x = `Time Exposed`, y = nA, color = interact)) +
    geom_boxplot(aes(group = interaction(`Time Exposed`))) +
    geom_line() +
    geom_point(color = "black", size = 2) +
    geom_point(shape = 1, size = 2) +
    labs(title = paste(title.prefix, "Amplitude Over Time"))

  plt.list[[2]] <-
    ggplot(
      input.df[(round((input.df[input.df$Treatment == current.treatment, "mV"]) / 10) * 10) == 0, ],
      aes(
        x = `Time Exposed`,
        y = nA,
        group = Condition
      )
    ) +
    geom_point(position = position_jitter(width = 0.1), size = 2, aes(color = interact)) +
    stat_summary(fun.y = mean, geom = "point", pch = 12, size = 5) +
    stat_summary(fun.y = mean, geom = "line", size = 1) +
    labs(color = "Phase \nAngle") +
    labs(title = paste(title.prefix, "Amplitude Over Time"))

  plt.list[[3]] <-
    ggplot(input.df[input.df$Treatment == current.treatment, ], aes(
      x = mV,
      y = nA,
      color = interact,
      group = Treatment
    )) +
    geom_point(position = position_jitter(width = 0.1), size = 2, shape = 1) +
    geom_smooth(linetype = "dashed", color = "black") +
    facet_grid(~`Time Exposed`) +
    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
    theme(legend.position = "") +
    labs(title = paste(title.prefix, "I/V Over Time")) +
    theme(legend.position = "")

  return(plt.list)
}

#' Save Figure List
#'
#'
#'
#'@title Save Figure List
#'@param input.list
#'@param title.prefix
#'@param file.type
#'@param save.path
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export

save_fig_list <- function(input.list,
                          title.prefix = "test.path",
                          file.type = ".png",
                          save.path = paste0(getwd(), "180315_act_dept_report/figures/")){
  for(i in seq(length(input.list))){
    cowplot::ggsave(paste0(title.prefix,".",as.character(i),as.character(file.type)),
                    plot = input.list[[i]],
                    device = NULL, path = save.path,
                    scale = 1,
                    width = 9.86,
                    height = 5.86,
                    dpi = 300, limitsize = TRUE)
  }
}











































#' Mini auto graph ionic
#'
#' This is an adaptation of `auto_graph` which removes the test portion so I can be used on the scant HTK A data in `Phase Shift`
#'
#'@title Mini auto graph ionic
#'@aliases
#'
#'@param input.df
#'@param input.title.1
#'@param input.title.2
#'@param target.comparison.mv
#'@param start.time
#'@param end.time
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export

mini_auto_graph_ionic <- function(input.df = a.peak,
                                  input.title.1 = c("Transient A Type"),
                                  input.title.2 = c("Transient A Type at 0mV"),
                                  target.comparison.mv = 0,
                                  start.time = 0,
                                  end.time = 70){
  #select
  input.df <- input.df[(input.df$`Time Exposed` == start.time |
                          input.df$`Time Exposed` == end.time) &
                         input.df$mV < 25,]
  input.df[, "Condition"] <- as.factor(input.df[,"Condition"])


  input.df <- input.df[!is.na(input.df[,"mV"]),]
  input.df <- input.df[!is.na(input.df[,"nA"]),]

  input.df <- input.df[!duplicated(input.df),]

  input.df[, "target_mV"] <- round((input.df$mV)/10, 0)*10

  plots.list <- list()
  plots.list[[1]] <-
    ggplot(input.df, aes(x = target_mV, y = nA))+
    geom_boxplot(aes(group = target_mV))+
    geom_point(aes(color = Experiment))+
    geom_point(shape =1)+
    labs(title = input.title.1, x = "Step mV")+
    facet_grid(.~`Time Exposed` )+
    theme_cowplot()

  plots.list[[2]] <-
    ggplot(input.df[input.df$target_mV == target.comparison.mv, ], aes(x = `Time Exposed`, y = nA))+
    geom_boxplot(aes(fill = as.factor(`Time Exposed`)))+
    geom_point(aes(color = interaction(Experiment, Cell)))+
    geom_smooth(method = lm, se = FALSE, aes(group = interaction(Experiment, Cell)))+
    geom_point(shape = 1)+
    labs(title = input.title.2, x = "Time in Minutes")+
    theme_cowplot()

  return(plots.list)
}

#' Auto Graph
#'
#' This is the orginal function. I intended it to work nicely for groups in the standard format (inv, teactrl, -53, aberr)
#'
#'@title Auto Graph
#'@aliases
#'
#'@param input.df
#'@param input.title.1
#'@param input.title.2
#'@param target.comparison.mv
#'@param start.time
#'@param end.time
#'@param iterations
#'
#'@return
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export
#'
#'@examples
#'

auto_graph <- function(input.df = a_peak,
                       input.title.1 = c("Transient A Type"),
                       input.title.2 = c("Transient A Type at 0mV"),
                       target.comparison.mv = 0,
                       start.time = 0,
                       end.time = 70,
                       iterations = 10){

  if (TRUE == FALSE){
    input.df = a_peak
    input.title.1 = c("Transient A Type")
    input.title.2 = c("Transient A Type at 0mV")
    target.comparison.mv = 0
    start.time = 0
    end.time = 80
    iterations = 10
  }

  results.list <- list()

  #select
  input.df <- input.df[(input.df$`Time Exposed` == start.time |
                          input.df$`Time Exposed` == end.time) &
                         input.df$mV < 25,]
  input.df[, "Condition"] <- as.factor(input.df[,"Condition"])


  input.df <- input.df[!is.na(input.df[,"mV"]),]
  input.df <- input.df[!is.na(input.df[,"nA"]),]

  input.df <- input.df[!duplicated(input.df),]

  input.df[, "target_mV"] <- round((input.df$mV)/10, 0)*10

  plots.list <- list()
  plots.list[[1]] <-
    ggplot(input.df, aes(x = target_mV, y = nA))+
    geom_boxplot(aes(group = target_mV))+
    geom_point(aes(color = Experiment))+
    geom_point(shape =1)+
    labs(title = input.title.1, x = "Step mV")+
    facet_grid(.~`Time Exposed` )+
    theme_cowplot()

  plots.list[[2]] <-
    ggplot(input.df[input.df$target_mV == target.comparison.mv, ], aes(x = `Time Exposed`, y = nA))+
    geom_boxplot(aes(fill = as.factor(`Time Exposed`)))+
    geom_point(aes(color = interaction(Experiment, Cell)))+
    geom_smooth(method = lm, se = FALSE, aes(group = interaction(Experiment, Cell)))+
    geom_point(shape = 1)+
    labs(title = input.title.2, x = "Time in Minutes")+
    theme_cowplot()


  #_RUN SOME  TESTS!_
  #does x current differ between 0 and 70 minutes?
  outputs <- as.data.frame(matrix(0, nrow = iterations, ncol = 1))
  names(outputs) <- c("Time Exposed")
  iter.input.df <- input.df[input.df$target_mV == target.comparison.mv, c("nA", "Time Exposed")]
  scrambled.iter.input.df <- iter.input.df

  #cache F stats
  outputs[1,] <- car::Anova(lm(nA ~ `Time Exposed`, data = iter.input.df), type = "III")$`F value`[2]
  tick <- Sys.time()
  set.seed(908743)
  for (i in 2:iterations){
    scrambled.iter.input.df$nA <- sample(iter.input.df$nA)
    outputs[i,] <- car::Anova(lm(nA ~ `Time Exposed`, data = scrambled.iter.input.df), type = "III")$`F value`[2]
  }
  print(Sys.time() - tick)

  #For coloring the histogram
  outputs[,"conditional_color"] <- "< Observed"
  outputs[outputs$`Time Exposed` >= as.numeric(outputs[1, "Time Exposed"]),"conditional_color"] <- ">= Observed"

  title.i.1 <- paste0("The Empirical P-value for Time Effect is ",
                      as.character(mean(outputs[,"Time Exposed"] >= outputs[1,"Time Exposed"])))
  plots.list[[3]] <-
    ggplot(outputs, aes(x = outputs$`Time Exposed`, fill = conditional_color))+
    geom_histogram(bins = 100)+
    geom_vline(xintercept = outputs[1,1], color = "red")+
    labs(x = "F Value", y = "Count", title = title.i.1)+
    theme_cowplot()

  return(plots.list)
}

#' Auto Graph A HTK HTK.LS
#'
#'This extends auto_graph so I can churn through treatments tersely. This to use Condition, not Treatment as it currently is.
#'
#'@title Auto Graph A HTK HTK.LS
#'
#'@param Current.Treatment
#'@param target.iterations
#'
#'@author Daniel Kick (\email{daniel.r.kick@@protonmail.com})
#'
#'@export
#'

auto_graph_a_htk_htk.ls <- function(Current.Treatment = "Silent Control",
                                    target.iterations = 100) {
  return.object <- list()

  a.peak <- sep_peak_end(input.df = a[a$Treatment == Current.Treatment, ], current.type = "a")[[1]] %>% simplify_df() %>% stack_channels()

  a.end <- sep_peak_end(input.df = a[a$Treatment == Current.Treatment, ], current.type = "a")[[2]] %>% simplify_df() %>% stack_channels()

  htk.peak <- sep_peak_end(input.df = htk[htk$Treatment == Current.Treatment, ], current.type = "htk")[[1]] %>% simplify_df() %>% stack_channels()

  htk.end <- sep_peak_end(input.df = htk[htk$Treatment == Current.Treatment, ], current.type = "htk")[[2]] %>% simplify_df() %>% stack_channels()

  htk.ls.peak <- sep_peak_end(input.df = htk[htk$Treatment == Current.Treatment, ], current.type = "htk")[[1]] %>% simplify_df() %>% stack_channels()

  htk.ls.end <- sep_peak_end(input.df = htk[htk$Treatment == Current.Treatment, ], current.type = "htk")[[2]] %>% simplify_df() %>% stack_channels()


  return.object$a.peak <-
    auto_graph(
      input.df = a.peak,
      input.title.1 = c("Transient A Type"),
      input.title.2 = c("Transient A Type at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )

  return.object$a.end <-
    auto_graph(
      input.df = a.end,
      input.title.1 = c("Sustained A Type"),
      input.title.2 = c("Sustained A Type at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )

  return.object$htk.peak <-
    auto_graph(
      input.df = htk.peak,
      input.title.1 = c("Transient HTK"),
      input.title.2 = c("Transient HTK at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )

  return.object$htk.end <-
    auto_graph(
      input.df = htk.end,
      input.title.1 = c("Sustained HTK"),
      input.title.2 = c("Sustained HTK at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )

  return.object$htk.ls.peak <-
    auto_graph(
      input.df = htk.ls.peak,
      input.title.1 = c("Transient HTK"),
      input.title.2 = c("Transient HTK at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )

  return.object$htk.ls.end <-
    auto_graph(
      input.df = htk.ls.end,
      input.title.1 = c("Sustained ls HTK"),
      input.title.2 = c("Sustained ls HTK at 0mV"),
      target.comparison.mv = 0,
      start.time = 0,
      end.time = 80,
      iterations = target.iterations
    )
  return(return.object)
}
danielkick/esynvmod documentation built on May 17, 2019, 7:02 p.m.