Cacher is the code snippet organizer for pro developers

#Code for blog post on visualizing signal flow in a multilayer perceptron: http://osazuwa223.github.io/2014/11/09/Visualizing-Signal-Flow-in-Neural-Network-Model/
# For source: https://github.com/osazuwa223/osazuwa223.github.com/blob/master/_posts/2014-11-09-Visualizing-Signal-Flow-in-Neural-Network-Model.md

states <- c("F.eng.has", "F.eng.none",
             "F.fr.has", "F.fr.none",
             "S.eng.has", "S.eng.none",
             "S.fr.has", "S.fr.none",
             "C.eng.has", "C.eng.none",
             "C.fr.has", "C.fr.none",
             "D.has", "D.none")
transitions <- c("F.eng->S.eng",
               "F.eng->S.fr",
               "F.fr->S.eng",
               "F.fr->S.fr",
               "S.eng->C.eng",
               "S.eng->C.fr",
               "S.fr->C.eng",
               "S.fr->C.fr",
               "C.eng->D",
               "C.fr->D",
               "D.eats")

hasPotatoBefore <- function(agent){
  out <- rep(0, length(transitions))
  if(grepl(".has", agent)){
    agent.sub <- strsplit(agent, ".has")[[1]][1]
    if(agent.sub == "D"){
      out <- grepl("D.eats", transitions)
    } else {
      passesPotato <- paste(agent.sub, "->", sep="")
      out <- grepl(passesPotato, transitions) * 1
    }
  }
  out
}
hasNoPotatoBefore <- function(agent){
  out <- rep(0, length(transitions))
  if(grepl(".none", agent)){
    agent.sub <- strsplit(agent, ".none")[[1]][1]
    getsPassedPotato <- paste("->", agent.sub, sep="")
    out <- grepl(getsPassedPotato, transitions) * 1
  }
  out
}
hasPotatoAfter <- function(agent){
  out <- rep(0, length(transitions))
  if(grepl(".has", agent)){
    agent.sub <- strsplit(agent, ".has")[[1]][1]
    getsPassedPotato <- paste("->",agent.sub , sep="")
    out <- grepl(getsPassedPotato, transitions) * 1
  }
  out
}
hasNoPotatoAfter <- function(agent){
  out <- rep(0, length(transitions))
  if(grepl(".none", agent)){
    agent.sub <- strsplit(agent, ".none")[[1]][1]
    if(agent.sub == "D"){
      out <- grepl("D.eats", transitions)
    } else{
      gaveUpPotato <- paste(agent.sub, "->", sep="")
      out <- grepl(gaveUpPotato, transitions) * 1
    }
  }
  out
}
pre <- sapply(states, hasPotatoBefore) + sapply(states, hasNoPotatoBefore)
rownames(pre) <- transitions
post <- sapply(states, hasPotatoAfter) + sapply(states, hasNoPotatoAfter)
rownames(post) <- transitions
A <- post - pre
S <- t(A)
print(S)

library(igraph)
nullmatA <- matrix(0, nrow = nrow(S), ncol = nrow(S))
rownames(nullmatA) <- rownames(S)
colnames(nullmatA) <- rownames(S)
nullmatB <- matrix(0, nrow = ncol(S), ncol = ncol(S))
rownames(nullmatB) <- colnames(S)
colnames(nullmatB) <- colnames(S)
bipartite.mat <- rbind(cbind(nullmatA, t(pre)),
      cbind(post, nullmatB))
