Evolutive Two-Way Network Formation

Evolutive Two-Way Network Formation preview image

1 collaborator

405882_233671050046915_140531416027546_540772_1171351483_n Juan MC Larrosa (Author)

Tags

evolutive algorithm 

Tagged by Juan MC Larrosa almost 8 years ago

game theory 

Tagged by Juan MC Larrosa almost 8 years ago

graphing 

Tagged by Juan MC Larrosa almost 8 years ago

networks 

Tagged by Juan MC Larrosa almost 8 years ago

Visible to everyone | Changeable by everyone
Model was written in NetLogo 5.0.1 • Viewed 889 times • Downloaded 44 times • Run 0 times
Download the 'Evolutive Two-Way Network Formation' modelDownload this modelEmbed this model

Do you have questions or comments about this model? Ask them here! (You'll first need to log in.)


WHAT IS IT?

NFGA (Network Formation Games with Accumulative-Costs) is a model designed to study the effects of accumulative costs in network formation games. The main assumption is that agents simultaneously choose who to connect with first and when agents connect to each others they have to pay no only for the directed but also for undirected connections.

This model is based on network formation games among firms in oligopolic markets. Firms essays on each round a connection with other firms. This is a two-way (non-directed) network.

QUICK GUIDE

You should try to prove different configurations of link-costs and information costs.
Other modifications include mutation rate (usually greater than 0.01 gives trembling results), change the slide of the number of generations (for observing convergence in the algorithm), selection procedure (elitism selects best genomes, roulette selects random genomes).

HOW IT WORKS

Social network

Agents can be connected, forming a social network. Thus, each node may link to none, one, or several nodes; this (potentially empty) set of neighbours defines the node's social neighbourhood.

The model tries to replicates theoretical results according to Goyal and Joshi (2002) but using an evolutive algorithm that takes samples of the network and then by mating and recombining, mutating and rebirth new populations evolve to achieved an optimal network architecture.

HOW TO USE IT

First, press SETUP button and the GO button. You will see how the genetic algorithm works by randomly selecting an adjacency matrix that represent links between agents. Structure will evolve by agents modifying in their decisions of connecting people. The importance is to play atention to the final topology that emerges in the last periods of the simulation. These would be the evolving outcomes of these connection games.

THINGS TO TRY

Try by modifying, first of all, the values of value-of-info and link-cost. If you know a little bit of genetic algorithm, try by selecting Elitism and Roulette Wheel in selection of mating peers.

CREDITS

Juan M.C. Larrosa, Master Thesis in Scientific Computing, Universidad Nacional del Sur, 2006
Ignacio Ponzoni, Thesis Director, Universidad Nacional del Sur
Fernando Tohm_, Thesis Co-Director, Universidad Nacional del Sur.

REFERENCES

Goyal, S and S Joshi (2002). "Networks of Collaboration in Oligopolies". http://merlin.fae.ua.es/fvega/Course/Art%EDculos%20del%20curso/Goyal-Joshi.pdf

Wilensky U (1999) NetLogo. Center for Connected Learning and Computer-Based Modeling, Northwestern University, Evanston, IL.

Comments and Questions

Please start the discussion about this model! (You'll first need to log in.)

Click to Run Model

;;;;;;;;;;;;
;; This is the case for undirected graphs, genome is created by strictly upper triangular matrixes;;
;;;;;;;;;;;;

;;;;;;;;;;;;
;; Breeds ;;
;;;;;;;;;;;;

  ;; nodes and edges between nodes, are all turtles
  ;; edges are not necessarily symmetric
breed [ nodes node ]
breed [ edges edge ]


;;;;;;;;;;;;;;;
;; Variables ;;
;;;;;;;;;;;;;;;

globals [
   
  clock
  list-of-nodes   ;; nodes ordered by reservation price
  nodes-in-round  ;; nodes who have bought a product in the session
  avg-information-value
  nodos-accesibles
               
    ;; average number of nodes reachable by each buyer
    ;; in an infinite number of steps
  avg-accessibility
  
    ;; variable for drag-and-drop procedure
  clicked-node      ;; buyer who was clicked on
  path
  my-random-seed
  basic-genome 
  topology
  strict-upper-triang
  topology-random
  sum-fitness
  ranking
  empty-topology
  complete-topology
  density
  sum-links 
   
    ;; genetic algorithm variables
  generation
         
        edge-cost
         fitlist
         edgelist
         best-fitness
         avg-fitness
         avg-dir
         avg-ind
         max-profits
         profits
         net-indirect-benefit
         net-direct-benefit
         global-fitness
         seed-genomes
         mix-genes
         chosen-size
         genome-size
         best-genome
         adjacency-matrix     
         ;indirect-info
         transitive-matrix
         
          genome-list 
          topology-list

          random-wife1
          random-wife2
          random-husband1
          random-husband2
          winner-list
 ]

nodes-own [
    ;; stores the list of nodes that this particular buyer edges to
  edgeees
    ;; these variables are used to do the layout
  force-x
  force-y
         genome           
           fitness
           own-information
           direct-information
           indirect-info
           indirect-information
           direct-edgeing-costs
           indirect-edgeing-costs
                     
            origin
            destination  
          ]

  ;; The direction of the edge does matter in this model.
edges-own [
        origin 
        destination
         ]

;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Nodes Procedures ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; accessibility is the number of social neighbours that the node could reach in a 
  ;; number of steps equal to "num-steps". For instance, if buyer A edges only to buyer B, 
  ;; who edges only to buyer C, who has no social neighbours, then A's accessibility 
  ;; in one step is 1, and in two steps is 2; B's accessibility in any number of steps is 1, 
  ;; and C's accessibility in any number of steps is 0.
  ;; This is what I need for counting accumulative edgeing costs!!

to-report accessibility [num-steps]
  set nodos-accesibles []
  let step 1
  let reachable-nodes edgeees
  let old-length 0
  let new-length length reachable-nodes
  while [ new-length != old-length and step < num-steps]
        [ set old-length new-length
          set reachable-nodes 
            remove-duplicates sentence 
              reachable-nodes 
              reduce [sentence ?1 ?2] map [ [edgeees] of ?] reachable-nodes 
          set new-length (length reachable-nodes)
          set nodos-accesibles fput reachable-nodes nodos-accesibles
          set step (step + 1)
        ]
        
  set path new-length - ifelse-value (member? self reachable-nodes) [1] [0]
  report path
end 

to-report accessibility-by-node [tag-node num-steps]
  let step 1
  let node-zero node tag-node
  let reachable-nodes [edgeees] of node-zero
  let old-length 0
  let new-length length reachable-nodes
  while [ new-length != old-length and step < num-steps]
        [ set old-length new-length
          set reachable-nodes 
            remove-duplicates sentence 
              reachable-nodes 
              reduce [sentence ?1 ?2] map [ [edgeees] of node ?] reachable-nodes 
          set new-length (length reachable-nodes)
          set step (step + 1)
        ]        
  set path new-length - ifelse-value (member? self reachable-nodes) [1] [0]
  report path
end 


;;;;;;;;;;;;;;;;;;;;;;;;
;;; Setup Procedures ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;

to startup
  
  ask patches [set pcolor white - .15]
end 

to setup
  ;; (for this model to work with NetLogo's new plotting features,
  ;; __clear-all-and-reset-ticks should be replaced with clear-all at
  ;; the beginning of your setup procedure and reset-ticks at the end
  ;; of the procedure.)
  __clear-all-and-reset-ticks 
;  random-seed random-normal 4 1
  set topology-list []
  set density 0
  ct
  ask patches [set pcolor black - .15]
  set-default-shape edges "line"  
  set avg-fitness 0
  set best-fitness 0
  repeat generations * .02 [ 
  create-initial-genetic-info
  sort-global-fitness
  build-ga-network item 0 topology-list
  set best-fitness item compute-factorial num-nodes item 0 topology-list
  plot-density
  ]
end 

to make-nodes
  set-default-shape nodes "circle"
 let colornode 0
;; create nodes and provide them with initial endowment of information
  create-ordered-nodes num-nodes [
    set size .6
     if B&W [
    set color colornode ]
    
    if information-endowment = "deterministic"
      [set own-information value-of-info]
    if information-endowment = "random"  
      [set own-information random-normal value-of-info 1]
    set edgeees []  ;; empty list
      ;; nodes are automatically created with evenly spaced headings,
      ;; so if they just move forward they will form a circle
    fd max-pxcor - 2
    if colornode > 9 [set colornode 0]
    set colornode colornode + .5
     ]
  if information-endowment = "heterogeneous"  
 [   
      
       let lista-valores (list 1 2 3 4 5 6 7 8 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) 
       ask nodes [set own-information item who lista-valores
        set label (word own-information "c " )
        set label-color black
        set plabel-color red] 
  ]   
end 

to create-initial-genetic-info
  ct
  set fitlist []

  make-nodes
  create-genome

  warshall ;; aca se forman adjacency y transitive
  indirect-information-matrix
  update-transitive-matrix
  
  calculate-profits  
;  show (word basic-genome  " bg")   
    let genome-reduction (list reduce [sentence ?1 ?2] basic-genome)
    set genome-reduction reduce [sentence ?1 ?2] genome-reduction 
    set genome-reduction fput genome-reduction fitlist
    let incoming reduce [sentence ?1 ?2] genome-reduction
    ;;show incoming    
    set topology-list lput incoming topology-list 
end  

to create-genetic-info
  ct

  set genome-list []
  set fitlist []
  make-nodes
  theory-driven
  update-genome ;; here is where seed-genomes become nodes' genome again
  warshall
  indirect-information-matrix
  update-transitive-matrix
  
  calculate-profits  
;  show (word seed-genomes  " sg")
  let genome-reduction (list reduce [sentence ?1 ?2] seed-genomes)
  set genome-reduction reduce [sentence ?1 ?2] seed-genomes

  set genome-reduction fput seed-genomes fitlist
  let incoming reduce [sentence ?1 ?2] genome-reduction
  set topology-list lput incoming topology-list
end  

;;;;;;;;;;;;;;;;;;;;;;
;;; Main Procedure ;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;

to go

    set generation (generation + 1)
    if (generation > generations ) [export stop]
    
    do-best-of-age-plot
    plot-density
    mate-recombine
    mutate
    rebirth
end 
 
 
  
;;;;;;;;;;;;;;;;;;;;;;;
;;; edge Operations ;;;
;;;;;;;;;;;;;;;;;;;;;;;

to build-ga-network [adjacency]
 ;; Nodes randomly are provided with their connection's structure. This is a node procedure.
no-display
;show adjacency 
ask nodes [set genome n-values num-nodes [0]]
 ;; Ahora, copia esos datos y se lo inserta en los genomas de los nodos respectivos (la diagonal principal nunca es usada)
 let y 0
 let f 0
  while [y < (num-nodes - 1)] ;; recorro todos los nodos menos el _ltimo
   [let g y + 1
    while [g < num-nodes] ;; de cada nodo, tengo que llegar al final del genome
     [ask node y [set genome replace-item g genome item f adjacency] 
      set g g + 1
      set f f + 1] 
      set y y + 1
     ]


     
;; se completa la diagonal inferior para todos los nodos, simetrica a la superior
let i 0
let j 0

   while [i < num-nodes ][set j 0
     while [j < num-nodes ][
      if (item j [genome] of node i = 1)
        [ask node j [set genome replace-item i genome 1]
         ]
      set j j + 1]
   set i i + 1]


; let a 0
;while [a < num-nodes]
;   [ask node a [show genome]
;    set a a + 1 ]
    

  set j 0
  set i 0  ;; agregu_ un contador i porque me parece que cuenta a cada nodo su conexi_n pero no recorre todos los nodos.
  
  while [i < num-nodes ]
          [set j 0
           while [j < num-nodes ]
           [if (item j [genome] of node i = 1)
               [make-edge node i node j ]
          set j j + 1]
      set i i + 1
    ]
  plot-accessibility
display
end 

to calculate-profits
;; Nodes procedure 
ask nodes [
 set direct-edgeing-costs 0
 set direct-information own-information
 set indirect-information 0
 set indirect-edgeing-costs 0
 set net-direct-benefit 0
 set net-indirect-benefit 0
 set profits 0
 set edge-cost own-information / ratio-info-edge 
 set genome (replace-item who genome 0)]
;; iterate over the nodes and ask them for their "direct" costs and information benefits
  
let j 0
let k 0
  while [j < num-nodes]
   [set k 0
    while [k < num-nodes]
      [ask node j [if (item k genome = 1)
                   [ifelse decay [set direct-information direct-information + (rate-of-decay * [own-information] of node k)]
                                 [set direct-information direct-information + [own-information] of node k] 
                    set direct-edgeing-costs direct-edgeing-costs + (edge-cost / 2) ]]
             set k k + 1]
     set j j + 1] 
             
set j 0

  while [j < num-nodes]
   [set k 0
    while [k < num-nodes]
     [ask node j [ifelse (item k indirect-info > 0)
                 [ifelse decay [set indirect-information indirect-information + ([direct-information] of node k * (rate-of-decay ^ item k indirect-info))]
                               [set indirect-information indirect-information + [direct-information] of node k] 
                  set indirect-edgeing-costs indirect-edgeing-costs + (item k indirect-info * ( edge-cost / 2 ))]
                  [set indirect-information indirect-information 
                   set indirect-edgeing-costs indirect-edgeing-costs]]       
        set k k + 1]
     set j j + 1]

ask nodes [
      if edge-Cost-Structure = "direct cost direct info"
        [set indirect-information 0  set indirect-edgeing-costs 0]
      if edge-Cost-Structure = "direct cost indirect info"
        [set indirect-edgeing-costs 0]
      if edge-Cost-Structure = "indirect cost direct info"
        [set indirect-information 0]
      if edge-Cost-Structure = "indirect cost indirect info"
        []
  ]  
     

      
 ;; viene del primer ask nodes
;; obtain now the total costs of individuals

 set net-direct-benefit sum [direct-information] of nodes - sum [direct-edgeing-costs] of nodes
 set net-indirect-benefit sum [indirect-information] of nodes - sum [indirect-edgeing-costs] of nodes 
 set profits precision (net-indirect-benefit + net-direct-benefit) 3

 set avg-ind smoothness * avg-ind + (1 - smoothness) * net-indirect-benefit  
 set avg-dir smoothness * avg-dir + (1 - smoothness) * net-direct-benefit 

 let max-links num-nodes * (num-nodes - 1) 
 set density sum-links / max-links

 set fitlist lput profits fitlist
 
 plot-direct-profits
 plot-indirect-profits 
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; edge procedures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; The algorithm for the following procedure has been borrowed from the 
;; model "Giant Component", in the "Models library".
;; The copyright for this procedure is included at the bottom of this file

  ;; makes a edge from edgeer to edgeee

to make-edge [edgeer edgeee]
  if member? edgeee [edgeees] of edgeer
  [
    user-message (word "There is already a edge from " edgeer " to " edgeee)
    stop
  ]
  create-edges 1
  [
    set origin edgeer
    set destination edgeee
    if show-network-evolution [
    set color [color] of edgeer
    reposition-edge]
    ;set direct-edgeing-costs direct-edgeing-costs + edge-cost
  ]
  
  
    ;; add edgeee to the edgeer's list of edgeees
;  set [edgeees] of edgeer fput edgeee [edgeees] of edgeer
  ask edgeer [ set edgeees fput edgeee edgeees ]
end 

to delete-edge [edgeer edgeee]
  ifelse (member? edgeee [edgeees] of edgeer)
  [
    ask edges [die]
  ]
  [
    user-message (word "There is no edge from " edgeer " to " edgeee)
    stop
  ]
  
  create-edges 1
  [
    set origin edgeer
    set destination edgeee
    if show-network-evolution [
    set color [color] of edgeer
    reposition-edge]
  ]
    ;; add edgeee to the edgeer's list of edgeees
;  set [edgeees] of edgeer fput edgeee [edgeees] of edgeer
  ask edgeer [ set edgeees fput edgeee edgeees ]
end 


;; The algorithm for the following procedure has been borrowed from the 
;; model "Giant Component", in the "Models library".
;; The copyright for this procedure is included at the bottom of this file

  ;; repositions and resizes the edge according to the position of the
  ;; nodes

to reposition-edge  ;; edge procedure
  setxy ([xcor] of origin) ([ycor] of origin)
  set size distance-nowrap destination
    ;; watch out for special case where origin and destination are
    ;; at the same place
  if size != 0
  [
      ;; position edge at midpoint between origin and destination
    set heading towards-nowrap destination
    jump size / 2
  ]
end 

;;;;;;;;;;;;;;;;
;;; Plotting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;

to plot-accessibility
  let steps accessibility-steps
  let accessibility-by-node-list []

    if accessibility-steps = "Infinity" [set steps num-nodes]

  ;; you cannot sort agents because that creates a list that is not processable as is. 
  let accessibility-list [accessibility steps] of nodes 
  

  let max-accessibility max accessibility-list
  set-current-plot "Accessibility Distribution"
  set-plot-x-range 0 (max-accessibility + 1)  ;; + 1 to make room for the width of the last bar
  histogram accessibility-list
  
 ;set accessibility-by-node-list values-from nodes [accessibility-by-node i steps]
end 

to plot-direct-profits
  auto-plot-on
  set-current-plot "Direct Benefits"
  set-current-plot-pen "net-direct-benefits"  
  plot net-direct-benefit
  set-current-plot-pen "avg-dir"  
  plot avg-dir
end 

to plot-indirect-profits
auto-plot-on

  set-current-plot "Indirect Benefits"
  set-current-plot-pen "net-indirect-benefits"  
  plot net-indirect-benefit
  set-current-plot-pen "avg-ind"  
  plot avg-ind
end  

to do-best-of-age-plot
    set-current-plot "Best-Average-Profit"
    set-current-plot-pen "Moving-Average"
    plot avg-fitness
    set-current-plot-pen "Best"
    plot best-fitness     
end 

to plot-density
auto-plot-on
  set-current-plot "Network Density"
  set-current-plot-pen "density"  
  plot density
end  
;;;;;;;;;;;;;;
;;; Layout ;;;
;;;;;;;;;;;;;;

;; The algorithm for the following procedure has been borrowed from the 
;; model "Giant Component", in the "Models library".
;; The copyright for this procedure is included at the bottom of this file

to layout
  no-display
    ;; these values are arbitrarily chosen to give a good layout
    ;; for typical model settings
  let spring-constant 0.2
  let natural-length 9.0
  let repulsion-constant 1.0

    ;; reset force-x and force-y
  ask nodes
  [
    set force-x 0
    set force-y 0
  ]

    ;; add the forces due to the springs
  without-interruption     ;; process edges one at a time, not concurrently
  [
    ask edges
    [
      let spring-force (spring-constant * (size - natural-length))
        ;; take care of zero sized spring
      ifelse size = 0
      [
        set spring-force spring-constant * natural-length

          ;; we know force but dont know the direction in which to apply it
          ;; make an arbitrary choice of direction ( postive and negative x direction)
        ask origin
        [set force-x force-x + spring-force]
        ask destination
        [set force-x force-x - spring-force]
      ]
      [
        ask origin
        [
          set force-x force-x + spring-force * sin towards-nowrap [destination] of myself
          set force-y force-y + spring-force * cos towards-nowrap [destination] of myself
        ]
        ask destination
        [
          set force-x force-x + spring-force * sin towards-nowrap [origin] of myself
          set force-y force-y + spring-force * cos towards-nowrap [origin] of myself
        ]
      ]
    ]
  ]

    ;; add a force of repulsion between nodes,
    ;; inversely proportional to square of distance
  without-interruption    ;; process nodes one at a time, not concurrently
  [
      ;; exempt edgeless nodes from the force
    let connected-nodes nodes with [not empty? edgeees]
    ask connected-nodes
    [
      ask connected-nodes with [self != myself]
      [
        let angle 0
        let force 0
        ifelse xcor = [xcor] of myself and ycor = [ycor] of myself
          ;; the two nodes are exactly on top of each other.  theoretically
          ;; this shouldn't occur, but in practice, it might because the world
          ;; is bounded and nodes can get forced into the corners.  not clear
          ;; how to handle this, so just apply a small arbitrary force in a
          ;; random direction.
        [
          set angle random-float 360    ;; arbitrary
          set force repulsion-constant  ;; arbitrary
        ]
          ;; normal case where nodes aren't on top of each other
        [
          set angle towards-nowrap myself
          set force repulsion-constant / ((distance-nowrap myself) ^ 2)
        ]
        set force-x force-x - force * sin angle
        set force-y force-y - force * cos angle
      ]
    ]
  ]

    ;; actually move the nodes
  ask nodes
  [
      ;; the current layout scheme has an issue where
      ;; sometimes heavily connected nodes are thrown back and forth.
      ;; to prevent that we cap the movement of nodes
    ifelse force-x > 1
    [ set force-x 1 ]
    [
      if force-x < -1
      [set force-x -1]
    ]
    ifelse force-y > 1
    [ set force-y 1 ]
    [
      if force-y < -1
      [set force-y -1]
    ]
    move (xcor + force-x) (ycor + force-y)
  ]
    ;; reposition all the edges
  ask edges [ reposition-edge ]
    ;; update the display, for smooth animation
  display
end 

  ;; move, but take care not to wrap around edge of world

to move [x y]  ;; buyer procedure
  ifelse x > max-pxcor
    [ set x max-pxcor ]
    [ if x < min-pxcor
      [ set x min-pxcor ] ]
  ifelse y > max-pycor
    [ set y max-pycor ]
    [ if y < (min-pycor + 1)
      [ set y (min-pycor + 1) ] ]
  setxy x y
end 

to drag-and-drop-nodes
    ifelse mouse-down? 
    [ ifelse is-agent? clicked-node 
        [ ask clicked-node [ setxy mouse-xcor mouse-ycor ] ]
        [   ;; no buyer had been clicked
            ;; if there are nodes at the current mouse location, then pick one
          if any? nodes-at mouse-xcor mouse-ycor [  
            set clicked-node one-of nodes-at mouse-xcor mouse-ycor
          ]
        ]
      ask edges [ reposition-edge ] 
    ]
    [   ;; mouse not down
      set clicked-node nobody
    ]    
end 

;; The algorithm for the following procedure has been borrowed from the 
;; model "Preferential Attachment", in the "Models library".
;; The copyright for this procedure is included at the bottom of this file

  ;; resize-nodes, change back and forth from size based on degree to a size of 1

to resize-nodes
  ifelse ( not (any? nodes with [size > 1]) )
  [ ask nodes [ set size sqrt length edgeees] ]
  [ ask nodes [ set size 1 ] ]
end 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Genetic Algorithms Procedures ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to-report compute-factorial [x]
let n 1
let factorial 0
 repeat (x - 1)
  [set factorial factorial + n
   set n n + 1
   ]
 report factorial
end                                                                                                                                                                                                    

to create-genome

;; here is where I must create a random binary string for each node and it must have a zero in 
;; position corresponding to the node because there's no loop condition (no self-connection).
 
 ask nodes [
 set genome []
 set genome n-values num-nodes [0]]
 
 ;; crea el genoma basico de grafo no dirigido (matriz triangular superior)
 set basic-genome []
 set basic-genome n-values compute-factorial num-nodes  [random 2]
 
 ;; Ahora, copia esos datos y se lo inserta en los genomas de los nodos respectivos (la diagonal principal nunca es usada)
 let y 0
 let g 1
  while [y < (num-nodes - 1)] ;; recorro todos los nodos menos el _ltimo
   [set g y + 1
    while [g < num-nodes] ;; de cada nodo, tengo que llegar al final del genome
     [ask node y [set genome replace-item g genome item y basic-genome] 
      set g g + 1
      ] 
      set y y + 1
     ]
     
;; se completa la diagonal inferior para todos los nodos, simetrica a la superior
let i 0
let j 0

   while [i < num-nodes ][set j 0
     while [j < num-nodes ][
      if [item j genome] of node i = 1
        [ask node j [set genome replace-item i genome 1]
         ]
      set j j + 1]
   set i i + 1]

;show basic-genome
;let a 0
;while [a < num-nodes]
;   [ask node a [show genome]
;    set a a + 1 ]
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to warshall 
set sum-links 0
;; It creates the reachability-matrix by adding individual's node genome
 set adjacency-matrix []
 set transitive-matrix []

;; this is the adjancency matrix
 let p 0
    while [p < num-nodes]
     [set adjacency-matrix lput [genome] of node p adjacency-matrix 
      set sum-links sum-links + sum [genome] of node p
      set p p + 1]
   
;diag-zero adjacency-matrix      

 ;;; Warshall's algorithm
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 let i 0
 let j 0
 let k 0

;; Get a copy of the transitive closure matrix
set transitive-matrix adjacency-matrix 
let track 1
 while [i < num-nodes] 
    [ set j 0
     while [j < num-nodes]
      [if (item j item i transitive-matrix = 1)
        [set k 0 set track 1
         while [k < num-nodes]
          [ if (item j item k transitive-matrix = 1)
           [set transitive-matrix (replace-item i transitive-matrix (
            replace-item k (item i transitive-matrix) track ))]
            set track track + 1
           set k k + 1]]
       set j j + 1]
    set i i + 1]
;show (word transitive-matrix "a")
;; Finally we got the transitive closure matrix for the original adjacency-matrix 
end 

to indirect-information-matrix

let prev-indirect-info n-values num-nodes [n-values num-nodes [0]] ;; a matrix of num-nodes of zeroes is created
ask nodes [set indirect-info []]
  let r 0
  let s 0

while [r < num-nodes]
   [set s 0
    while [s < num-nodes]
        [ 
         set prev-indirect-info (replace-item r prev-indirect-info
                    (replace-item s (item r prev-indirect-info) 
                    (item s item r transitive-matrix - item s item r adjacency-matrix))) ;; acabo de agregar valor absoluto
         set s s + 1]
        set r r + 1]

let i 0
 while [i < num-nodes]
       [ ask node i [set indirect-info item i prev-indirect-info]
          set i i + 1 ]       
end 

to update-transitive-matrix
;; Back transformation, return reachability-matrix to reachability-matrix in the original
;; format of genome 
set transitive-matrix []
let p 0
    while [p < num-nodes]
     [
       set transitive-matrix lput [indirect-info] of node p transitive-matrix  
       set p p + 1
     ]

;show (word transitive-matrix "b")
end 

to sort-global-fitness
set topology-list remove-duplicates topology-list
set topology-list sort-by [ item compute-factorial num-nodes ?1 > item compute-factorial num-nodes ?2] topology-list
end 

to mate-recombine

;let scd compute-factorial num-nodes / 2

set best-fitness item compute-factorial num-nodes item 0 topology-list 
set avg-fitness smoothness * avg-fitness + (1 - smoothness) * best-fitness 

;; Ac_ tengo que elegir entre cual configuraci_n, provista por genome, me da mayor pago, provista por fitness, y seleccionar la mejor. 
;; tengo entonces que ver como formo la matriz de adyacencia de la que deriva la formaci_n original y la nueva que se utilizar_
;; con el algoritmo gen_tico.



    if Selection = "Elitism"  [elitism
                               set seed-genomes item 0 winner-list]
    if Selection = "Roulette" [wheel-roulette
                              let chosen-generation item random-float length ranking ranking
                              let chosen-topology position chosen-generation ranking 
                              set seed-genomes item chosen-topology topology-list ]
    if Selection = "Tournament" [tournament
                              set seed-genomes item 0 winner-list]


 ; will only allow mating between chosen ones of previous generation (not their offspring)
  
  
  make-mix-genes                               ;recombine genomes of those who mate
  let o 0 
  
  while [o < (compute-factorial num-nodes)]
  [
   set seed-genomes (replace-item o mix-genes item o seed-genomes)
   set o o + 1
  ]
end 

to wheel-roulette
let i 0
set sum-fitness 0
set ranking []

while [i < min (list (generations * .01) length topology-list) ]
  [
  set sum-fitness sum-fitness + item compute-factorial num-nodes item i topology-list 
  set i i + 1
  ]
set i 0  
while [i < min (list (generations * .01) length topology-list) ]
  [
  set ranking lput ((item compute-factorial num-nodes item i topology-list) / sum-fitness) ranking 
  set i i + 1
  ]
end  

to tournament

let draftlist topology-list
set winner-list []
set draftlist shuffle topology-list
set winner-list n-of (1 + random(length draftlist / 2)) draftlist

set winner-list sort-by [ item (compute-factorial num-nodes) ?1 > item (compute-factorial num-nodes) ?2] winner-list 
end 

to elitism

let draftlist topology-list
set winner-list []
set winner-list sublist draftlist 0 (1 + random (length draftlist - 1))
end 

to driven-theory

set empty-topology n-values compute-factorial num-nodes [0]
set complete-topology n-values compute-factorial num-nodes [1]
;set complete-topology diag-zero complete-topology 
end 

to make-mix-genes
;; trabajan con seed-genomes, toman un _tem al azar y crean el marido. Igualan a la esposa con el marido
;; si el item 0 de seed-genomes = item 1 de seed-genomes no pasa nada, pero si no son iguales entonces
;; igualo ambos 
 let k 0
 let i random compute-factorial ( num-nodes - 1)
 let v compute-factorial num-nodes - i
 
 
  set mix-genes []
  let husband []
  let wife []
  
  let chosen random-float 1
  let swap false
    while [k < i][
     ifelse chosen < .5 [ set swap true
     if Selection = "Elitism"  [ set husband lput item k seed-genomes husband]
     if Selection = "Roulette" [ set husband lput item k seed-genomes husband]
     if Selection = "Tournament" [ set husband lput item k item 0 winner-list husband] ]
     [
      if Selection = "Elitism"  [set wife lput item k seed-genomes wife]
      if Selection = "Roulette" [set wife lput item k seed-genomes wife] 
      if Selection = "Tournament" [set wife lput item k item 0 winner-list wife] 
     ]
      ;assigns random genome to husband
     set k k + 1
     ]
;; consultar este procedimiento con Ignacio: el esposo es mitad del item k de seed-genomes en elitism...?
  while [k < v][
  ifelse swap = true [
  ;set wife lput item k item random generation topology-list wife
    if Selection = "Elitism"  [set wife lput item k item random length winner-list winner-list wife]
    if Selection = "Roulette" [set wife lput item k item random length topology-list topology-list wife] 
    if Selection = "Tournament" [set wife lput item k item 0 winner-list wife] ]
    [
     if Selection = "Elitism"  [set husband lput item k item random length winner-list winner-list husband]
     if Selection = "Roulette" [set husband lput item k item random length topology-list topology-list husband]
     if Selection = "Tournament" [set husband lput item k item 0 winner-list husband] 
    ]
   ;other half goes to wife
  set k k + 1
  ]
  
   while [k < compute-factorial num-nodes][
     ;ifelse chosen < .5 [ set swap true
   
   ifelse swap = true [
     if Selection = "Elitism"  [ set husband lput item k seed-genomes husband]
     if Selection = "Roulette" [ set husband lput item k seed-genomes husband]
     if Selection = "Tournament" [ set husband lput item k item 0 winner-list husband] ]
     [
      if Selection = "Elitism"  [set wife lput item k seed-genomes wife]
      if Selection = "Roulette" [set wife lput item k seed-genomes wife] 
      if Selection = "Tournament" [set wife lput item k item 0 winner-list wife] 
     ]
      ;assigns random genome to husband
     set k k + 1
     ]
   

let wh []
set wh lput wife wh
set wh lput husband wh
let mix-previous reduce [sentence ?1 ?2] wh 
set mix-genes reduce [sentence ?1 ?2] mix-previous
end 

to mutate
;; Here is where a mask covering the zeroes in diagonal must be added.    

   let genome-m 0
       while [genome-m < length seed-genomes] [ ; scan all genes
           if (random-float 1000 < mutation-rate * 1000)  
           ; change bit if mutation rate threshold is met
           [ let switch item genome-m seed-genomes
           ifelse (switch = 1)
           [ set seed-genomes (replace-item genome-m seed-genomes 0 ) ]
           [ set seed-genomes (replace-item genome-m seed-genomes 1 ) ]
           ]
   set genome-m genome-m + 1 ; moves to next genome
    ] 
;set seed-genomes diag-zero seed-genomes
end 

to rebirth
   
   ask patches [set pcolor black - .15]
   set-default-shape edges "line"
   create-genetic-info
   sort-global-fitness
   if length topology-list > 50 [set topology-list butlast topology-list]
   set topology-list remove-duplicates topology-list
   build-ga-network item 0 topology-list
end 

to update-genome 
 
 ask nodes [set genome n-values num-nodes [0] ]
; show seed-genomes
 ;; Ahora, copia esos datos y se lo inserta en los genomas de los nodos respectivos (la diagonal principal nunca es usada)
  
  let j 0
  let q 0
  while [j < (num-nodes - 1)][ let i j + 1
   while [i < num-nodes]
    [ask node j [set genome (replace-item i genome item q seed-genomes)]
       set q q + 1
       set i i + 1 ]
     set j j + 1]
    

;; se completa la diagonal inferior para todos los nodos, simetrica a la superior
let i 0
set j 0

   while [i < num-nodes ][set j 0
     while [j < num-nodes ][
      if [item j genome] of node i = 1
        [ask node j [set genome replace-item i genome 1]
         ]
      set j j + 1]
   set i i + 1]

;let a 0
;while [a < num-nodes]
;   [ask node a [show genome]
;    set a a + 1 ]
; 
end 

to theory-driven
if theory-driven? [driven-theory
let chosen random-float 1
ifelse chosen < .5 [
  set seed-genomes empty-topology]
 [set seed-genomes complete-topology  ]
 
 set theory-driven? false]
end 


;to-report diag-zero [matrix]
;;; zero diagonal mask  
;;; esta mal, hace cualquier cosa...
; ;let s matrix
; ;let p length s
; ;show s
; let i 1
; let j num-nodes
; while [j < (num-nodes * num-nodes)]
;       [ set matrix  replace-item (i + j) matrix  0
;         set i i + 1
;         set j j + num-nodes
;        ]   
; set matrix  replace-item 0 matrix  0        
; set matrix  replace-item (num-nodes * num-nodes - 1) matrix  0  
; ;show s
; report matrix 
;end

;;;;;;;;;;;;;;;;;;;;;
;;; Export Outcomes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;

to export
let i 0
file-delete "GA_1.txt"
file-open "GA_1.txt"

while [i < num-nodes][
  ask node i [print (word "node "  i  " " genome)]
  set i i + 1 ]

export-output "GA_1.txt"
file-close 
export-view (word edge-Cost-Structure "-" generations "-"  "-" ".png") 
export-plot "Accessibility Distribution" "Access.csv"
end 

There is only one version of this model, created almost 8 years ago by Juan MC Larrosa.

Attached files

File Type Description Last updated
Evolutive Two-Way Network Formation.png preview Preview for 'Evolutive Two-Way Network Formation' over 7 years ago, by Juan MC Larrosa Download

This model does not have any ancestors.

This model does not have any descendants.