R/plotConnection.R

In eifer4/stochasticSampling: Stochastic partitioning sampler.

plotConnection <- function(y.idx = NULL, x.idx = NULL, XY=NULL, YY=NULL, long=NULL, lat=NULL, size.Y=NULL, size.X=NULL, state = NULL, size.name = NULL, file=NULL) {
  
  states <- map_data("state")
  
  if(!is.null(state) ) states <- subset(states, region %in% state )
  
  if(is.null(y.idx)){
    if(!is.null(XY)) {
      y.idx <- 1:nrow(XY)
    } else {
      y.idx <- 1:nrow(YY)
    }
  }
  if(is.null(x.idx) & !is.null(XY))  x.idx <- 1:ncol(XY)
  
  if(is.null(size.Y)) size.Y <- 1
  
  Ydata <- data.frame(lat=lat$Y, long=long$Y, size=size.Y)
  Xdata <- colors <- NULL
  
  breaks<- seq(0,1, 0.2)
  break.lab <- format(breaks)
  stopifnot((!is.null(XY) | !is.null(YY)))
  P<-0
  
  plot.list <- vector("list",2)
  if(!is.null(XY)) {
    if(is.null(size.X)) size.X <- 1
    Xdata <- data.frame(lat = lat$X[x.idx], long=long$X[x.idx], size=size.X[x.idx])
    XY <- XY[y.idx,x.idx]
    
    P <- ncol(XY)
    Q <- nrow(XY)
   
    plot.list[[1]] <- data.frame(value = c(XY), 
                                 lat = rep(lat$Y[y.idx],P), 
                                 long = rep(long$Y[y.idx],P),
                                 latE = rep(lat$X[x.idx], each=Q),
                                 longE = rep(long$X[x.idx], each=Q),
                                 data = "Power Plants")
  }
  
  if(!is.null(YY)){
    YY <- YY[y.idx, y.idx]
    
    Q <- nrow(YY)
    
    plot.list[[2]] <- data.frame(value = c(YY), 
                                 lat = rep(lat$Y[y.idx],Q), 
                                 long = rep(long$Y[y.idx],Q),
                                 latE = rep(lat$Y[y.idx], each=Q),
                                 longE = rep(long$Y[y.idx], each=Q),
                                 data = "Monitors")
  }
  
  plot.data <- do.call("rbind", plot.list)
  plot.data$data <- factor(plot.data$data, levels=c("Power Plants", "Monitors"))

  true.value <- plot.data$value
  plot.data$value <- true.value^3
  
  p <- ggplot() + theme(axis.line=element_blank(),axis.text.x=element_blank(),
                             axis.text.y=element_blank(),axis.ticks=element_blank(),
                             axis.title.x=element_blank(),
                             axis.title.y=element_blank(),
                             panel.background=element_blank(),
                             panel.border=element_blank(),
                             panel.grid.major=element_blank(),
                             panel.grid.minor=element_blank(),
                             plot.background=element_blank())
  
  p <- p + geom_polygon( data=states, aes(x=long, y=lat, group = group),colour="white" )
  
  if(!is.null(XY)) {
    
    p <- p + geom_point(data=Xdata, aes(x=long, y=lat, size=size), pch=21, fill="#ffeda0",color = "#feb24c") + scale_size(name=size.name)
    colors <- c(colors, "#f03b20")
    
  }
  
  p <- p + geom_point(data=Ydata, aes(x=long, y=lat), size=1, pch=21, fill="#74a9cf", color="#045a8d")
  
  if(!is.null(YY)) {
    colors <- c(colors, "blue")
  }
  if(length(colors)>1) {
    color.name <- "Connection"
    guide <- "legend"
  } else {
    color.name <- guide <- FALSE
  }
  p <- p + geom_segment(data=plot.data, aes(x = long, y=lat, xend=longE, yend=latE, alpha=value, color=data)) + scale_alpha(name="Posterior Probability\nof Association",range=c(0,1), limits=c(0,1), labels=seq(0.25,1,0.25),breaks=seq(0.25,1,0.25)^3) + scale_color_manual(guide=guide, name=color.name, values = colors)
  
  if(is.null(file)){
    
    print(p)
    
  } else {
    pdf(file=paste0(file,"_connections.pdf"), height=4, width=7)
    print(p)
    dev.off()
  }

}