reorganize, upload some things

iterated-prisoners-dilemma-contest/dilemma.scm

@@ -0,0 +1,158 @@
+;; prisond.scm: iterated prisoner's dilemma simulation
+;; by matt
+;; this program is in the public domain
+
+(define strategies '())
+
+(define add-strategy
+  (lambda (x y)
+    (set! strategies (cons (cons x y) strategies))))
+
+(define angel
+  (lambda (x y) 0))
+
+(define devil
+  (lambda (x y) 1))
+
+(define tat-for-tit
+  (lambda (x y)
+    (if (null? x)
+        1
+        (if (= (car x) 0)
+            1
+            0))))
+
+(define tit-for-tat
+  (lambda (x y)
+    (if (null? x)
+        0
+        (car x))))
+
+(define time-machine
+  (lambda (x y)
+    (if (> 3 (length x))
+        0
+        (caddr x))))
+
+(define random-choice
+  (lambda (x y)
+    (random 2)))
+
+(define grudger
+  (lambda (x y)
+    (if (memq 1 x)
+        1
+        0)))
+
+(define angry-tit-for-tat
+  (lambda (x y)
+    (if (null? x)
+        1
+        (car x))))
+
+(define apl
+  (lambda (x y)
+    (if (null? x)
+        1
+        (if (= ( car y) 0)
+            1
+            0))))
+
+(load-shared-object "/usr/lib/libc.so.6")
+(define fork (foreign-procedure #f "fork" () unsigned))
+;(define waitpid (foreign-procedure #f "waitpid" (unsigned uptr unsigned) integer-32))
+(define wait (foreign-procedure #f "wait" (uptr) integer-32))
+(define mmap (foreign-procedure #f "mmap" (uptr unsigned integer-32 integer-32 integer-32 unsigned) uptr))
+(define shmem (mmap 0 8 3 33 -1 0))
+
+(define tt-run
+  (lambda (pid)
+    (if (> pid 0) (begin
+      (wait 0)
+      (foreign-ref 'integer-64 shmem 0)
+    ) 'temporary-timeline)))
+(define tt-send (lambda (x) (begin
+  (foreign-set! 'integer-64 shmem 0 3)
+  (exit))))
+(define tt-recv (lambda () (tt-run (fork))))
+
+(set! strategized 0)
+(set! running 0)
+(define apiomemetics
+  (lambda (x y)
+    (if (null? x)
+        (if (= running 0) (let ((ttr (tt-recv))) (if (eq? ttr 'temporary-timeline)
+          (begin (set! running 1) (display "temporary TL\n") 0)
+          (begin (set! running 1) (display "primary TL, got result ") (display ttr) (newline) (set! strategized 1) 0))) 0)
+        (if (= (length x) 99)
+          (if (= strategized 0) (begin
+            (display "end of game, reversing\n")
+            (tt-send 3)
+          ) (begin
+            (set! running 0)
+            (display "end of game in primary\n")
+            0
+          ))
+          (car x)))))
+
+(define prisond
+  (lambda (x y)
+    (if (= x y)
+        (if (= x 1)
+            '(-2 -2)
+            '(-1 -1))
+        (if (= x 1)
+            '(0 -3)
+            '(-3 0)))))
+
+(define iter-prisond
+  (lambda (x y z)
+    (define scores '(0 0))
+    (define moves-x '())
+    (define moves-y '())
+    (define current-moves '())
+    (define helper
+      (lambda (x y z)
+        (if (= z 0)
+            scores
+            (begin
+              (set! current-moves (list (x moves-x moves-y) (y moves-y moves-x)))
+              (set! moves-x (cons (cadr current-moves) moves-x))
+              (set! moves-y (cons (car current-moves) moves-y))
+              (set! scores (map + scores (prisond (car current-moves) (cadr current-moves))))
+              (helper x y (- z 1)))))) (helper x y z)))
+
+(define get-strategy-scores
+  (lambda (x)
+    (define score 0)
+    (define helper
+      (lambda (y)
+        (if (eqv? (car x) (car y))
+            0
+            (set! score (+ score (car (iter-prisond (cdr x) (cdr y) 100)))))))
+    (map helper strategies)
+    score))
+
+(define get-all-scores
+  (lambda ()
+    (define helper
+      (lambda (x)
+        (write (list (car x) (get-strategy-scores x)))
+        (newline)))
+    (map helper strategies)))
+
+(add-strategy 'angel angel)
+(add-strategy 'devil devil)
+(add-strategy 'tit-for-tat tit-for-tat)
+(add-strategy 'tat-for-tit tat-for-tit)
+(add-strategy 'time-machine time-machine)
+(add-strategy 'random-choice random-choice)
+(add-strategy 'grudger grudger)
+(add-strategy 'angry-tit-for-tat angry-tit-for-tat)
+(add-strategy 'apl apl)
+(add-strategy 'apiomemetics apiomemetics)
+
+(random-seed (time-second (current-time)))
+
+(get-all-scores)
+(exit)

iterated-prisoners-dilemma-contest/dilemma2.scm

@@ -0,0 +1,173 @@
+;; prisond.scm: iterated prisoner's dilemma simulation
+;; by matt
+;; this program is in the public domain
+
+(define strategies '())
+
+(define add-strategy
+  (lambda (x y)
+    (set! strategies (cons (cons x y) strategies))))
+
+(define angel
+  (lambda (x y) 0))
+
+(define devil
+  (lambda (x y) 1))
+
+(define tat-for-tit
+  (lambda (x y)
+    (if (null? x)
+        1
+        (if (= (car x) 0)
+            1
+            0))))
+
+(define tit-for-tat
+  (lambda (x y)
+    (if (null? x)
+        0
+        (car x))))
+
+(define time-machine
+  (lambda (x y)
+    (if (> 3 (length x))
+        0
+        (caddr x))))
+
+(define random-choice
+  (lambda (x y)
+    (random 2)))
+
+(define grudger
+  (lambda (x y)
+    (if (memq 1 x)
+        1
+        0)))
+
+(define angry-tit-for-tat
+  (lambda (x y)
+    (if (null? x)
+        1
+        (car x))))
+
+(define apl
+  (lambda (x y)
+    (if (null? x)
+        1
+        (if (= ( car y) 0)
+            1
+            0))))
+
+(define forgiving-grudge
+  (lambda (x y) (let* (
+    (defection-count (length (filter (lambda (m) (= m 1)) x)))
+    (result (if (> defection-count 3) 1 0))
+  ) result)))
+
+(define (take n xs)
+  (let loop ((n n) (xs xs) (zs (list)))
+    (if (or (zero? n) (null? xs))
+        (reverse zs)
+        (loop (- n 1) (cdr xs)
+              (cons (car xs) zs)))))
+
+(define (zip . xss) (apply map list xss))
+
+(define actually-forgiving-grudge
+  (lambda (x y) (let* (
+    (defection-count (length (filter (lambda (m) (= m 1)) x)))
+    ; TODO: tune 1.8 there, or maybe entirely switch out formula
+    (lookback (+ 1 (inexact->exact (floor (expt 1.8 defection-count)))))
+    ; should maybe be (zip (append x '(-1)) (cons -1 y)) - current version compares actions at the same time, but it may not be "betrayal" unless the defecting by the opponent comes AFTER our cooperating
+    ; this does seem to worsen its score so maybe not
+    (result (if (member '(1 0) (take lookback (zip x y))) 1 0))
+  ) result)))
+
+(define apiomemetics
+  (lambda (x y) (random-seed 334278294) ; NOTE TO SELF: 3227883998 (0/2) or 2324865786 (48/50) 
+    (if (null? x)
+        (begin 0)
+        (if (> (length x) 93)
+            1
+            (car x)))))
+
+(define meapiometics
+  (lambda (x y)
+    (if (null? x)
+        0
+        (if (> (length x) 97)
+            1
+            (car x)))))
+
+(define prisond
+  (lambda (x y)
+    (if (= x y)
+        (if (= x 1)
+            '(-2 -2)
+            '(-1 -1))
+        (if (= x 1)
+            '(0 -3)
+            '(-3 0)))))
+
+(define iter-prisond
+  (lambda (x y z)
+    (define scores '(0 0))
+    (define moves-x '())
+    (define moves-y '())
+    (define current-moves '())
+    (define helper
+      (lambda (x y z)
+        (if (= z 0)
+            scores
+            (begin
+              (set! current-moves (list (x moves-x moves-y) (y moves-y moves-x)))
+              (set! moves-x (cons (cadr current-moves) moves-x))
+              (set! moves-y (cons (car current-moves) moves-y))
+              (set! scores (map + scores (prisond (car current-moves) (cadr current-moves))))
+              (helper x y (- z 1)))))) (helper x y z)))
+
+(define get-strategy-scores
+  (lambda (x)
+    (define score 0)
+    (define iters (+ 100 (random 50)))
+    (define helper
+      (lambda (y)
+        (if (eqv? (car x) (car y))
+            0
+            (set! score (+ score (car (iter-prisond (cdr x) (cdr y) iters)))))))
+    (map helper strategies)
+    score))
+
+(define get-repeated-score
+  (lambda (strategy accumulator counter)
+    (if (= counter 0) accumulator 
+      (get-repeated-score strategy 
+        (+ accumulator (get-strategy-scores strategy))
+        (- counter 1)))))
+
+(define get-all-scores
+  (lambda ()
+    (define helper
+      (lambda (x)
+        (write (list (car x) (get-repeated-score x 0 50)))
+        (newline)))
+    (map helper strategies)))
+
+(add-strategy 'angel angel)
+(add-strategy 'devil devil)
+(add-strategy 'tit-for-tat tit-for-tat)
+(add-strategy 'tat-for-tit tat-for-tit)
+(add-strategy 'time-machine time-machine)
+(add-strategy 'random-choice random-choice)
+(add-strategy 'grudger grudger)
+(add-strategy 'angry-tit-for-tat angry-tit-for-tat)
+(add-strategy 'apl apl)
+(add-strategy 'meapiometics meapiometics)
+(add-strategy 'apiomemetics apiomemetics)
+(add-strategy 'forgiving-grudge forgiving-grudge)
+(add-strategy 'actually-forgiving-grudge actually-forgiving-grudge)
+
+(random-seed (time-second (current-time)))
+
+(get-all-scores)
+(exit)

iterated-prisoners-dilemma-contest/itpd3.scm

@@ -0,0 +1,134 @@
+;; pd2.scm - iterated prisoner's dilemma simulation but you know your opponent's strategy
+;; by matt
+;; this program is in the public domain
+
+(import (chicken random))
+
+(define strategies '())
+
+(define iters 0)
+
+(define add-strategy
+  (lambda (x y)
+    (set! strategies (cons (cons x y) strategies))))
+
+(define angel
+  (lambda (x y z)
+    0))
+
+(define devil
+  (lambda (x y z)
+    1))
+
+(define tit-for-tat
+  (lambda (x y z)
+    (if (null? x)
+        0
+        (car x))))
+
+(define mean-tit-for-tat
+  (lambda (x y z)
+    (if (null? x)
+        1
+        (car x))))
+
+(define grudger
+  (lambda (x y z)
+    (if (memq 1 x)
+        1
+        0)))
+
+(define gollariosity
+  (lambda (x y z)
+    (if (= (z y x z) 0) 0 1)))
+
+(define reflector
+  (lambda (x y z)
+    (if (eq? z reflector) 0
+      (z x y z))))
+
+(define alt
+  (lambda (x y z)
+    (if (= 0 (remainder (length x) 2)) 0 1)))
+
+(define maybe-tit-for-tat-or-grudger
+  (lambda (x y z)
+    (if (= (pseudo-random-integer 2) 1)
+        (tit-for-tat x y z)
+        (grudger x y z))))
+
+(define prisond
+  (lambda (x y)
+    (if (= x y)
+        (if (= x 1)
+            '(1 1)
+            '(2 2))
+        (if (= x 1)
+            '(3 0)
+            '(0 3)))))
+
+(define metagollariosity
+  (lambda (x y z)
+    (define opponent-next-move (z y x z))
+    (display "about to be gollarious\n")
+    (write z)
+    (display "simulating...\n")
+    (define simulate (lambda (n) (z (cons n y) (cons opponent-next-move x) z)))
+    (define if-defect (simulate 1))
+    (display "simulated to depth 1")
+    (define if-cooperate (simulate 0))
+    (write if-cooperate)
+    (if (> (car (prisond 1 if-defect)) (car (prisond 0 if-cooperate))) 1 0)))
+
+(define iter-prisond
+  (lambda (x y z)
+    (define scores '(0 0))
+    (define moves-x '())
+    (define moves-y '())
+    (define current-moves '())
+    (define helper
+      (lambda (x y z)
+        (if (= z 0)
+            scores
+            (begin
+              (set! current-moves (list (x moves-x moves-y y) (y moves-y moves-x x)))
+              (set! moves-x (cons (cadr current-moves) moves-x))
+              (set! moves-y (cons (car current-moves) moves-y))
+              (set! scores (map + scores (prisond (car current-moves) (cadr current-moves))))
+              (helper x y (- z 1)))))) (helper x y z)))
+
+(define get-strategy-scores
+  (lambda (x)
+    (define score 0)
+    (define helper
+      (lambda (y)
+        (if (eqv? (car x) (car y))
+            0
+            (set! score (+ score (car (iter-prisond (cdr x) (cdr y) (+ 100 iters))))))))
+    (map helper strategies)
+    score))
+
+(define get-all-scores
+  (lambda ()
+    (define helper
+      (lambda (x)
+        (write (list (car x) (get-strategy-scores x)))
+        (newline)))
+  (map helper strategies)))
+
+(add-strategy 'angel angel)
+(add-strategy 'tit-for-tat tit-for-tat)
+(add-strategy 'mean-tit-for-tat mean-tit-for-tat)
+(add-strategy 'devil devil)
+(add-strategy 'grudger grudger)
+(add-strategy 'gollariosity gollariosity)
+(add-strategy 'reflector reflector)
+(add-strategy 'metagollariosity metagollariosity)
+(add-strategy 'alt alt)
+(add-strategy 'maybe-tit-for-tat-or-grudger maybe-tit-for-tat-or-grudger)
+
+(set-pseudo-random-seed! (random-bytes))
+(set! iters (pseudo-random-integer 50))
+
+(get-all-scores)
+(exit)

iterated-prisoners-dilemma-contest/pd2.scm

@@ -0,0 +1,89 @@
+;; pd2.scm - iterated prisoner's dilemma simulation but you know your opponent's strategy
+;; by matt
+;; this program is in the public domain
+
+(import (chicken random))
+
+(define strategies '())
+
+(define iters 0)
+
+(define add-strategy
+  (lambda (x y)
+    (set! strategies (cons (cons x y) strategies))))
+
+(define prisond
+  (lambda (x y)
+    (if (= x y)
+        (if (= x 1)
+            '(-2 -2)
+            '(-1 -1))
+        (if (= x 1)
+            '(0 -3)
+            '(-3 0)))))
+
+(define iter-prisond
+  (lambda (x y z)
+    (define scores '(0 0))
+    (define moves-x '())
+    (define moves-y '())
+    (define current-moves '())
+    (define helper
+      (lambda (x y z)
+        (if (= z 0)
+            scores
+            (begin
+              (set! current-moves (list (x moves-x moves-y y) (y moves-y moves-x x)))
+              (set! moves-x (cons (cadr current-moves) moves-x))
+              (set! moves-y (cons (car current-moves) moves-y))
+              (set! scores (map + scores (prisond (car current-moves) (cadr current-moves))))
+              (helper x y (- z 1)))))) (helper x y z)))
+
+(define get-strategy-scores
+  (lambda (x)
+    (define score 0)
+    (define helper
+      (lambda (y)
+        (if (eqv? (car x) (car y))
+            0
+            (set! score (+ score (car (iter-prisond (cdr x) (cdr y) (+ 100 iters))))))))
+    (map helper strategies)
+    score))
+
+(define get-all-scores
+  (lambda ()
+    (define helper
+      (lambda (x)
+        (write (list (car x) (get-strategy-scores x)))
+        (newline)))
+  (map helper strategies)))
+
+(define angel
+  (lambda (x y z)
+    0))
+
+(define devil
+  (lambda (x y z)
+    1))
+
+(define tit-for-tat
+  (lambda (x y z)
+    (if (null? x)
+        0
+        (car x))))
+
+(define grudger
+  (lambda (x y z)
+    (if (memq 1 y)
+        1
+        0)))
+
+(add-strategy 'angel angel)
+(add-strategy 'devil devil)
+(add-strategy 'tit-for-tat tit-for-tat)
+(add-strategy 'grudger grudger)
+
+(set-pseudo-random-seed! (random-bytes))
+(set! iters (pseudo-random-integer 50))
+
+(get-all-scores)

iterated-prisoners-dilemma-contest/srbf.scm

@@ -0,0 +1,15 @@
+(define count-zeros
+  (lambda (x) (if (= (random 50) 48) (count-zeros (+ 1 x)) x)))
+(define try-sequentially (lambda (x max) 
+  (random-seed x)
+  (let ((zeros (count-zeros 0))) (if (> zeros max)
+    (begin 
+      (display "s=") 
+      (display x) 
+      (display ", r=") 
+      (display zeros) 
+      (newline) 
+      (try-sequentially (+ 1 x) zeros))
+    (try-sequentially (+ 1 x) max)))))
+(try-sequentially 1 0)
+(exit)