g <- graph.adjacency(bipartite.mat)
V(g)$type <- "place"
V(g)[V(g)$name == "D.eats"]$type <- "transition"
V(g)[grepl("->", V(g)$name)]$type <- "transition"
V(g)$shape <- "circle"
V(g)[V(g)$type == "transition"]$shape <- "square"
V(g)$label <- V(g)$name
V(g)[V(g)$type == "transition"]$label = ""
layout.matrix <- matrix(c(60, 124, 60, 26, 314, 196, 52, 138, 210, 315, 318, 417, 427, 360, 206, 124, 148, 38, 194, 402, 110, 288, 282, 420, 430, 49, 0, 230, 130, 24, 106, 380, 278, 394, 318, 246, 128, 315, 393, 40, 127, 208, 318, 326, 29, 408, 186, 409, 221, 410), ncol = 2)
plot.igraph(g, layout=layout.matrix, vertex.label.dist=-.67, edge.arrow.size=.4)

getMinimalPInvariants <- function(S){
  # Get the places corresponding to minimal p invariants of an incidence matrix
  # S is an incidence matrix with rows corresponding to places and columns to transitions
  # Returns a list where each element is a pInvariant containing an array of place names
  require(MASS, quietly = T)
  nullMat <- round(Null(S), 4)
  rownames(nullMat) <- rownames(S)
  invariants <- list()
  for(j in 1:ncol(nullMat)){
    pVec <- nullMat[, j]
    valCounts <- table(pVec)
    valCounts <- valCounts[valCounts != 1]
    valCounts <- valCounts[names(valCounts) != 0]
    for(i in 1:length(valCounts)){
      val <- valCounts[i]
      invariants <- c(invariants, list(names(pVec[pVec == names(val)])))
    }
  }
  lengths <- sapply(invariants, length)
  invariants <- invariants[order(lengths)]
  if(length(invariants) > 1){
    for(i in 1:(length(invariants) - 1)){
      for(j in (i+1):length(invariants)){
        invariants[[j]] <- setdiff(invariants[[j]], invariants[[i]])
      }
    }
  }
  invariants <- invariants[which(sapply(invariants, length) > 0)]
  invariants
}

#Here is what the list of p-invariants looks like.

pInvariants <- getMinimalPInvariants(S)

#Visualizing them back on the graph:


pVertex <- lapply(pInvariants, function(p){
  V(g)[V(g)$name %in% p]
  })
plot.igraph(g, layout=layout.matrix, vertex.label.dist=-.67, 
            edge.arrow.size=.4, mark.groups=pVertex)
            
#Assign p-invariants their names

names(pInvariants) <- unlist(lapply(pInvariants, function(p){
  gsub(".has", "", p[1])
}))
pInvariants


#Start making edges for signal flow diagram
edgeMat <- NULL
# Iterate through and draw edges between invariants where there are shared places.
edgeMat <- rbind(edgeMat, do.call("rbind", combn(pInvariants, 2, function(pair){
  if(length(intersect(pair[[1]], pair[[2]])) > 0){
    list(names(pair))
  } else {
    list(NULL)
  }
})))

#Add edges based on p-invariants connected via transitions and plot
#Connect p-invariants by transitions that link their members
edgelist <- get.edgelist(g)
pre.edges <- edgelist[1:(nrow(edgelist)/2), ] #the first half of edges are outgoing from states
pre.list <- split(pre.edges[,1], as.factor(pre.edges[, 2]))
post.edges <- edgelist[((nrow(edgelist)/2) + 1):nrow(edgelist), ]
post.list <- split(post.edges[, 2], as.factor(post.edges[, 1]))
edgeMat <- rbind(edgeMat, do.call("rbind", combn(pInvariants, 2, function(pair){
  paired <- FALSE
  for(transition in transitions){
    if(any(pair[[1]] %in% pre.list[[transition]]) && any(pair[[2]] %in% post.list[[transition]])){
      paired <- TRUE
      break
    } else if(any(pair[[1]] %in% post.list[[transition]]) && any(pair[[2]] %in% pre.list[[transition]])) {
      paired <- TRUE
      break
    }   
  }
  if(paired){
    return(list(names(pair)))
  }
  else{
    return(list(NULL))
  }
})))
plot.igraph(graph.edgelist(edgeMat), vertex.label.dist=-1.5, edge.arrow.size=.4)