;; Helper functions ;; Count occurences of items in list ;; See: https://stackoverflow.com/questions/32100378/count-the-number-of-occurrences-of-each-item-in-a-list to-report frequency [an-item a-list] report length (filter [ i -> i = an-item] a-list) end to-report tally-list [f-list] report map [ i -> frequency i f-list] (sort remove-duplicates f-list) end to-report eucl-distance [x1 y1 x2 y2] report sqrt ( ((x1 - x2 ) ^ 2) + ((y1 - y2 ) ^ 2) ) end to-report get-percentiles [data q] let sorted-list sort (data) let N length data let u round N * q let l round N * (1 - q) let m round N * 0.5 report (list (item l sorted-list ) (item m sorted-list ) (item u sorted-list )) end ;; radius from area (for HR calcs) - in m to-report radius-from-area [A] report sqrt (A / pi) end ;; Course (heading) between points: https://edwilliams.org/avform.htm#Crs ;to-report course ; dx = x2-x1 ; dy = y2-y1 ; if dx > 0 then ; bearing = 90 - arctan(dy/dx) ; if dx < 0 then ; bearing = 270 - arctan(dy/dx) ; if dx = 0 then ; if dy > 0 then bearing = 0 ; if dy < 0 then bearing = 180 ; if dy = 0 then point 1 = point 2 and there is no bearing ;end ; ;to write-distance ; let file-name (word dump-path "distance_" behaviorspace-run-number ".txt") ; file-open file-name ; (foreach distance-list n-seeds-list ; [ [?1 ?2] -> ; file-type behaviorspace-run-number file-type " " file-type precision ?1 3 file-type " " file-print ?2 ; ]) ; file-close-all ;end ; ;to write-step-length ; let file-name (word dump-path "steplength_" behaviorspace-run-number ".txt") ; file-open file-name ; (foreach step-length-list step-length-list ; [ [?1 ?2] -> ; file-type precision ?1 3 file-type " " file-print ?2 ; ]) ; file-close-all ;end ; ;to write-visited-locations ; ; let file-name (word dump-path "visited_" behaviorspace-run-number ".txt") ; file-open file-name ; (foreach emu-xcor-list emu-ycor-list ; [ [?1 ?2] -> ; file-type behaviorspace-run-number file-type " " file-type precision ?1 3 file-type " " file-print ?2 ; ]) ; file-close-all ;end ; ; to write-output write-deposition write-walk end to write-deposition if last file-path != "/" [ set file-path (word file-path "/" )] if behaviorspace-run-number > 0 [set nlrx-tag (word behaviorspace-run-number)] if file-prefix = "" [set file-prefix species] let file-name (word file-path file-prefix "_deposited_" nlrx-tag ".csv") file-open file-name file-print csv:to-row (list "id" "mass" "x" "y" "d" "activity") file-print csv:to-string [ (list id precision mass-id 4 precision scat-xcor 4 precision scat-ycor 4 precision scat-dist 4 activity) ] of scats file-close end to write-walk if last file-path != "/" [ set file-path (word file-path "/" )] if behaviorspace-run-number > 0 [set nlrx-tag (word behaviorspace-run-number)] if file-prefix = "" [set file-prefix species] let file-name (word file-path file-prefix "_walker_" nlrx-tag ".csv") file-open file-name file-print csv:to-row (list "run" "id" "mass" "x" "y" "speed" "activity") ask dispersers [ let M body-mass (foreach real-xcor-list real-ycor-list mvt-speed-list state-list [ [?1 ?2 ?3 ?4] -> file-print csv:to-row (list behaviorspace-run-number who precision M 4 precision ?1 4 precision ?2 4 precision ?3 4 ?4) ]) ] file-close end ;; Analogous to 'which' in R:: boolean comparison to-report which-bool [a b operator] let idx 0 let which [] while [idx < length a] [ if operator = ">" [ if (item idx a) > (item idx b) [set which lput idx which] ] if operator = "<" [ if (item idx a) < (item idx b) [set which lput idx which] ] set idx idx + 1 ] report which end ;; Code reconstructed from the R 'type 7' quantile function ;; Interpolates and is fast ;; https://svn.r-project.org/R/trunk/src/library/stats/R/quantile.R to-report get-quantiles-r [x q] ; x = list, q = quantile let n length x let probs (list q (1 - q)) let index map [i -> 1 + (n - 1) * i] probs let lo map floor index let hi map ceiling index set x sort x let qs map [j -> item (j - 1) x] lo let i which-bool index lo ">" let i-lo (map [[a b] -> a - b] index lo) let h (map [c -> item c i-lo] i ) let h-i (map [j -> item j hi] i) let xhi (map [j -> item (j - 1) x] h-i) set qs (map [ [ hh q-s xxh ] -> (1 - hh) * q-s + hh * xxh] h qs xhi) set qs fput min x qs set qs lput max x qs set qs insert-item 2 qs (median x) report qs end