Heatmaps for imputation with independent models

Libraries and Data

Start by loading the libraries

rm(list=ls())
## Visualize heatmap for imputed graphs
   suppressPackageStartupMessages(library(sna))
   suppressPackageStartupMessages(library(network))
   suppressPackageStartupMessages(library(ggplot2))
 suppressPackageStartupMessages(library(reshape2))

and reading in the data.

## data
net_list <- readRDS("../sim-from-ergm/imputed_100_nets_w_nodemix.RDS")

Processsing the Data

Then we process the data

net <- net_list[[1]]
n <- network.size(net)
matrix.list <- array(NA, dim=c(n, n, length(net_list)))

matrices <- lapply(net_list, function (x) as.matrix.network(x, "adjacency"))

for (i in 1:length(net_list)){
  matrix.list[, , i] <- matrices[[i]]
}

and compile the above data in to a “frequency” matrix

freq <- apply(matrix.list, c(1,2), sum)
colnames(freq) <- net%v%"vertex.names" 
rownames(freq) <- net%v%"vertex.names" 

Plot

Now plot its image.

  customize_image_axes <- function(prop.resp){
  
  axis(1, at=prop.resp/2, labels="Respondents")
  axis(1, at=(prop.resp+(1-prop.resp)/2), labels="Nonrespondents")
  axis(1, at=prop.resp, labels="")
  axis(2, at=prop.resp/2, labels="Respondents")
  axis(2, at=(prop.resp+(1-prop.resp)/2), labels="Nonrespondents")
  axis(2, at=prop.resp, labels="")
}

image(freq, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=298/885)

The x-axis shows respondents to non-respondents from left to right, and the y-axis shows respondents to nonrespondents from the bottom to the top. Hence, in every case, the upper right corner is nonrespondent-nonrespondent, and what we care about.

Image plot, consisting of 50 respondents and 50 nonrespondets is below.

freq_small <- freq[273:323, 273:323]
image(freq_small, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=25/50)

For the sake of comparison, an image plot with only respondents:

freq_resp <- freq[100:150, 100:150]
image(freq_resp, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=25/50)

And with only nonrespondents:

freq_nonresp <- freq[325:375, 325:375]
image(freq_nonresp, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=25/50)

# freq_melt <- melt(freq)
# #image(freq_nonresp, col=gray(32:0/32))
# qplot(x=Var1, y=Var2, data=freq_melt, geom="tile")

png(file="test-heatmaps.png", width=7, height=10,
    units = 'in', res = 1200)
par(mfrow=c(2, 1))

image(freq, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=298/885)

image(freq_small, col=gray(32:0/32), xaxt="n", yaxt="n")
customize_image_axes(prop.resp=25/50)

dev.off()

## png 
##   2