Tax evasion: Turkish case

;;;; This software is a NetLogo model written with the aim of accomplishing similar
;;;; behaviour of tax payers concerning tax compliance as described in Bloomquist(2011):
;;;; "Tax Compliance as an Evolutionary Coordination Game: An Agent-Based Approach"
;;;; Written by Ozgur Ican and M.Oguz Arslan. All rights reserved.
;;;; Contact: oican@anadolu.edu.tr , ozgur.ican@omu.edu.tr

;; Common turtle attributes 
turtles-own [ 
  z
  yTrue
  yReport
  yNet 
  audit? ]

;; Below are some turtle breeds necessary for simulation
breed [defiants defiant]
breed [honests honest]
breed [rands rand]
breed [stgs stg]

;; Globals that are not linked with any GUI controls
globals [ audit_rate pop_size mean_Z mean_yNet nh nd ns nr]


;; Below lay setup procedures

to setup-defiants
  let ndefiants ( pop_size * per_def / 100 )
  ask n-of ndefiants patches with [not any? turtles-here] [ sprout-defiants 1 ]
  ask defiants [set color red]
  ifelse ( audit_rate >= ( 1 / ( 1 + phi)) ) 
  [ ask defiants [ set z 1 ] ] 
  [ ask defiants [ set z 0 ] ]
end 

to setup-honests
  let nhonests ( pop_size * per_hon / 100 )
  ask n-of nhonests patches with [not any? turtles-here] [ sprout-honests 1 ]
  ask honests [set color green]
  ask honests [ set z 1 ]
end 

to setup-rands
  let nrands ( pop_size * per_ran / 100 )
  ask n-of nrands patches with [not any? turtles-here] [ sprout-rands 1 ]
  ask rands [set color blue]
  ifelse ( audit_rate >= ( 1 / ( 1 + phi)) ) 
  [ ask stgs [ set z 1 ] ] 
  [ ask rands [set z tri-dist-generate 0 1 1 ] ]
end     

to setup-stgs
  let nstgs ( pop_size * per_stg / 100 )
  ask n-of nstgs patches with [not any? turtles-here] [ sprout-stgs 1 ]
  ask stgs [ set color yellow ]
  ifelse ( audit_rate >= ( 1 / ( 1 + phi)) ) 
  [ ask stgs [ set z 1 ] ] 
  [ ask stgs [ set z random 1 ] ]
end     

to prep-defiants
  ;;
  set color red 
  set z 0
end 

to prep-honests
  ;;
  set color green
  set z 1.0  
end 

to prep-rands
  ;;
  set color blue
  set z tri-dist-generate 0 1 1 
end 

to prep-stgs
  ;;
  set color yellow 
  set z random 1
end 

to initialize-replacers-without-nhood [ pset ]
  ;;
  let n count pset
  let ndefiants floor ( n * per_def / 100 )
  let nhonests floor ( n * per_hon / 100 )  
  let nstgs floor ( n * per_stg / 100 )  
  let nrands (n - ( ndefiants + nhonests + nstgs ))
  let defland n-of ndefiants pset with [not any? turtles-here] 
  ask defland [ sprout-defiants 1 ]
  ask turtles-on defland [ prep-defiants ]
  let honland n-of nhonests pset with [not any? turtles-here]  
  ask honland [ sprout-honests 1 ]
  ask turtles-on honland [ prep-honests ]
  let ranland n-of nrands pset with [not any? turtles-here] 
  ask ranland [ sprout-rands 1 ]
  ask turtles-on ranland [ prep-rands]
  let stgland n-of nstgs pset with [not any? turtles-here] 
  ask stgland [ sprout-stgs 1 ]
  ask turtles-on stgland [ prep-stgs ]
end 

to nhood-research
  ;; Von Neumann, i.e. 4 immediate neighbors
  let hood_people turtles-on neighbors4
  let nhith count honests with [member? self hood_people] ; Number of honests in the hood
  let ndith count defiants with [member? self hood_people] ; Number of defiants in the hood
  ;let nrith count rands with [member? self hood_people] ; Number of rands in the hood
  ;let nsith count stgs with [member? self hood_people] ; Number of stgs in the hood  
  ;report (list nhith ndith nrith nsith)
  if ((ndith >= 2) and ( ndith > nhith )) 
  [ ask self [ sprout-defiants 1]
    ask turtles-on self [ prep-defiants ]
    stop ]
  if ((nhith >= 2) and ( nhith > ndith )) 
  [ ask self [ sprout-honests 1]
    ask turtles-on self [ prep-honests ]
    stop ]
  let rn random-float 1.0
  let pdef (per_def / 100.0)
  let phon (per_hon / 100.0)
  let pran (per_ran / 100.0)
  ifelse ( rn < pdef)
    [ sprout-defiants 1 
      ask turtles-on self [ prep-defiants ]]
    [ifelse ( rn < (pdef + phon))
      [ sprout-honests 1 
        ask turtles-on self [ prep-honests ]        ]
      [ ifelse ( rn < (pdef + phon + pran)) 
        [ sprout-rands 1 
          ask turtles-on self [ prep-rands ]]
        [ sprout-stgs 1 
          ask turtles-on self [ prep-stgs ]]]]
