HShsvary.r

#! /usr/bin/Rscript
###
### Experiment for how h and ell
### affect the accuracy of VN-via-SGM when matching
### HS facebook and survey networks.
###
### Heather Gaddy Patsolic
### 2017 <[email protected]>
### S.D.G
#

require(igraph)

## Loading required package: igraph

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

require(clue)

## Loading required package: clue

require(raster)

## Loading required package: raster

## Loading required package: sp

require(foreach)

## Loading required package: foreach

require(ggplot2)

## Loading required package: ggplot2

run <- FALSE

if(run){
    require(doMC); nCores <- 4

    ## Register Cores for parallelism
    if("package:doMPI" %in% search()){
        cl <- startMPIcluster()
        registerDoMPI(cl)} else {
        registerDoMC(nCores)
        }

    load("../HSdata/coregraphs/hscore_undirected.RData")

    # using HSfbgraphfull
    Afb <- get.adjacency(HSfbgraphfull)

    svec <- c(1:9)
    hvec <- c(1:4)
    sh <- expand.grid(s=svec,h=hvec)

    len2 <- 50

    MK <- foreach(ish = 1:nrow(sh))%:%
          foreach(le = 1:len2,.combine='rbind')%dopar%{

        # for(le in 1:len2){
          set.seed <- 12345*ish + 19*le
          s <- sh[ish,]$s
          h <- sh[ish,]$h
          S <- sample(c(1:nrow(Afb)),s)
          voi <- sample(setdiff(c(1:nrow(Afb)),S),1)
          Nh <- unlist(ego(HSfbgraphfull,h,nodes=voi,mindist=1)) #mindist: 1=open, 0=closed)
          nh <- length(Nh)
          Sx1 <- NULL
          Sx1 <- sort(intersect(Nh,S))
          sx <- length(Sx1)

          c(s,h,sx,nh)
    }
}else{
    load("HShsvary.RData")
}


sallbar <- as.numeric(lapply(MK,function(x){mean(as.numeric(x[,3]))}))
sallsd <- as.numeric(lapply(MK,function(x){sd(as.numeric(x[,3]))}))
sallsd <- sallsd/sqrt(len2)
sci <- cbind(c(sallbar-2*sallsd),c(sallbar+2*sallsd)) # for 95% CI, use 1.96 instead of 2
df1 <- data.frame(sh,sallbar,sci)
ps <-
        ggplot(data=df1, aes(x=s, y = sallbar),colour=as.factor(h)) +
        scale_x_continuous(breaks = df1$s) +
        scale_y_continuous(breaks = df1$s) +
        geom_line(aes(colour=as.factor(h)),size=1)  +
        geom_point(aes(colour=as.factor(h))) +
        theme(axis.line.x = element_line(colour="black"),
              axis.line.y = element_line(colour="black")) +
        geom_errorbar(aes(ymin=X1, ymax=X2,colour=as.factor(h)),
                      width=0.5,size=0.75) +
        theme(text=element_text(size=25)) +
        ylab(expression(s[x])) +
        xlab("s") +
        guides(color=guide_legend(title="h")) +
        labs(title= expression(paste("FB: ", s[x]," as a function of h and s")))

ps

#save.image("HShsvary.RData")

#pdf("FB_Sxfcnsh_tmpHShsvary.pdf",width=8,height=8)
#ps
#dev.off()


if(exists("cl")){
        closeCluster(cl)
    mpi.quit()
    }