R/bar.interaction.R

In alemiani/explora: Explore and Visualize Data

bar.interaction <- function(x.factor, group, response, bartest = T) {
  require(ggplot2)
  require(Rmisc)
  require(ggpubr)
  df <- data.frame(
    response     = response,
    group = as.factor(group),
    x.factor     = x.factor
  )
  SE <- summarySE(df, measurevar = 'response', groupvars = c('x.factor', 'group'), na.rm = T)
  SE <- na.omit(SE)
  print(SE)

  pd <- position_dodge(0.2) # move error bars .05 to the left and right
  TheTitle <- paste(substitute(response))[[3]]
  Y.axis <- paste(substitute(response))[[3]]
  X.axis <- paste(substitute(x.factor))[[3]]

  ThePlot <- ggplot(SE, aes(x=x.factor, y=response, colour=group, group=group)) +
    geom_line(aes(linetype=group),size=1.4, position=pd) +
    # scale_color_manual(values=c("black", "grey40")) +
    theme_bw() +
    geom_point(aes(shape=group), position=pd) +
    geom_point(aes(size= N), position=pd)+
    geom_errorbar(aes(ymax=response+se, ymin=response-se), width=0.2,size=0.5, position=pd) +
    guides(fill=F) +
    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
    theme(plot.title = element_text(size = rel(2)))  +
    ggtitle(TheTitle) +
    xlab(X.axis) + ylab(Y.axis) +
    theme(panel.background = element_rect(fill = "white"))


  #####################################################################################.
  ##################################################################################### Bartest

  if(bartest == T) {
    group <- as.factor(group)
    gg <- levels(as.factor(group))
    lev <- (as.numeric(as.factor(group)))
    sem1 = sd(na.exclude(response[lev == 1]))/sqrt(length(na.exclude(response[lev == 1])))
    mean1 = mean(na.exclude(response[lev == 1]))
    sem2 = sd(na.exclude(response[lev == 2]))/sqrt(length(na.exclude(response[lev == 2])))
    mean2 = mean(na.exclude(response[lev == 2]))

    df <- data.frame(
      group   = c(gg[[1]], gg[[2]]),
      response = c(mean1, mean2),
      sem     = c(sem1, sem2)
    )

    Ns <- tapply(response,group,length)
    means <- tapply(response,group,mean, na.rm = T)
    sds <- tapply(response,group, sd, na.rm = T)

    var.res <- var.test(response ~ group)

    if(var.res$p.value < .05) {
      var.equal = F
    } else {var.equal = T}

    t.res <- t.test(response ~ group, var.equal = var.equal)

    am <- means[[1]]; bm <- means[[2]]
    asd <- sds[[1]]; bsd <- sds[[2]]
    aN <- Ns[[1]]; bN <- Ns[[2]]

    es <- compute.es::tes(t.res$statistic, aN, bN, verbose = F)

    space <- ''
    a <- paste(as.character(levels(group)[1]),' ',
               '(M=',round(am,2),', SD=', round(asd,2),')',
               ' - N=',aN,
               sep = '')
    b <- paste(as.character(levels(group)[2]),' ',
               '(M=',round(bm,2),', SD=', round(bsd,2),')',
               ' - N=',bN,
               sep = '')
    t <- paste('t-test: ','t(', round(t.res$parameter, 2),')=',round(t.res$statistic,2),', p=', round(t.res$p.value,4), sep = '')
    d <- paste('d=', es$d, sep = '')
    v <- paste('var: ','F(', var.res$parameter[1],',',var.res$parameter[2],')=',round(var.res$statistic,2),', p=', round(var.res$p.value,4), sep = '')

    text <- paste(space,a,b,v,t,d,space, sep = '\n')

    TheBar <- ggplot(df, aes(x=group, y=response, fill=group)) +
      geom_bar(position=position_dodge(), stat="identity", fill=c("black", "Grey80"),
               colour="#000000", size=.4) +
      geom_errorbar(aes(ymin=response-sem, ymax=response+sem), width=.2, position=position_dodge(.8)) +
      guides(fill=F) +
      theme(panel.background = element_rect(fill = "white")) +
      labs(x = '', y = '', title = paste(substitute(response))[[3]]) +
      geom_label(aes(x = 1.5, y = response[[1]]/2, label = text), fill = "white") +
      theme(plot.title = element_text(hjust = 0.5))

    ggarrange(TheBar, ThePlot, widths = c(1, 3),
              ncol = 2, nrow = 1)

  }
  else {
    print(table(group, x.factor))
    return(ThePlot)
  }


}
# bar.interaction(x.factor = ToothGrowth$dose, group = ToothGrowth$supp, response = ToothGrowth$len, bartest = F)
# bar.interaction(x.factor = ToothGrowth$dose, group = ToothGrowth$supp, response = ToothGrowth$len, bartest = T)





