R/NispDiachr.R

In zoometh/arithmetic: Methods for NISP Main Domestic Data

#' @export
NispDiachr <- function(df){
  lhisto <- list()
  # fill a list of ggplot
  for (per in df$period){
    a.hist <- df[per,] # a row
    period <- a.hist$period
    a.hist$period <- NULL
    a.hist <- a.hist %>%
      gather(key=tax, value=perc) # to long format
    a.hist$color <- c("blue","green","red")# color
    a.gg <- ggplot(a.hist, aes(x = factor(tax), y = perc, fill=color)) +
      ggtitle(paste0("period ",period))+
      geom_bar(stat='identity')+
      scale_fill_identity()+
      # xlab(paste0("period ",period)) +
      ylab("%") +
      theme_bw() +
      theme(axis.line = element_line(colour = "black"),
            axis.title.x = element_blank(),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.border = element_blank(),
            panel.background = 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 <- 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"))
      geom_segment(aes(x = 0.3, y = .4, xend = 0.7, yend = .4),
                   size = 0.7,
                   arrow = arrow(length = 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)
}