• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Betapocalypse: Marriage age gap vs polygamy

a guest Dec 9th, 2016 155 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. #!/usr/bin/newlisp -n
2.
3. ;;; marriage-age-gap-simulation.lsp Copyright (c) 2016 Mycroft Jones
4. ;;;
5. ;;; to run: newlisp.exe marriage-age-gap-simulation.lsp
6. ;;;
7. ;;; The polygamy problem: If some men have more than one wife, other men will
8. ;;; have to go without!  Is this problem real?  Or does it depend on false
9. ;;; assumptions?
10. ;;;
11. ;;; Assuming an age gap between the age at which men and women marry, how many
12. ;;; men can have 2 wives?
13. ;;;
14. ;;; Assuming every man has a certain number of wives, what age gap is required?
15. ;;; Also, how many times will a woman marry, compared to a man?
16. ;;;
17. ;;; First model:
18. ;;;   * everyone lives their full lifespan
19. ;;;   * no abortions, miscarriages, murders
20. ;;;   * marriage is for life, no divorce
21. ;;;   * if father is over 40, female birthrate goes to 0.6408
22.
23. (define (ratio a b) (div a (add a b))) ; transforms a ratio a:b to a decimal fraction
24.
25. (define maxwives 2)
26. (define male-age-of-death 72) ; 72
27. (define female-age-of-death 79)
28. (define male-age-of-majority 18)
29. (define female-age-of-majority 16)
30. (define female-age-of-menopause 42)
31. (define female-age-of-widowhood 60)
32. (define male-birth-ratio (ratio 1 1.05))
33. (define ratio-after-40 0.6408)
34. (define average-number-of-children-per-woman 8)
35. (define birth-odds (div average-number-of-children-per-woman
36.                         (sub female-age-of-menopause female-age-of-majority)))
37.
38. (context '/dev/urandom)
39. (define max-32bit-int 4294967295)
40. (set 'fd (open "/dev/urandom" "read"))
41. (define (/dev/urandom:/dev/urandom)
43.   (div (max 1 (first (unpack "lu" buf))) max-32bit-int))
44. (context MAIN)
45.
46. (define-macro (nq a b) (eval (list 'push a b -1)))
47. (define-macro (\$# a) (-- (length (eval a)))) ; index of last element in a list, just like in Perl
48.
49. (define males (list))
50. (define females (list))
51. (define everyone (list)) ; (m birthyear ((wife-id marriage-year) ...) (child-id ...) deathyear (current-wives))
52.                          ; (f birthyear ((husband-id marriage-year) ...) (child-id ...) deathyear current-husband)
53.
54. (define (age x) (- yr (everyone x 1)))
55.
56. ;; yearly stats
57. (define mdeaths 0) ; male deaths
58. (define fdeaths 0) ; female deaths
59. (define mbirths 0) ; male births
60. (define fbirths 0) ; female births
61. (define mages 0)   ; used to calculate average male age at marriage
62. (define fages 0)   ; used to calculate average female age at marriage
63. (define nmarriages 0) ; number of marriages
64.
65. (define initialize-population
66.   (lambda ()
67.     (dotimes (yr (max male-age-of-majority female-age-of-majority))
68.       (nq (list 'm yr '() '() nil '()) everyone)
69.       (nq (+ -1 (length everyone)) males)
70.       (nq (list 'f yr '() '() nil nil) everyone)
71.       (nq (+ -1 (length everyone)) females)
72.     )))
73.
74. ;; married women can give birth between ages of 18 and 44
75. ;; average number of children, 5
76. ;; let's say a 1 in 5 chance of giving birth in any given year
77.
78. (define (do-births yr)
79.   (letn (bfemales (filter (fn (x) (and (everyone x 5) (> (age x) female-age-of-majority) (< (age x) female-age-of-menopause) (< (/dev/urandom) birth-odds))) females)
80.          gfemales (filter (fn (x) (< (/dev/urandom) (if (< (age x) 40) male-birth-ratio ratio-after-40))) bfemales)
81.          mfemales (difference bfemales gfemales)
82.          leveryone (+ -1 (length everyone)))
83.     (dotimes (i (length mfemales)) (push (list 'm yr '() '() nil '()) everyone -1) (push (++ leveryone) males -1))
84.     (dotimes (i (length gfemales)) (push (list 'f yr '() '() nil nil) everyone -1) (push (++ leveryone) females -1))
85.     (++ mbirths (length mfemales))
86.     (++ fbirths (length gfemales))))
87.
88. (define (do-deaths yr)
89.   (let (dmales   (filter (fn (y) (> (age y) male-age-of-death)) males)
90.         dfemales (filter (fn (y) (> (age y) female-age-of-death)) females))
91.     (set 'males (difference males dmales))
92.     (set 'females (difference females dfemales))
93.     (set 'mdeaths (length dmales))
94.     (set 'fdeaths (length dfemales))
95.     (dolist (m dmales)
96.       (setf (everyone m 4) yr)
97.       (dolist (w (everyone m 5)) (setf (everyone w 5) nil))
98.     )
99.     (dolist (f dfemales)
100.       (setf (everyone f 4) yr)
101.       (let (h (everyone f 5))
102.         (when h
103.           (setf (everyone h 5)
104.               (clean (fn (x) (= x f)) (everyone h 5)))) ; free up husband to take another wife
105.       )
106.     )
107.   )
108. )
109.
110. (define (do-marriages yr)
111.   (let (smales (filter (fn (x) (and (< (length (everyone x 5)) maxwives) (> (age x) male-age-of-majority))) males)
112.         sfemales (clean (fn (x) (or (everyone x 5) (< (age x) female-age-of-majority) (> (age x) female-age-of-widowhood))) females))
113.   (catch (dolist (m smales)
114.     (when (empty? sfemales) (throw))
115.     (let (f (pop sfemales))
116.       (push f (everyone m 5))
117.       (setf (everyone f 5) m)
118.       (++ fages (age f))
119.       (++ mages (age m))
120.       (++ nmarriages)
121.   )))))
122.
123. (define (print-year yr)
124.   (println (format "Year %d. population %d (m: %d f: %d) %d births (m: %d f: %d) %d deaths (m: %d f: %d) %d marriages (m: %d f: %d)"
125.     yr
126.     (+ (length males) (length females)) (length males) (length females)
127.     (+ mbirths fbirths) mbirths fbirths
128.     (+ mdeaths fdeaths) mdeaths fdeaths
129.     nmarriages (round (div mages nmarriages)) (round (div fages nmarriages))
130.   ))
131.   (set 'mdeaths 0 'fdeaths 0 'mbirths 0 'fbirths 0 'mages 0 'fages 0 'nmarriages 0))
132.
133. (initialize-population)
134. (define (do-year yr)
135.       (when (and (< 0 (length males)) (< 0 (length females)))
136.       (do-births yr)
137.       (do-deaths yr)
138.       (do-marriages yr)
139.       (print-year yr)))
140.
141. (for (yr male-age-of-majority 1000)
142.      (do-year yr))
143.
144. (exit)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Top