end 

to initialize-replacers-with-nhood [ pset ]
  ;;
  ask pset [ nhood-research ]
end 

to replace-goners-and-maintain-survivors
  ;; Find and replace goners
  let goners turtle-set find-goners
  let pos [patch-here] of goners
  let ps patch-set pos
  ask goners [die]
  ifelse ( nhood_effect = True )
  [ initialize-replacers-with-nhood ps ]
  [ initialize-replacers-without-nhood ps ]  
  ;; Make repayment for survivors and init
  ;; payment for new-comers
  if (income_dist = "uniform")
  [ ask turtles [ set yTrue ((random 80) + 20) ] ]
  if (income_dist = "lognormal")
  [ ask turtles [ set yTrue lognormal-dist-generate-sbtcs ] ] 
  ;; Check if full compliance is necessary
  ;; for all agents
  ask turtles
  [ if ( audit_rate >= ( 1 / ( 1 + phi)) ) 
    [set z 1 ] ]
end 

to setup-agents
  resize-world -49 50 -49 50
  set-default-shape turtles "square"  
  set pop_size 10000
  set nh count honests
  set nd count defiants
  set ns count stgs
  set nr count rands
  ;; Call helper setup procedures
  setup-defiants
  setup-honests
  setup-rands
  setup-stgs
  ;; Initialize income of first turn and
  ;; related turtle attributes
  if (income_dist = "uniform")
  [ ask turtles [ set yTrue ((random 80) + 20) ] ] ; Turtles have a yTrue of drawn from an uniform dist between 20 and 100
  if (income_dist = "lognormal")
  [ ask turtles [ set yTrue lognormal-dist-generate-sbtcs ] ]
  ask turtles
  [ set audit? false ]
  ask turtles 
  [ set yReport ( z * yTrue) ]
  ask turtles
  [ set yNet ( yTrue - ( taxRate * yReport )) ]
end 

;; Checkup procedure to be called under main setup function
;; which controls some of user supplied parameters

to check-up
  if (per_ran + per_def + per_hon + per_stg )  !=  100 [ 
    user-message ( word "Sum of percentage of breeds must be exactly 100!"
      "Push the \"Halt\" button and re-enter percentages." ) ]
  if ( times < 50 ) [
    user-message ( word "Minimum loop should be equal or greater than 50! "
      "Push the \"Halt\" button and re-enter \"times\" global value." ) ]
  ifelse ( perceived_ar_ctrl = true ) 
    [ set audit_rate  perceived-audit-prob actual_audit_rate gamma ]
    [ set audit_rate actual_audit_rate ]
end 

;; Main setup function

to setup
  ca
  check-up
  setup-agents
end 

;; Update statistics

to update-stats
  set mean_Z mean [ z ] of turtles
  set mean_yNet mean [ yNet ] of turtles
  set nh count honests
  set nd count defiants
  set ns count stgs
  set nr count rands
end 

;; Update plots

to update-plots
  set-current-plot "mean_compliance_rate"
  set-current-plot-pen "default"
  set-plot-x-range 0 times
  set-plot-y-range 0 1 
  plot mean_Z
  set-current-plot "mean_net_income"
  set-current-plot-pen "default"
  plot mean_yNet
end 

to plot-histogram-start
  set-current-plot "comp_rate_dispersion_start"
  set-current-plot-pen "default"
  set-plot-x-range 0 1.001
  set-histogram-num-bars 10 
  ;set-plot-pen-interval 0.2
  histogram [ z ] of turtles
end 

to plot-histogram-end
  set-current-plot "comp_rate_dispersion_end"
  set-current-plot-pen "default"
  set-plot-x-range 0 1.001
  set-histogram-num-bars 10 
  ;set-plot-pen-interval 0.2
  histogram [ z ] of turtles
end 

;; Selection strategies

to-report random-select [ n ]
  let aset n-of n turtles
  let alist [ self ] of aset ;; agent list in random order  
  report alist
end 

to-report dif-like-select [ n ] 
  let l sort-by [ [yReport] of ?1 < [yReport] of ?2 ] turtles 
  report sublist l 0 n
end 

to-report half-half-select [ n ]
  let n1 0
  let n2 0
  if (n mod 2) = 0 [ set n1 ( n / 2) ]
  if (n mod 2) = 1 [ set n1 ( ( n + 1 ) / 2 ) ]
  set n2 ( n - n1 )
  let l1 dif-like-select n1  
  let s2 n-of n2 turtles with [ not member? turtles l1 ]
  let l2 [ self ] of s2 
  report sentence l1  l2 ; append two list: it is not '+' anymore
end 

to-report select-agents-for-audit [ n ]
  ;; Return a list of agents selected for 
  ;; auditing according to given selection method.
  if ( selection_strategy = "random" )
  [ report random-select n ]
  if ( selection_strategy = "DIF-like" )
  [ report dif-like-select n]
  if ( selection_strategy = "half-half" )
  [report half-half-select n]