# bar.interaction <- function(x.factor, group, response) {
#   require(ggplot2)
#   require(Rmisc)
#   require(ggpubr)
#   df <- data.frame(
#     response     = response,
#     group = as.factor(group),
#     x.factor     = x.factor
#   )
#   SE <- summarySE(df, measurevar = 'response', groupvars = c('x.factor', 'group'), na.rm = T)
#   SE <- na.omit(SE)
#   print(SE)
#
#   pd <- position_dodge(0.2) # move error bars .05 to the left and right
#   TheTitle <- paste(substitute(response))[[3]]
#   Y.axis <- paste(substitute(response))[[3]]
#   X.axis <- paste(substitute(x.factor))[[3]]
#
#   ThePlot <- ggplot(SE, aes(x=x.factor, y=response, colour=group, group=group)) +
#     geom_line(aes(linetype=group),size=1.4, position=pd) +
#     scale_color_manual(values=c("black", "grey40")) +
#     geom_point(aes(shape=group), position=pd) +
#     geom_point(aes(size= N), position=pd)+
#     geom_errorbar(aes(ymax=response+se, ymin=response-se), width=0.2,size=0.5, position=pd) +
#     guides(fill=F) +
#     theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
#     theme(plot.title = element_text(size = rel(2)))  +
#     ggtitle(TheTitle) +
#     xlab(X.axis) + ylab(Y.axis) +
#     theme(panel.background = element_rect(fill = "white"))
#
#
#   #####################################################################################.
#   ##################################################################################### barplot
#   group <- as.factor(group)
#   gg <- levels(as.factor(group))
#   lev <- (as.numeric(as.factor(group)))
#   sem1 = sd(na.exclude(response[lev == 1]))/sqrt(length(na.exclude(response[lev == 1])))
#   mean1 = mean(na.exclude(response[lev == 1]))
#   sem2 = sd(na.exclude(response[lev == 2]))/sqrt(length(na.exclude(response[lev == 2])))
#   mean2 = mean(na.exclude(response[lev == 2]))
#
#   df <- data.frame(
#     group   = c(gg[[1]], gg[[2]]),
#     response = c(mean1, mean2),
#     sem     = c(sem1, sem2)
#   )
#
#   Ns <- tapply(response,group,length)
#   means <- tapply(response,group,mean, na.rm = T)
#   sds <- tapply(response,group, sd, na.rm = T)
#
#   var.res <- var.test(response ~ group)
#
#   if(var.res$p.value < .05) {
#     var.equal = F
#   } else {var.equal = T}
#
#   t.res <- t.test(response ~ group, var.equal = var.equal)
#
#   am <- means[[1]]; bm <- means[[2]]
#   asd <- sds[[1]]; bsd <- sds[[2]]
#   aN <- Ns[[1]]; bN <- Ns[[2]]
#
#   es <- compute.es::tes(t.res$statistic, aN, bN, verbose = F)
#
#   space <- ''
#   a <- paste(as.character(levels(group)[1]),' ',
#              '(M=',round(am,2),', SD=', round(asd,2),')',
#              ' - N=',aN,
#              sep = '')
#   b <- paste(as.character(levels(group)[2]),' ',
#              '(M=',round(bm,2),', SD=', round(bsd,2),')',
#              ' - N=',bN,
#              sep = '')
#   t <- paste('t-test: ','t(', round(t.res$parameter, 2),')=',round(t.res$statistic,2),', p=', round(t.res$p.value,4), sep = '')
#   d <- paste('d=', es$d, sep = '')
#   v <- paste('var: ','F(', var.res$parameter[1],',',var.res$parameter[2],')=',round(var.res$statistic,2),', p=', round(var.res$p.value,4), sep = '')
#
#   text <- paste(space,a,b,v,t,d,space, sep = '\n')
#
#   TheBar <- ggplot(df, aes(x=group, y=response, fill=group)) +
#     geom_bar(position=position_dodge(), stat="identity", fill=c("black", "Grey80"),
#              colour="#000000", size=.4) +
#     geom_errorbar(aes(ymin=response-sem, ymax=response+sem), width=.2, position=position_dodge(.8)) +
#     guides(fill=F) +
#     theme(panel.background = element_rect(fill = "white")) +
#     labs(x = '', y = '', title = paste(substitute(response))[[3]]) +
#     geom_label(aes(x = 1.5, y = response[[1]]/2, label = text), fill = "white") +
#     theme(plot.title = element_text(hjust = 0.5))
#
#   ggarrange(TheBar, ThePlot, widths = c(1, 3),
#             ncol = 2, nrow = 1)
#
# }