R/NispDiachr2.R

In zoometh/arithmetic: Methods for NISP Main Domestic Data

NispDiachr2 <- function(df,tax.color=c("blue","red","green")){
  # df <- nisp.df2
  lhisto <- list()
  for (per in df$period){
    # a.hist <- df[1,] # a row
    # TODO: group/average by periods
    a.hist <- df[per,] # a row
    period <- a.hist$period
    a.hist$period <- a.hist$site <- NULL
    a.hist <- reshape::melt(a.hist)
    a.hist$color <- tax.color # color
    # a.hist$color <- c("blue","green","red")# color
    a.gg <- ggplot2::ggplot(a.hist, ggplot2::aes(x = factor(variable), y = value, fill=color)) +
      ggplot2::ggtitle(paste0("per. ",period)) +
      ggplot2::geom_bar(stat='identity')+
      ggplot2::scale_fill_identity()+
      # xlab(paste0("period ",period)) +
      ggplot2::ylab("%") +
      ggplot2::theme_bw() +
      ggplot2::theme(axis.line = ggplot2::element_line(colour = "black"),
                     axis.title.x = ggplot2::element_blank(),
                     panel.grid.major = ggplot2::element_blank(),
                     panel.grid.minor = ggplot2::element_blank(),
                     panel.border = ggplot2::element_blank(),
                     panel.background = ggplot2::element_blank())
    # scale_x_discrete(position = "top") 
    lhisto[[length(lhisto)+1]] <- a.gg
  }
  lchi <- list()
  for (i in 1:(nrow(nisp.df)-1)){
    # i <- 1
    print(paste0("compare period: ",i,"--",i+1))
    a.df <- nisp.df[c(i,i+1),] # subset two rows
    a.df$period <- a.df$site <- NULL
    p.val <- as.character(round(chisq.test(a.df)$p.value,2))
    print(p.val)
    # ggplot not working
    # a.pval <- ggplot() +
    #   theme_void() +
    #   geom_text(aes(0,0,label=as.character(p.val))) +
    #   xlab(NULL) #optional, but safer in case another theme is applied later
    # a.pval <- cowplot::ggdraw() +
    #   cowplot::draw_label(p.val,size=10,fontface = "bold")
    a.pval <- cowplot::ggdraw() +
      cowplot::draw_label(p.val,size=10,fontface = "bold") +
      # cowplot::draw_line(x=c(0.2,0.8),
      #                    y=c(.5,.5),colour="black")+
      # geom_line(arrow = arrow(length=unit(0.30,"cm"), ends="first", type = "closed"))
      ggplot2::geom_segment(ggplot2::aes(x = 0.3, y = .4, xend = 0.7, yend = .4),
                   size = 0.7,
                   arrow = ggplot2::arrow(length = ggplot2::unit(0.2, "cm")))
    lchi[[length(lchi)+1]] <- a.pval
  }
  # merge graph and p.value lists
  # interleaf lists
  list.interleaves <- c(rbind(lhisto,lchi))
  list.interleaves <- head(list.interleaves, -1)
  # relative width
  w.histo <- 4
  w.p.val <- 1
  rel.w <- rep(c(w.histo,w.p.val),length(lhisto))
  rel.w <- head(rel.w, -1)
  # idx <- order(c(seq_along(lhisto), seq_along(lchi)))
  # unlist(c(lhisto,lchi))[idx]
  g.all <- cowplot::plot_grid(plotlist=list.interleaves,
                              ncol=length(list.interleaves),
                              nrow = 1,
                              rel_widths = rel.w)
  return(g.all)
}