end 

to audit-individual
  ;; Related procedure to apply on individuals
  ;; selected for audit.
  if ( [ z ] of self < 1 ) 
    [ set yReport yTrue
      let after_penalty (yTrue - (((100 + penalty_rate) / 100) * ( taxRate * yReport )))
      ifelse ( after_penalty > 0 ) 
      [ set yNet after_penalty ]
      [ set yNet 0 ]
    ]
end 

to make-audit
  let n (audit_rate * pop_size )  
  let selected select-agents-for-audit n
  let lucky-ones turtle-set selected
  ask lucky-ones [ set audit? True ]
  ask lucky-ones [ audit-individual ]
  ask lucky-ones [ update-compliance-rate ]
  reset-audit-memory
end 

to-report find-goners
  ;;
  let nbankrupts ( pop_size * attrition_rate * ( 1 - nonbankrupt_leaver_rate ))
  let narbitrary_leavers ( pop_size * attrition_rate * nonbankrupt_leaver_rate )
  let m median [yNet] of turtles
  let ntemp ceiling ( ( nbankrupts / 9 ) * 10 )
  let tempset n-of ntemp turtles with [ yNet <= m ]
  let bset n-of nbankrupts tempset
  let blist [self] of bset
  let aset n-of narbitrary_leavers turtles with [ not member? turtles blist ]
  let alist [self] of aset
  report sentence blist alist
end 

to-report inc-audit-rate-for-stgs [ ex_z ]
  ;;
  let new_z (ex_z + ( random-float 1 ) )
  ifelse ( new_z < 1 ) [ report new_z ] [ report 1 ]
end 

to-report dec-audit-rate-for-stgs [ ex_z ]
  ;;
  let new_z (ex_z - ( random-float 1 ) )
  ifelse ( new_z > 0 ) [ report new_z ] [ report 0 ]
end 

to reset-audit-memory
  ;;
  ask turtles [ set audit? False ]
end 

to update-compliance-rate 
  ;;
  if ( is-stg? self ) 
  [ ifelse ( audit? ) [ set z ( inc-audit-rate-for-stgs z ) ]
    [ set z ( inc-audit-rate-for-stgs z ) ] ]  
end 

;; Main loop function

to go
  clear-all-plots
  tick
  plot-histogram-start  
  repeat times [
    make-audit
    replace-goners-and-maintain-survivors
    tick
    update-stats
    update-plots ]
  plot-histogram-end
end 


;;; Below lay some necessary utility functions
;; Returns perceived audit rate as a function of the
;; actual rate and a gamma parameter.

to-report perceived-audit-prob [ p g ]
 report 1 - ( (1 - p) ^ g / ( p ^ g + (1 - p ) ^ g) ^ (1 / g) )
end 

;; Below lay some NetLogo code for pdf, cdf and a random number 
;; generator function for triangular distribution
;; and lognormal distribution.

;; Triangular distribution
;; Source for trianular dist. http://www.brighton-webs.co.uk/distributions/triangular.asp

to-report tri-dist-pdf [ x mn mx mode ]
  if (x = mode) [ report 2 / (mx - mn) ]
  if (x < mode) [ report (2 * (x - mn)) / ((mx - mn)*(mode - mn)) ]
  if (x > mode) [ report (2 * (mx - x))/((mx - mn)*(mx - mode)) ]
end 

to-report tri-dist-cdf [ x mn mx mode ]
  if (x = mode) [ report (mode - mn) / (mx - mn) ]
  if (x < mode) [ report (x - mn) ^ 2 / ((mode - mn) * (mx - mn)) ]
  if (x > mode) [ report  (1 - ((mx - x) ^ 2 / ((mx - mode) * (mx - mn)))) ]
end 

to-report tri-dist-generate [ mn mx mode ]
  let p random-float 1
  if p = ((mode - mn ) / ( mx - mn )) [ report mode ]
  if p < ((mode - mn ) / ( mx - mn )) [ report (mn + sqrt (p * ( mx - mn ) * (mode - mn ))) ]
  if p > ((mode - mn ) / ( mx - mn )) [ report (mx - sqrt (( 1 - p ) * (mx - mn) * (mx - mode ))) ]
end   

;; Logormal distribution
;; Source for lognormal dist. http://www.brighton-webs.co.uk/distributions/lognormal.htm

to-report lognormal-dist-generate [ meanl stdevl ]
  let r1 sqrt ( ( -2 * ln (random-float 1) ) * (sin ( 2 * pi * (random-float 1) ) ) )
  let r2 ( meanl + r1 * stdevl )
  report exp r2
end 

to-report lognormal-dist-generate-sbtcs
  ;; Generate a lognormal variable with a mean of 16
  ;; and a median of 7 as decribed in Bloomqust et al.
  let n random-normal 0 1
  report exp ( 2 + 1.25 * n )
end