R/longitudinal_plot_g.R

In ctross/STRAND: An R package for simulating and analyzing social network data in R and Stan

#' Plot multiplex random effects - generalized reciprocity
#'
#' @param input A STRAND model object, obtained by fitting a multiplex combined stochastic block and social relations model.
#' @param HPDI Highest Posterior Density Interval. Ranges in (0,1).
#' @param plot Should a plot be displayed?
#' @param export_as_table Should the tabular data rather than a ggplot object be returned?
#' @param save_plot Should a plot be exported to working directory? If so, set save_plot="desired_filename.pdf".
#' @param height Height of exported plot.
#' @param width Width of exported plot.
#' @param palette Override the default palette with a 3-vector of color codes.
#' @return A figure or tabluar data to make a figure.
#' @export
#' @examples
#' \dontrun{
#' res = multiplex_plot_g(input = fit)
#' }
#'

longitudinal_plot_g = function(input, HPDI=0.9, plot = TRUE, export_as_table = FALSE, save_plot = NULL, height=6, width=6, palette=NULL){
 if(is.null(palette)){
  palette = c("black", "grey60","darkred","#975e3d", "#406e6b")  
    }

 stanfit = posterior::as_draws_rvars(input$fit$draws())
 corr = posterior::draws_of(stanfit$"G_corr")

 N_responses = input$data$N_responses
 layer_names = attr(input$data,"layer_names")
 names_outcomes = c(paste0(layer_names, "\n(sender)"), paste0(layer_names, "\n(receiver)"))

 rs_m = apply(corr, 2:3, median)
 rs_l = apply(corr, 2:3, HPDI, prob=HPDI)[1,,]
 rs_h = apply(corr, 2:3, HPDI, prob=HPDI)[2,,]

 rs_m[lower.tri(rs_m)] = NA
 diag(rs_m) = NA

 rs_l[lower.tri(rs_l)] = NA
 diag(rs_l) = NA

 rs_h[lower.tri(rs_h)] = NA
 diag(rs_h) = NA

 m1 = m2 = rs_type = rs_m
 rs_type[which(!is.na(rs_type))] = "Cross"

 for(i in 1:(2*N_responses)){
   m1[i,] = names_outcomes[i]
   m2[,i] = names_outcomes[i]
 }

 for(m in 1:(N_responses-1)){
 for(n in (m+1):N_responses){
  rs_type[m,n] = "Sender"
  rs_type[N_responses+m,N_responses+n] = "Receiver"
 }}

 rs_m = c(rs_m)
 rs_l = c(rs_l)
 rs_h = c(rs_h)

 m1 = c(m1)
 m2 = c(m2)

 rs_type = c(rs_type)  

 # Prep for CI figure
  substrRight = function(x, n){
  x = as.character(x)
  substr(x, nchar(x)-n+1, nchar(x))
  }

  substrLeft = function(x, n){
  x = as.character(x)
  substr(x, 1, nchar(x)-n+1)
  }

 r_if_sig = ifelse(rs_l > 0 | rs_h < 0, round(rs_m, 2), NA)

 df = data.frame(rs_m=rs_m, l=rs_l, h=rs_h, m1=m1, m2=m2, r_if_sig=r_if_sig, rs_type=rs_type)

 Time = l = h = Type = c()

  df_sub1 = df[which(df$m1==names_outcomes[1] & df$rs_type=="Sender"),]
  df_sub2 = df[which(df$m1==names_outcomes[N_responses+1] & df$rs_type=="Receiver"),]
  df_sub1$Time = c(1:(N_responses-1))
  df_sub2$Time = c(1:(N_responses-1))

  df_sub1$Type = "Sender"
  df_sub2$Type = "Receiver"

  df_sub3 = df[which(df$m1==names_outcomes[1] & df$rs_type=="Cross"),]
  df_sub4 = df[which(df$m2==names_outcomes[N_responses+1] & df$rs_type=="Cross"),]
  df_sub3$Time = c(0:(N_responses-1))
  df_sub4$Time = c(0:(N_responses-1))

  df_sub3$Type = "Cross, R>S"
  df_sub4$Type = "Cross, S>R"

  df_sub0 = df_sub3[1,]
  
  df_sub3 = df_sub3[-1,]
  df_sub4 = df_sub4[-1,]

  df_sub0$Type = "Generalized Reciprocity"

  df_sub = rbind(df_sub1, df_sub2, df_sub3, df_sub4, df_sub0)

p = ggplot2::ggplot(df_sub, ggplot2::aes(x=Time, y=as.numeric(rs_m), ymin=as.numeric(l), ymax=as.numeric(h), group=Type, color=Type))+ 
     ggplot2::geom_linerange(size=1, position = ggplot2::position_dodge(width = 0.3))+
     ggplot2::geom_point(size=2, position = ggplot2::position_dodge(width = 0.3))+
     ggplot2::geom_hline(ggplot2::aes(yintercept=0),color="black",linetype="dashed")+
     ggplot2::labs(y="Generalized reciprocity correlations", x="Time-step lags") + 
     ggplot2::theme(strip.text.x = ggplot2::element_text(size=12,face="bold"), 
      strip.text.y = ggplot2::element_text(size=12,face="bold"),
      axis.text = ggplot2::element_text(size=12),
      axis.title = ggplot2::element_text(size=14, face="bold"))+
     ggplot2::theme(strip.text.y = ggplot2::element_text(angle = 360)) + 
    # ggplot2::coord_flip() + 
     ggplot2::theme(panel.spacing = grid::unit(1, "lines")) + ggplot2::scale_color_manual(values = palette) + 
     ggplot2::theme(legend.position="bottom") + ggplot2::theme(legend.title = ggplot2::element_blank())

 if(!is.null(save_plot)){
  ggplot2::ggsave(save_plot, p, height=height, width=width)
 }

 if(plot == TRUE){
  plot(p)
  return(p)  
 }

 if(export_as_table == TRUE){
  return(df_sub)   
 }

}