---small_w_tester.nlogo

NETLOGO

globals [
    steps         ; Number of steps the model has made 
    edge_list     ; list of all edges
    tol           ; tolerance measure
    inertia       ; decimal version
    terminate     ; the main control repetition terminate flag
    polterminate  ; the policy action subroutine termination flag
    short_l       ; the average of L for all vertices
    clust_coeff   ; netowrks av. clustering coeff
    polsteps      ; no of iterations to policy agreement
    exit_flag
    pathl_min_list ; pathl at min p val
    pathl_p1_list ; path length at p=1
    pathllist ; the list for output of path lengths
    cc_min_list ; cc at min p val
    cc_p1_list ; clust coeff at p=1
    cclist ; the list for output of clustering coeffs
    polsteps_p1_list ; number of its to pol agree at p=1
    polsteps_min_list ; polsteps at min p val
    polstepslist ; the list for output of the number of iterations in policy sim
    ploglist ; list for output of the plog values
    nactorlist ; list for output of the number of actors
    num_actors
    p_rand_log
    shortcuts
    randval
    repcounter ; repetitions counter
    ]
breeds [actors policies envideas] ; this is mostly importqnt for policy simulation
actors-own [
    edges        ; List of edges belonging to actor
    inArcs       ; List of IDs of nodes pointing to me
    outArcs      ; List of IDs of nodes I point to
    policylist   ; list of policies hatched by the turtle
    temp         ; a temp variable
    policy       ; the agreement with policy
    oldpolicy    ; stored version of policy for that round
    mat          ; the full matrix
    short        ; shortest path lengths
    clustc       ; cluser coefficient (Watts Strogatz) 
    
]
policies-own [
   p-target       ; the target actor of the policy
   p-source       ; the source actor of the policy
             ]

;************
; highest level control
;************

to setup
clear-all
set repcounter 1
set pathllist []
set cclist []
set polstepslist []
set pathl_p1_list []
set cc_p1_list []
set polsteps_p1_list []
set pathl_min_list []
set cc_min_list []
set polsteps_min_list []
set ploglist []
set nactorlist []
end

to step            ; a step is one repetition of the plog-loop within actor-loop i.e. 'one_run'
init_one_run
while [terminate = 0]
[one_run]
set repcounter repcounter + 1
end

;************
; the control of one_run, the randomisation values p-loop, within number of actors loop
;************

to init_one_run  
set terminate 0
set num_actors num_actors_start - 5
set p_rand_log p_rand_log_end
end

to one_run
ifelse (p_rand_log = p_rand_log_end)               ; if last p val for this num_actors 
[set p_rand_log p_rand_log_start                   ; then reset the p val
 set num_actors num_actors + 5]                    ; and increase the actors by 5
[set p_rand_log precision (p_rand_log + 0.2) 1]    ; else increase the p_rand_log by 0.2

if (p_rand_log = p_rand_log_start)                 ; if this is first p value for this num_actor value
  [p1step]                                         ; call the procedure to do the p=1 run early

ifelse (p_rand_log = 0)                            ; if p_rand_log is 0 (i.e. p=1)
[if pathlen? [set short_l last pathl_p1_list]      ; put in the values we calculated in the special p1 run at start
 if clustcoeff? [set clust_coeff last cc_p1_list]
 if pol_action? [set polsteps last polsteps_p1_list]
]
[setnet                                            ; else set up the network
 setactors                                         ; initialise the actors
 calcs                                             ; and run the calulations
]
set nactorlist lput num_actors nactorlist          ; record the actor number
set ploglist lput p_rand_log ploglist              ; and the p value

if (p_rand_log = p_rand_log_start)                 ; if this is first p value for this num_actor value
  [first_p_net]                                    ; run the procedures that calculate/record p0 (min) values

if clustcoeff? [set cclist lput clust_coeff cclist]            ; record the outputs of the calcs
if pathlen? [set pathllist lput short_l pathllist]
if pol_action? [set polstepslist lput polsteps polstepslist]

doplots                                            ; do the plots

if ((num_actors >= num_actors_end) and (p_rand_log >= p_rand_log_end))
[set terminate 1]                                  ; set the terminate flag if on both last num_actors value and last _ value
end

;************
; the heart of the program called within the inner p-values loop
;************

; this is done for the first p value each time within actor loop
to first_p_net  
if pathlen? [set pathl_min_list lput (short_l) pathl_min_list]   ;sets the supposed 'minimums' for the plotting
if clustcoeff? [set cc_min_list lput (clust_coeff) cc_min_list]  ;post-run analysis should of course use the correct figures
if pol_action? [set polsteps_min_list lput (polsteps) polsteps_min_list]
end

