I am trying to write a basic Cellular Automation Model to model social contamination. The code itself seems to work fine and so does the plotting of images. For any x and any y the values in [x,y,3] will either be "0", "0.5", "0.75" or "1". Using the "image"-function of R, I want to plot these values - a "0" should generate a White square, a "1" a Black square (and something grey inbetween).
This seems to work unless there are (because of social contamination) only one or two values for [x,y,3] in the whole array. Then, the color palette breaks down.
For example, if [x,y,3] always takes the value "1" for all 2500 instances, I get a grey image although I wanted "1" to be black. In the case you see below, all entries for [x,y,3] are either 0.75 or 1 - but I can only see White and Black The computation seems to work (I checked the entries) but I just don't get the color palette to be the same for all outputs. What am I doing wrong?
n = 50 #size of matrix
z = 3
mar <- array (0, dim = c(n, n, z)) # creating an array of 20*20 fields with 3 values each
mar[,,1:2] <- sample(c(0,1), size = n*n*2, replace = TRUE) # some random fields are getting changed to 1.
# However, according to DBO, an action only comes to happen, if D and B equal 1. Therefore the third component of each tuple should be replaced according to the DBO-logic.
for (i in 1:n) {
for (j in 1:n) {
if (mar[i,j, 1] == 1 & mar[i,j,2] == 1) {mar[i,j,3] <- 1}
else if (mar[i,j, 1] == 0 & mar[i, j, 2] == 1) {mar[i, j, 3] <- 0.75}
else if (mar[i,j, 1] == 1 & mar[i, j, 2] == 0) {mar[i, j, 3] <- 0.5}
else {mar[i,j,3] <- 0}
}
}
# Set up color palette
col_palette <- gray.colors(3, start = 0, end =1)
# Plot the image
png("50x50_initial.png")
image(1:n, 1:n, mar[, , 3], col = col_palette, axes = TRUE, xlab = "", ylab = "")
dev.off()
# Calculating with a temporary copy of the original array
marr1 <- mar
temp_marr1 <- marr1
marr2 <- mar
temp_marr2 <- marr2
for (k in 1:10) { #for two times
for (i in 1:n) { #for every row
for (j in 1:n) { #and every column
# Specification of the matrix boundaries
E = j+1; W = j-1; N = i-1; S = i+1
# The boundaries are supposed to be hard. Numbers over n or below 0 are therefore inacceptable
if (E==n+1) {E = 1}
if (W == 0) {W = n}
if (N==0) {N =n}
if (S==n+1) {S =1}
# Next, we simply sum up the values that are in the Moore neighborhood. We assume
# that any individual reassesses his wishes and desires, if the majority of his
# neighbors have different wishes and desires.
# Step 1: counting cells with "desire" = 1.
des_alive = marr1[S,j,1] + marr1 [S,W,1] + marr1 [i, W, 1] +
marr1 [N, W, 1] + marr1 [N, j, 1] + marr1 [N, E, 1] +
marr1 [i, E, 1] + marr1 [S, E,1]
# Step 2: counting cells with "belief" = 1.
bel_alive = marr1[S,j,2] + marr1 [S,W,2] + marr1 [i, W, 2] +
marr1 [N, W, 2] + marr1 [N, j, 2] + marr1 [N, E, 2] +
marr1 [i, E, 2] + marr1 [S, E,2]
# the desire-entry will change, if the majority of neighbors has different desires
if (temp_marr1[i, j, 1] == 1 && des_alive < 4) {temp_marr1[i,j,1]=0}
else if (temp_marr1[i, j, 1] == 0 && des_alive > 4) {temp_marr1[i,j,1]=1}
# the belief-entry will change, if the majority of neighbors has different beliefs
if (temp_marr1[i, j, 2] == 1 && bel_alive < 2) {temp_marr1[i,j,2]=0}
else if (temp_marr1[i, j, 2] == 0 && bel_alive > 2) {temp_marr1[i,j,2]=1}
# Final question: Does the person act? This happens iff corresponding beliefs and desires exist
if (temp_marr1[i,j,1] == 1 && temp_marr1[i,j,2] == 1) {temp_marr1[i, j, 3] = 1}
else if (temp_marr1[i,j, 1] == 0 & temp_marr1[i, j, 2] == 1) {temp_marr1[i, j, 3] <- 0.75}
else if (temp_marr1[i,j, 1] == 1 & temp_marr1[i, j, 2] == 0) {temp_marr1[i, j, 3] <- 0.5}
else {temp_marr1[i,j,3] <- 0}
}
}
# Updating the corresponding matrix
marr1 <- temp_marr1
}
png("50x50_after10_cutoff2a4.png")
image(1:n, 1:n, marr1[, , 3], col = col_palette, axes = TRUE, xlab = "", ylab = "")
dev.off()
Usually, it works, as can be seen here
But here all antries get either 1 or 0.75 and the color palette breaks down
The code provided above should probably generate a distribution that leads to entries only taking values for [x,y,3] of 0.75 and 1. Changing the values of "bel_alive" like this (using "4" instead of "2") should generate a distribution similar to the first picture.
if (temp_marr1[i, j, 2] == 1 && bel_alive < 4) {temp_marr1[i,j,2]=0} else if (temp_marr1[i, j, 2] == 0 && bel_alive > 4) {temp_marr1[i,j,2]=1}
