R/histPlot.R

In xiangtuochen/bibliometrixfullname: Comprehensive Science Mapping Analysis

#' Plotting historical co-citation network
#'
#' \code{histPlot} plots a historical co-citation network.
#'
#' The function \code{\link{histPlot}} can plot a historical co-citation network previously created by \code{\link{histNetwork}}.
#' @param histResults is an object of \code{class} "list" containing the following components:
#'
#' \tabular{lll}{
#' NetMatrix \tab  \tab the historical citation network matrix\cr
#' Degree \tab       \tab the min degree of the network\cr
#' histData \tab      \tab the set of n most cited references\cr
#' M \tab      \tab the bibliographic data frame}
#' 
#' is a network matrix obtained by the function \code{\link{histNetwork}}. 
#' @param n is integer. It defines the number of vertices to plot.
#' @param size is an integer. It defines the point size of the vertices. Default value is 5.
#' @param labelsize is an integer. It indicates the label size in the plot. Default is \code{labelsize=5}
#' @param title_as_label is a logical. If TRUE document titles are plotted instead of short labels.
#' @param verbose is logical. If TRUE, results and plots are printed on screen.
#' @return It is list containing: a network object of the class \code{igraph} and a plot object of the class \code{ggraph}.
#' 
#' @examples
#' # EXAMPLE Citation network
#'
#' data(management, package = "bibliometrixData")
#'
#' histResults <- histNetwork(management, sep = ";")
#' 
#' net <- histPlot(histResults, n=20, labelsize = 5)
#' 
#' @seealso \code{\link{histNetwork}} to compute a historical co-citation network.
#' @seealso \code{\link{cocMatrix}} to compute a co-occurrence matrix.
#' @seealso \code{\link{biblioAnalysis}} to perform a bibliometric analysis.
#' 
#' @export
histPlot<-function(histResults, n=20, size = 5, labelsize = 5, title_as_label = FALSE, verbose = TRUE){
  
  colorlist <-  c(brewer.pal(9, 'Set1')[-6], brewer.pal(8, 'Set2')[-7], brewer.pal(12, 'Paired')[-11],brewer.pal(12, 'Set3')[-c(2,8,12)])
  ## legacy with old argument size
  if (isTRUE(size)){
    size <- 5
  }
  
  #LCS=histResults$LCS
  LCS <- colSums(histResults$NetMatrix)
  NET <- histResults$NetMatrix
  ## selecting the first n vertices or all if smaller
  s=sort(LCS,decreasing = TRUE)[min(n, length(LCS))]
  ind=which(LCS>=s)
  NET=NET[ind,ind]
  LCS=LCS[ind]
  
  # Create igraph object
  bsk.network <- graph_from_adjacency_matrix(NET, mode = c("directed"),weighted = NULL)
  
  R <- strsplit(names(V(bsk.network)),",")
  RR <- lapply(R,function(l){
    l=l[1:2]
    l=paste(l[1],l[2],sep=",")})
  
  # add titles
  V(bsk.network)$title <- histResults$histData$Title[ind]
  
  if (isTRUE(title_as_label)){
    V(bsk.network)$id <- tolower(paste(substr(V(bsk.network)$title,1,50),"...",sep=""))
  } else {
    V(bsk.network)$id <- tolower(unlist(RR))
  }
  
  # Compute node degrees (#links) and use that to set node size:
  deg <- LCS
  V(bsk.network)$size <- size
    #rep(size,length(V(bsk.network)))}
  
  #Years=histResults$histData$Year[ind]
  Years <- as.numeric(unlist(str_extract_all(unlist(RR),"[[:digit:]]{4}$")))
  V(bsk.network)$years <- Years
  
  # Remove loops
  bsk.network <- igraph::simplify(bsk.network, remove.multiple = T, remove.loops = T) 
  
  
  # define network layout
  
  E(bsk.network)$color <- "slategray1"
  
  bsk.network <- delete.isolates(bsk.network)
  dg <- decompose.graph(bsk.network)

  layout_m <- as.data.frame(layout.fruchterman.reingold(bsk.network))
  names(layout_m) <- c("x","y")
  layout_m$name <- V(bsk.network)$name
  layout_m$years <- V(bsk.network)$years
  layout_m$cluster <- 0
  rr <- 0
  for (k in 1:length(dg)){
    bsk <- dg[[k]]
    
    a <- ifelse(layout_m$name %in% V(bsk)$name,k,0)
    layout_m$cluster <- layout_m$cluster+a
    Min <- min(layout_m$y[layout_m$cluster==k])-1
    layout_m$y[layout_m$cluster==k] <- layout_m$y[layout_m$cluster==k]+(rr-Min)
    rr <- max(layout_m$y[layout_m$cluster==k])
  }
  #bsk <- bsk.network
  wp <- membership(cluster_infomap(bsk.network,modularity = FALSE))
  layout_m$color <- colorlist[wp]
  layout_m$x <- layout_m$years
  layout_m$y <- (diff(range(layout_m$x))/diff(range(layout_m$y)))*layout_m$y

  ################
  df_net <- dataFromIgraph(bsk.network, layout=as.matrix(layout_m[c("x","y")]), niter=50000, arrow.gap=0)
  df_net$color <- "slategray1"
  df_net <- left_join(df_net,layout_m[c("name","color")], by = "name")
  names(df_net)[10:11] <- c("color", "color_v")
  
  ylength <- diff(range(df_net$years))+1
  Ylabel <- (as.character(seq(min(df_net$years),max(df_net$years),length.out=ylength)))
  Breaks <- (seq(0,1,length.out=ylength))
  
  df_net <- df_net %>% 
    left_join(histResults$histData, by = c("name" = "Paper")) #%>%
  
#  Title <- strsplit(df_net$title, "(?<=.{40})", perl = TRUE)
  Title <- gsub("(.{40})", "\\1\n",df_net$title) 
  df_net$Title <- unlist(lapply(Title, function(x){
    paste(x,"\n",collapse="", sep="")
  }))
  df_net <- df_net %>%
    mutate(text = paste(tolower(.data$Title), "doi: ",
                        .data$DOI, "\nLCS: ",
                        .data$LCS, "    GCS: ",
                        .data$GCS, sep=""))
  
  g <- ggplot(df_net, aes(x = .data$x, y = .data$y, xend = .data$xend, yend = .data$yend, text=.data$text)) +
    geom_network_edges(color = "grey", size=0.4, alpha=0.4) +
    geom_network_nodes(aes(color = .data$color_v), size = size, alpha=0.5) +
    geom_text(aes(label=.data$id, color=.data$color_v),  size=labelsize,
              nudge_x = 0,
              nudge_y = 0.02,
              check_overlap = FALSE,alpha=0.7)+
    scale_x_continuous(labels=Ylabel,breaks=Breaks)+
    guides(size="none", color="none") +
    theme_minimal()+
    theme(legend.position='none', panel.background = element_rect(fill='white', color='white'),
          axis.line.y = element_blank(), axis.text.y = element_blank(),axis.ticks.y=element_blank(),
          axis.title.y = element_blank(), axis.title.x = element_blank(),
          panel.grid.minor.y = element_blank(), panel.grid.major.y = element_blank(),
          panel.grid.major.x = element_line(adjustcolor(col="grey", alpha.f = 0.2), linetype = 2, size = 0.5),
          panel.grid.minor.x = element_blank(), 
          axis.text.x=element_text(face="bold", angle = 90, size=labelsize+4)) +
    labs(title = "Historical Direct Citation Network") 
  
  ### logo coordinates
  #data("logo",envir=environment())
  #logo <- grid::rasterGrob(logo,interpolate = TRUE)
  
  a <- ggplot_build(g)$data
  
  ymin <- unlist(lapply(a, function(l){
    if ("y" %in% names(l)){
      min(l["y"])  
    }
  })) %>% min(na.rm=TRUE)
  
  ymax <- unlist(lapply(a, function(l){
    if ("y" %in% names(l)){
      max(l["y"])  
    }
  })) %>% max(na.rm=TRUE)
  
  xmin <- unlist(lapply(a, function(l){
    if ("x" %in% names(l)){
      min(l["x"])  
    }
  })) %>% min(na.rm=TRUE)
  
  xmax <- unlist(lapply(a, function(l){
    if ("x" %in% names(l)){
      max(l["x"])  
    }
  })) %>% max(na.rm=TRUE)
  
  x <- c(xmax-0.02-diff(c(xmin,xmax))*0.125, xmax-0.02)
  y <- c(ymin,ymin+diff(c(ymin,ymax))*0.125)+0.02
  
  g <- g #+
    #annotation_custom(logo, xmin = x[1], xmax = x[2], ymin = y[1], ymax = y[2]) 

  
  if (isTRUE(verbose)) {
    plot(g)
    
    cat("\n Legend\n\n")
    
    label <- data.frame(Label = names(V(bsk.network)), stringsAsFactors = FALSE)
    Data <-  histResults$histData
    
    Data <- left_join(label,Data, by = c("Label" = "Paper"))
    
    print(Data[,-2])
  }
  
  results <- list(net=bsk.network, g=g, layout=layout_m, axis=data.frame(label=Ylabel,values=Breaks))
  return(results)
}


# ### layout function
# histLayout <- function(NET,bsk.network,Years,edgesize=edgesize){
#   
#   diag(NET)=0
#   
#   up=triu(NET)
# 
#   A=apply(NET,2,function(x){
#     x[x>0]=sum(x)
#     return(x)
#   })
#    E(bsk.network)$width=log(t(A)[t(A)>0],base=exp(1))*edgesize
#   
#    return(bsk.network)
# }

delete.isolates <- function(graph, mode = 'all') {
  isolates <- which(degree(graph, mode = mode) == 0) - 1
  delete.vertices(graph, names(isolates))
}