; this is the procedure done for each plog value in the p-loop
to p1step             
locals [stored_p_val]
set stored_p_val p_rand_log     ; this is a bit of necessary housekeeping
set p_rand_log 0
setnet      ; create the network according to the randomisation, p, value
calcs
if pathlen? [set pathl_p1_list lput (short_l) pathl_p1_list]      ;put the required outputs into their lists
if clustcoeff? [set cc_p1_list lput (clust_coeff) cc_p1_list]
if pol_action? [set polsteps_p1_list lput (polsteps) polsteps_p1_list]
set p_rand_log stored_p_val
end

to setnet        ; creates the network in an agent based way
locals [myid]
clear-turtles
clear-patches
set-default-shape actors "circle"
set steps 0
set tol 1
set terminate 0
create-custom-actors (num_actors) [
   set ycor 0
   set xcor 0
   set size 5      
   set myid who      
   fd ((0.9 * screen-edge-x) - ((myid mod 2) * 20))  ; set up the actors in a concentric circle pattern - nice
   set color green
   set edges []   ; give the actors their empty lists
   set edge_list []
   set policylist []
   ]
ask actors [without-interruption[ makeregularnet    ; get the actors to create their regular network
            ] ]
randomnet    ; then randomise to the extent necessary
if drawnet? [drawlinks] 
ask actors
[ 
ifelse drawLabels? 
 [set label 0 + " "]
 [set label no-label]
 ]
end

;************
; the calculation control area
;************

to calcs     ; subroutine that runs the calculations
create_mat   ; creates a matrix  
if pathlen? [shortest_paths]   ;call the actual calculation subroutines
if clustcoeff? [cluster_coeff]
if pol_action? [
setactors   ; initiate the actors for the policy simulation
pol_action  ; do the policy simulation
]
set exit_flag 1
end

; creates the matrix to do some of the calcs on 
; n.b. it would be preferable to do them all by actor based methods, but hey
to create_mat
locals [i myid]
ask actors
 [without-interruption
  [set myid who
   set i 0
   set mat []
   set short []
   repeat num_actors
    [
     ifelse (member? i edges)
      [set mat lput 1 mat
       set short lput 1 short]
      [set mat lput 0 mat
       set short lput 99999 short]
     set i i + 1
    ]
   set short replace-item myid short 0
   ]
   ]
end

;************
; the agent based policy simulation bits
;************

; for the policy simulation give actors their initial conditions
to setactors  
locals [n]
set n 0
while [(count actors with [policy = 1]) < (start_policy_% * num_actors / 100)]
[
ask turtle n
 [update_policy (1)]
set n n + 1
]
color_actors  ; distinguish them graphically
end

;the actual meat of the policy simulation
to pol_action
locals [myid theirsupp]
set polterminate 0       ; the finish condition flag
set polsteps 0           ; the iteration counter
while [polterminate = 0]
[ask actors [set oldpolicy policy]   ; store the old value as we want to test convergence later

 ask actors [without-interruption    ; get all the actors to do their thing
  [set myid who

;**** the interaction rule *********   
   set theirsupp ((sum values-from (turtles with [member? myid edges]) [policy]) / (length edges) )
   update_policy (((1 - inertia) * theirsupp) + (inertia * oldpolicy))
   
;***********************************   
   ]]
color_actors        ; update the actors 'opinions' based on some rules
check_convergence   
set polsteps polsteps + 1 ; update the iteration counter
dopolplots                ; plot something to let us know the simulation is alive
]
end

; convergence happens either when all actors stop moving or when they all think the same thing (all green or all red)
to check_convergence
set tol max values-from actors [policy] - min values-from actors [policy]
if ((tol < 0.01) or (count actors with [color = green] = 0) or (count actors with [color = red] = 0))
 [set polterminate 1] ; set the terminate flag if we have convergence
end

; the colour of actors shows what they think
; this allows some nice tuning possibilities
to color_actors
ask actors
 [
   ifelse (policy > 0.5)
     [set color red]
     [set color green]
  ]
end

; 
to update_policy [newval]
 set policy newval
 ifelse (drawlabels?)
 [ set label " " + precision newval 3]
 [ set label no-label]
end

;********
; small worlds tests subroutines
;********

