Modified Random Clusters

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Modified random clusters method for landscape pattern simulation - NetLogo  ;;
;;                                                                              ;;
;;  Code licenced by James D.A. Millington (http://www.landscapemodelling.net)  ;;
;;  under a Creative Commons Attribution-Noncommercial-Share Alike 3.0          ;;
;;  Unported License (see http://creativecommons.org/licenses/by-nc-sa/3.0/)    ;;
;;                                                                              ;;
;;  This code is based on the method by Saura & Martinez-Millan (2000)          ;;
;;  Landscape Ecology 15 661-678 http://dx.doi.org/10.1023/A:1008107902848      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  


patches-own 
[ 
  cover        ;; cover of patch
  cluster_ID   ;; id of cluster patch belongs to
  cluster      ;; holds a patch which is that cluster's "leader" - arbitrarily chosen
]


globals 
[ 
  cluster-area-list  ;for plotting purposes
]




;---------------

to generate-landscape

  set cluster-area-list []
  
  set_random_seeds                                 ;; randomly distribute cluster seeds (Step 1 in Saura & Martinez-Millan 2000 p.664)

  set-cover                                        ;; identify and label clusters (Steps 2 & 3 in above)
  fill_landscape                                   ;; fill remaining patches to dominant neighbour (Step 4 in above)
  
  ask patches [ set pcolor (cover * 10) + 5 ]      ;; color patches according to cover types

  plotting                                         ;; plot bar plots
end 
;---------------




;---------------

to set-cover
  loop
  [ 
    let seed one-of patches with [ ( cluster = nobody and pcolor = blue ) ]   ;; pick a random seed we haven't labelled yet
    if seed = nobody                                                          ;; if we have labelled all seeds stop
      [ stop ]
      
    ask seed                   
    [                          
      set cluster self                     ;; make the seed the "leader" of a new cluster by assigning itself to its own cluster
      set cover ( random Number-of-Types )       ;; assign this "leader" a random cover      
      grow-cover_cluster                   ;; then grow-cover_cluster to find the rest of the cluster     
      
      set cluster-area-list fput count patches with [cluster = myself] cluster-area-list        
    ]
    
  ]   
end   
;---------------




;---------------      

to grow-cover_cluster               
  
  without-interruption              ;; we use without-interruption here so each patch only gets added to the cluster once
  [ 
    let neighbours nobody
    
    ifelse(Neighbourhood = "Moore") 
    [ set neighbours neighbors with [ cluster = nobody and pcolor = [pcolor] of myself ] ]
    [ set neighbours neighbors4 with [ cluster = nobody and pcolor = [pcolor] of myself ] ]
    
    ask neighbours
    [ 
      set cluster [cluster] of myself    ;;assign neighbouring patch to seed patch cluster
      set cover [cover] of myself        ;;assign neighbouring patch to seed patch cover
      set cluster_ID [cluster_ID] of myself
      grow-cover_cluster                 ;;recursive call!
    ] 
   ]
end 
;---------------





;---------------

to set_random_seeds
  
  let cluster-counter 0
  
  ask patches 
  [
    set cover nobody                  
    set cluster_ID nobody                 
    set cluster nobody                    
  ]
  
  ask patches 
  [  
    ifelse ( (random-float 1) < cluster-probability )  ;set patch as seed if rand no is less than cluster_probability
    [ 
      set pcolor blue                                ;seeds are blue
      set cluster_ID cluster-counter 
      set cluster-counter cluster-counter + 1
    ]                            
    [ set pcolor red ]                               ;non-seeds are red
  ]
end 
;---------------



;---------------

to fill_landscape                  ;; assign patches not initially assigned (to dominant cover in neighbourhood)
  
  loop 
  [
    if ( not any? patches with [ cluster = nobody ] )     ;;if all patches have been assigned to an cover-cluster 
    [ stop ]
 
    ask one-of patches with [ cluster = nobody ]  ;;pick a patch that has not been assigned to an cover-cluster yet
    [
      let neighbours nobody
  
      ifelse(Neighbourhood = "Moore") 
      [ set neighbours neighbors ]
      [ set neighbours neighbors4 ]
        
      
      ifelse ( any? neighbours with [ cluster != nobody ] )  ;; check if there are any assigned patches in neighbourhood
      [ 
        
        let covers []
        
        ask neighbours with [ cluster != nobody ] 
        [
          set covers fput cover covers    ;;ask neighbours to add their covers to the list
        ] 
          
        let unique-covers remove-duplicates covers    ;;create a list of unique covers
                                      
        let max-cover-count -1                 ;the number of neighbours with the maximum cover
        let max-cover -1                       ;the maximum cover
        
        
        ifelse(length unique-covers > 1)
        [
          ;if there is more than one unique-cover
          foreach unique-covers                  ;for each of the unique covers
          [
            let occ occurrences ? covers          ;count how many neighbours had this cover
            
            ifelse(occ > max-cover-count)        ;if the count is greater than the current maximum count
            [ 
              set max-cover ?                    ;set this as the dominant cover
              set max-cover-count occ            ;update the current maximum count
            ]
            [
              if(occ = max-cover-count)          ;otherwise, if the count is equal to the current maximum count
              [
                let rand random-float 1          
                if(rand < 0.5) [ set max-cover ? ]  ;randomly pick one of the two covers to be the new dominant cover
              ]
            ]
          ]
        ]
        
        [
          ;otherwise just set the max-cover to the only unique-cover
          set max-cover first unique-covers
        ]
 
  
        let p one-of neighbours with [ cover = max-cover ]    ;;assign qualities of one of dominant neighbours to patch (no wrap!)
        set pcolor [pcolor] of p 
        set cluster [cluster] of p   
        set cover [cover] of p 
        set cluster_id [cluster_id] of p
      ]
      [                                                               ;; if no assigned agents in neighbourhood assign an agent at random
        set cover ( random Number-of-Types) 
        set cluster self                                              ;; remember to start a new cluster!
        set cluster_ID ([cluster_ID] of max-one-of patches [cluster_ID]) + 1
      ]
    ]
  ]
end 
;---------------





;; count the number of occurrences of an item in a list
;---------------

to-report occurrences [x the-list]
  report reduce
    [ifelse-value (?2 = x) [?1 + 1] [?1]] (fput 0 the-list)
end 
;---------------



;---------------

to plotting
  
  set-current-plot "Cluster-Distribution"
  clear-plot
  histogram cluster-area-list
  
  set-current-plot "Cover-By-Area"
  clear-plot
  let cover-counts []
  let c 0
  while[c < Number-of-Types] 
  [ 
    set cover-counts fput 0 cover-counts 
    set c c + 1
  ]
  ask patches [ set cover-counts replace-item cover cover-counts ((item cover cover-counts) + 1) ]
  
  set c 0
  while[c < Number-of-Types]
  [
    plotxy c item c cover-counts
    set c c + 1
  ]
  
  
  
  set-current-plot "Count-Clusters-By-Cover"
  clear-plot
   
  set cover-counts []
  set c 0
  while[c < Number-of-Types] 
  [ 
    set cover-counts fput 0 cover-counts 
    set c c + 1
  ]
  
  let max-cluster-ID 0
  ask max-one-of patches [cluster_ID][ set max-cluster-ID cluster_ID ]
  
  let id 0
  while[id <= max-cluster-ID] 
  [
    let p one-of patches with [cluster_ID = id]
    
    if(p != nobody)
    [
      ask p
      [
        set cover-counts replace-item cover cover-counts ((item cover cover-counts) + 1) 
      ]
    ]
    set id id + 1
  ]
  
  print cover-counts
  
  set c 0
  while[c < Number-of-Types]
  [
    plotxy c item c cover-counts
    set c c + 1
  ]
end   
;---------------



;---------------

to export-map
  
  file-close-all 
  if(file-exists? "export.asc") [file-delete "export.asc"]
  file-open "export.asc"
  
  
  file-type "ncols   " 
  file-print world-width
  file-type "nrows   "
  file-print world-height 
  file-print "xllcorner  0" 
  file-print "yllcorner  0" 
  file-print "cellsize   1" 
  file-print "NODATA_value  -9999"
  
  let x min-pxcor
  let y max-pycor
  
  while[y >= min-pycor]
  [
    while[x <= max-pxcor]
    [
      ifelse(x = max-pxcor)
      [
        ask patches with [pxcor = x and pycor = y] [ file-print cover ]
      ]
      [
        ask patches with [pxcor = x and pycor = y] [ file-type cover file-type " "]
      ]
      
      set x x + 1
    ]
    
    set x min-pxcor
    set y y - 1
  ]
  
  file-close
end 
;---------------