(This article was first published on

**ProbaPerception**, and kindly contributed to R-bloggers)As you will certainly see later on this blog, I am extremely interested in neural networks. My reference book is “Networks, crowds and markets: reasoning about a highly connected world” by David Easley and Jon Kleinberg who are professors at Cornell University.

What is a network? A network is a representation of the interconnections between objects. Generally, we represent each object by a node and each connection by an edge. The most striking example of a network is the Facebook network where each node represents a person –a Facebook account- and each edge is a friendship between to account.

In this simple representation of a neural network, each node is represented by a person, each edge by a dashed line. |

But network has much more applications than analysis of your Facebook account, it may be applied in so many disciplines that we cannot even imagine all the possibilities of neural networks. Sport efficiency, foreign policy, risk theory, finance, game theory… All these fields can use very easily neural network to understand phenomena. This is why I love neural networks.

In this post I would like to present an idea developed in the chapter 4, part 5 of the book I mentioned earlier: “Networks, crowds and markets: reasoning about a highly connected world”. The idea is to explain the phenomenon of spatial segregation in a city. Some cities are well known for being split into neighborhoods where a predominant ethnicity is settled. We can take as an example the Chinatown in New York City or the black neighborhood in Chicago. How to explain such a spatial convergence of an ethnic group in a city? Some factors such as wealth have to be taken into account. However there is another way to explain such a spatial organization.

In order to have a clean model, we consider a city as an array of 150 time 150 cells. Each cell is an house where one person may live (some cells will be vacant). This house has 8 neighbors (north, north-east, east, south-east, south, south-west, west, north-west). The day one, each house is randomly assigned to either a person of the group A with a probability of 0.4, a person of the group B with a probability of 0.5 or remains vacant with a probability of 0.1. Then we assume that one person does not mind being with many people of the other group as long as there are at least three of his neighbors who are from the similar group than he is. If there are less than three neighbors from his group, he will try to move the next day to a vacant house respecting the condition of having three neighbors of the same group. Then we repeat this process many times to see what happens. In order to display this experience, we use the function matrixplot() from the library hydroTSM. This function is really convenient to “display” a matrix as a graph. The website gifmake allows you then to generate beautiful GIF animations.

This model uses a neural network approach since each cell is a node with eight edges (the neighbors). In the program, I do not use neural network approach because I have tried to do the simplest code as possible. However, the conception of the model is definitely a neural network way of thinking.

We represent the group A by green squares, the group B by red squares and the vacant houses by yellow cells. As we can see in the following graphs, step by step the city experienced the gathering of the two different groups. At the beginning, the households are scattered and then persons from the group A are steadily gathering with each other.

__The code (R):__#package installation

install.packages("hydroTSM")

library(hydroTSM)

#initialization

size = 200

q = matrix(0, nrow = size, ncol = size)

countMinus1 = matrix(0, nrow = size, ncol = size)

countPlus1 = matrix(0, nrow = size, ncol = size)

prob = runif(size*size)

for (i in 1:size){

for (j in 1:size){

if(prob[(i-1)*size + j]<0.4){ # row 1: column 1 to 200; then row 2: column 1 to 200; etc...

q[i,j] = -1 # 40% of type -1, randomly distributed.

}

if(prob[(i-1)*size + j]>0.5){

q[i,j] = 1 # 50% of type 1, randomly distributed.

} # 10 other % of type 0, randomly distributed.

}

}

#the recursive process

for (k in 1:50){ # 50 steps of population aggregation = 50 plots.

#the function file.path is really useful to save automatically many plots.

mypath <- file.path("C:","Users","PCordier","Documents","Blog","Post4","Plots", paste("myplot_", k, ".png", sep = ""))

png(file=mypath)

mytitle = paste("my title is", k)

print(matrixplot(q)) # At each step, saving of the precedent plot.

dev.off() # k=0: initial random q matrix, then matrix result of the followings.

for(i in 1:size){

for(j in 1:size){

value = q[i,j]

if(i==1){ # row 1

if(j==1){ # top left cell of the row 1 : one house with 3 neighbours

a = table(c(q[i+1,j], q[i,j+1], q[i+1, j+1])) # Number of 0, -1, 1 among the 3 surrounding houses (max = 3!).

if("-1" %in% names(a)){ # If there are some -1, there is a column with name -1.

countMinus1[i,j] = a[names(a)==-1]} # Number of -1 around the house of coordinates 1,1.

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){ # Same for number of 1 in the neighbourhood.

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else if(j==size){ # top right cell of the row 1 : one house with 3 neighbours

a = table(c(q[i+1,j], q[i,j-1], q[i+1, j-1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else{ # all top middle cells : 198 houses with 5 neighbours

a = table(c(q[i+1,j], q[i+1,j+1],q[i,j-1],q[i,j+1], q[i+1, j-1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

}

else if(i==size){ # last row

if(j==1){ # bottom left : one house with 3 neighbours

a = table(c(q[i-1,j], q[i,j+1], q[i-1, j+1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else if(j==size) # bottom right : one house with 3 neighbours

a = table(c(q[i-1,j], q[i,j-1], q[i-1, j-1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else{ # bottom center : 198 houses with 5 neighbours

a = table(c(q[i-1,j], q[i-1,j+1],q[i,j-1],q[i,j+1], q[i-1, j-1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

}

else{

if(j==1){ # center left : 198 houses with 5 neighbours

a = table(c(q[i-1,j], q[i+1,j], q[i-1,j+1],q[i,j+1],q[i+1,j+1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else if(j==size){ # center right : 198 houses with 5 neighbours

a = table(c(q[i-1,j], q[i+1,j], q[i-1,j-1],q[i,j-1],q[i+1,j-1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

else{ # center center : 39204 houses with 8 neighbours

a = table(c(q[i-1,j], q[i+1,j], q[i-1,j-1],q[i,j-1],q[i+1,j-1], q[i-1,j+1],q[i,j+1],q[i+1,j+1]))

if("-1" %in% names(a)){

countMinus1[i,j] = a[names(a)==-1]}

else{countMinus1[i,j] = 0}

if("1" %in% names(a)){

countPlus1[i,j] = a[names(a)==1]}

else{countPlus1[i,j]= 0}

}

}

}

}

listEmpty = which(q == 0)

listMissingMinus1 = which( countMinus1 < 4)

listMissingPlus1 = which( countPlus1 < 4)

listToMovePlus = which((countPlus1 < 4 & q == 1))

listToMoveMinus = which((countMinus1 < 4 & q == -1))

listOfPlacePlus = which((countPlus1 >=4 & q == 0))

listOfPlaceMinus = which((countMinus1 >= 4 & q == 0))

while (length(listToMovePlus)!=0 && length(listOfPlacePlus) != 0){

number = sample(1:length(listOfPlacePlus), 1)

number2 = sample(1:length(listToMovePlus), 1)

q[listToMovePlus[number2]] = 0

q[listOfPlacePlus[number]] = 1

listToMovePlus = listToMovePlus[-number2]

listOfPlacePlus = listOfPlacePlus[-number]

}

while (length(listToMoveMinus)!=0 && length(listOfPlaceMinus) != 0){

number = sample(1:length(listOfPlaceMinus), 1)

number2 = sample(1:length(listToMoveMinus), 1)

q[listToMoveMinus[number2]] = 0

q[listOfPlaceMinus[number]] = -1

listToMoveMinus = listToMoveMinus[-number2]

listOfPlaceMinus = listOfPlaceMinus[-number]

}

}

To

**leave a comment**for the author, please follow the link and comment on his blog:**ProbaPerception**.R-bloggers.com offers

**daily e-mail updates**about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...