to shortest_paths
; ************************
; floyd warshall algorithm
; ************************
locals [k i j]
ask actors [set temp short]
set k 0
repeat num_actors
[
 ask actors [without-interruption[
   set i who
   set j 0
   repeat num_actors
    [
    set temp replace-item j temp (min list (item j short) ( (item k short) + (value-from turtle k [item j short]) ) )
    set j j + 1
    ]
   ]]
 set k k + 1
 ask actors [set short temp]
]
set short_l 0       ; short_l (that is an 'el', not a 'one', is the global shortest path value
ask actors [without-interruption
 [set short_l (short_l + (sum short))]]
set short_l (short_l / (num_actors * num_actors))
end  

; ************************
; calculation of clustering coefficient as described by Watts and Strogatz
; ************************
to cluster_coeff
locals [tot_links neighbours myedges  i j]
ask actors [without-interruption[
  set neighbours length edges
  set myedges edges
  set tot_links 0
  set i 0
  repeat neighbours
   [
    set j i + 1
    repeat neighbours - (i + 1)
     [ask turtle (item i myedges)
      [if (member? (item j myedges) edges)
       [ set tot_links tot_links + 1]
      ]
      set j j + 1
     ]
    set i i + 1
   ]
  ifelse (tot_links > 0)
  [set clustc (tot_links / (neighbours * (neighbours - 1) / 2))]
  [set clustc 0]
 ]]
set clust_coeff ((sum values-from actors [clustc]) / num_actors)
end      

;*********
; section that deals with getting the actors to create the networks
;*********

; a regular network where each actor is neighbours with actors on either side
to makeregularnet
locals [myid relative destination]
set myid who
set relative 0 - ( range )
repeat (range * 2) + 1 [
  set destination (myid + relative + num_actors) mod (num_actors) 
  if (destination != myid) [addEdge (destination)]
  set relative relative + 1
  ]       
end

; rewiring the edges of a regular network according to a probablity factor p
; again see Watts and Strogatz for the maths
to randomnet
locals [fromid toid n new_toid shortlist]
set n 0
set shortcuts 0
set shortlist sort-by [random (length edge_list) < random (length edge_list)] edge_list
repeat int((length edge_list) * (10 ^ p_rand_log))
 [
   set shortcuts shortcuts + 1
   set fromid item 0 (item n shortlist)
   set toid item 1 (item n shortlist)  
   ask turtle fromid
    [without-interruption[
    set new_toid (random num_actors)
    while [(new_toid = fromid) or (member? new_toid edges)]
     [set new_toid (random num_actors)]
    ]]
   replace_edge (list (list fromid toid) (list fromid new_toid))
   set n (n + 1)
 ] 
end

;used to get actors to manipulate their network variables consistently
; according to a list 'params' that is self explanatory from the code below
; this code was stolen from someone, but I cannot remember who - let me know if it was you and I will reference you

to replace_edge [params]
locals [fromid new_fromid toid new_toid]
set fromid item 0 (item 0 params)
set toid item 1 (item 0 params)
set new_fromid item 0 (item 1 params)
set new_toid item 1 (item 1 params)
ask turtle fromid
    [
     set edges remove toid edges
    ]
ask turtle new_fromid
    [
    set edges lput new_toid edges
    ]
ask turtle toid
    [
    set edges remove fromid edges 
    ]
ask turtle new_toid
    [
    set edges lput new_fromid edges
    ]
set edge_list (replace-item (position (list fromid toid) edge_list) edge_list (list new_fromid new_toid))
end

to addEdge [toactor]
locals [myID theirID them pair]
set myid who
set them turtle toactor
if (them != nobody) 
  [
   ask them 
     [
      set theirID who
      if (not member? myID edges) 
         [
          set edges fput myID edges      
          set pair list myID theirID
          set edge_list fput pair edge_list
         ]              
      ]
    if (not member? theirID edges) 
      [set edges fput theirID edges]
   ]
end

;****************
; graphical representation subroutines
;****************

to drawlinks
locals [dest_actor myid]
ask actors [without-interruption[ 
             set temp 0
             repeat (length edges)
              [ 
               set dest_actor (item temp edges)
               hatch_small_blue_policy (dest_actor) 
               set temp (temp + 1)
              ] 
           ]]
; this makes it all happen so quickly!     
ask policies [without-interruption[move_to_dest_draw]]
ask policies [without-interruption[die]]                     
end

to hatch_small_blue_policy [destination]
locals [myid]
set myid who
hatch 1 [
         set breed policies
         set color blue
         set label ""
         set p-target destination
         set p-source myid
         set heading (towards-nowrap turtle p-target)]
end

to move_to_dest_draw
pd
while [(distance turtle p-target) > 5]
[fd 3]
pu
end