Bonjour,
Je réalise actuellement une simulation simple via un automaton cellulaire. Le scénario est le suivant:
Chaque cellule représente une parcelle de terrain qui peut avoir trois états: abandon (A), appartenant à un individu prive (P) ou appartenant a une compagnie (C)
A l’année 1 le cellular automaton se compose d’une cellule C (par simplification une seule compagnie est présente dans le scénario) le reste des cellules étant a l’état P.
Chaque année un nombre aléatoire de cellules P deviennent A . La compagnie achète alors les terrains connexes devenant libre. Lors de l’achat d’un terrain son budget décroit de 10. Lorsque le nombre total de cellule connexe est supérieur à 3, chaque le terrain commence à générer des bénéfices. Ces bénéfices sont injectés au budget restant. Lorsque le budget est égal à 0, le processus d’expansion de la compagnie s’achève.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26 # This simulation is for a concentrated budget and a development around the original seed library("deSolve") library("lattice") library("simecol") # constants private <- 0 # cell state = 0 means private available <- 1 # cell state = 1 means available cells_earn <- 4 # earning of each cells at each period t land_cost <- 10 # unit cost of land company <- 2 budget <- 150 # initial money you have to buy land wdist <- matrix(c(0,1,0,1,0,1,0,1,0),3,3) critical_size <- 3 # number of cells needed to reach critical size, passed three cells connected the parcel start to earn money # starting population m <- 10 # nbr of rows n <- 10 # nbr of cols x <- rep(0, m*n) # cells dim(x) <- c(m,n) # m rows n cols # company land is in the middle x[floor((m+1)/2),floor((n+1)/2)] <- company image(x, col=c("white","green"))
La simulation fonctionne lorsque l’on suppose que la compagnie acquiert uniquement les cellules connexes aux cellules déjà acquises (cellules C) . Le processus d’expansion se forme donc uniquement autour de la cellule C originale.
Je souhaite compliquer un peu la situation via cette nouvelle règle : chaque nouvelle année, la compagnie achète d’abord les terres disponibles connexes, puis se rabat sur les autres terres disponibles. Le problème étant désormais le calcul des bénéfices. En effet, lors de la précédant simulation, le calcul était particulièrement aisé via la fonction company_area (company_area <- sum(x==company) ).
Désormais, la situation est plus complexe car de nombreuses parcelles de terrain indépendantes se forment. Je dois donc désormais dissocier le bénéfice de chaque parcelle non connexe pour calculer le bénéfice total. Une parcelle de moins de 4 cellules ne dégageant pas de bénéfice.
Voici mon code complet pour le senario 1 (développement autour de la cellule C original ):
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57 # This simulation is for a concentrated budget and a development around the original seed library("deSolve") library("lattice") library("simecol") # constants private <- 0 # cell state = 0 means private available <- 1 # cell state = 1 means available cells_earn <- 4 # earning of each cells at each period t land_cost <- 10 # unit cost of land company <- 2 budget <- 150 # initial money you have to buy land wdist <- matrix(c(0,1,0,1,0,1,0,1,0),3,3) critical_size <- 3 # number of cells needed to reach critical size, passed three cells connected the parcel start to earn money # starting population m <- 10 # nbr of rows n <- 10 # nbr of cols x <- rep(0, m*n) # cells dim(x) <- c(m,n) # m rows n cols # company land is in the middle x[floor((m+1)/2),floor((n+1)/2)] <- company # image(x, col=c("white","green")) span <- 10 # time span in periods p_avail <- 1/10 # probability of land becoming available company_area <- sum(x==company) # initial company area newly_owned <- function(t){ # newly owned area in year t company_area[[t]] - company_area[[t-1]]} earning <- function(t){ # earning in year t ifelse(critical_size < company_area[[t]], cells_earn*(company_area[[t-1]] - critical_size),0)} revenue <- 0 # for t=1 net_earned <- 0 # for t=1 for(t in 2:span){ # some cells become available r01 <- ifelse(x == private, matrix((runif(x,0,1)),nrow=m,ncol=n), x) x <- ifelse(r01 <= p_avail, available, x) # buy available lands around the company land x <- ifelse( 1 == neighbors(x,state=company,wdist=wdist) & x==available, company, x) company_area[[t]] <- sum(x==company) revenue[[t]] <- earning(t) expansion_cost <- newly_owned(t)*land_cost # the cost of buying new land net_earned[[t]] <- revenue[[t]] - expansion_cost budget[[t]] <- budget[[t-1]] + net_earned[[t]] if (budget[[t]]<=0) break # white = private owned land, blue = available, green = company image(x, col=c("white","blue","green")) }
Je souhaiterais donc savoir si vous connaissiez une méthode me permettant de calculer le nombre de cellules connexes pour chaque parcelle de terrain appartenant à la compagnie.
Merci
Partager