| 1 | (defun decode-percent-table (table) |
| 2 | (let ((base 0)) |
| 3 | (mapcar (lambda (i) |
| 4 | (prog1 |
| 5 | (cons (- (car i) base) (cdr i)) |
| 6 | (setf base (car i)))) |
| 7 | table))) |
| 8 | |
| 9 | (defparameter weapons |
| 10 | '(( 9 "Axe, battle") |
| 11 | ( 15 "Axe, hand") |
| 12 | ( 17 "Axe, hand (returning)") |
| 13 | ( 20 "Blackjack") |
| 14 | ( 22 "Bola") |
| 15 | ( 23 "Bola (returning)") |
| 16 | ( 28 "Club") |
| 17 | ( 40 "Dagger") |
| 18 | ( 43 "Dagger (returning)") |
| 19 | ( 53 "Hammer, war") |
| 20 | ( 56 "Hammer, war (returning)") |
| 21 | ( 59 "Javelin") |
| 22 | ( 60 "Javelin (returning)") |
| 23 | ( 64 "Lance") |
| 24 | ( 76 "Mace") |
| 25 | ( 78 "Net") |
| 26 | ( 79 "Net (returning)") |
| 27 | ( 84 "Polearm") |
| 28 | ( 94 "Spear") |
| 29 | ( 97 "Spear (returning)") |
| 30 | (100 "Whip"))) |
| 31 | |
| 32 | (defparameter new-weapons |
| 33 | '((9 "D" "Axe, battle") |
| 34 | (6 "B" "Axe, hand") |
| 35 | (2 "B" "Axe, hand (returning)") |
| 36 | (3 "C" "Blackjack") |
| 37 | (2 "B" "Bola") |
| 38 | (1 "B" "Bola (returning)") |
| 39 | (5 "C" "Club") |
| 40 | (12 "B" "Dagger") |
| 41 | (3 "B" "Dagger (returning)") |
| 42 | (4 "C" "Flail, one-handed") |
| 43 | (2 "D" "Flail, two-handed") |
| 44 | (3 "D" "Halberd") |
| 45 | (10 "C" "Hammer, war") |
| 46 | (3 "B" "Javelin") |
| 47 | (1 "B" "Javelin (returning)") |
| 48 | (4 "D" "Lance") |
| 49 | (7 "C" "Mace") |
| 50 | (5 "C" "Morning star") |
| 51 | (2 "B" "Net") |
| 52 | (1 "B" "Net (returning)") |
| 53 | (3 "D" "Pike") |
| 54 | (2 "D" "Pole axe") |
| 55 | (10 "B" "Spear") |
| 56 | (3 "B" "Spear (returning)") |
| 57 | (3 "C" "Whip"))) |
| 58 | |
| 59 | (defun normalize-percent-table (table) |
| 60 | (let* ((max (reduce #'+ (mapcar #'car table))) |
| 61 | (aug (mapcar (lambda (i) |
| 62 | (let* ((ideal (* 100 (/ (car i) max))) |
| 63 | (actual (max 1 (round ideal)))) |
| 64 | (list* (- actual ideal) actual (cdr i)))) |
| 65 | table)) |
| 66 | (tot (reduce #'+ (mapcar #'cadr aug)))) |
| 67 | (loop |
| 68 | (let ((dir (signum (- 100 tot))) |
| 69 | (best nil) |
| 70 | (best-diff nil) |
| 71 | (nbest 0)) |
| 72 | (when (zerop dir) |
| 73 | (return)) |
| 74 | (dolist (i aug) |
| 75 | (when (> (cadr i) 1) |
| 76 | (let ((diff (abs (- (car i) dir)))) |
| 77 | (cond ((or (null best-diff) (< diff best-diff)) |
| 78 | (setf best-diff diff |
| 79 | best i |
| 80 | nbest 1)) |
| 81 | ((and (= diff best-diff) |
| 82 | (zerop (random (1+ nbest)))) |
| 83 | (setf best i) |
| 84 | (incf nbest)))))) |
| 85 | (unless best |
| 86 | (error "Can't normalize this table!")) |
| 87 | (decf (car best) dir) |
| 88 | (incf (cadr best) dir) |
| 89 | (incf tot dir))) |
| 90 | (mapcar #'cdr aug))) |
| 91 | |
| 92 | (defun print-percent-table (table) |
| 93 | (let* ((rangetab (let ((base 1)) |
| 94 | (flet ((percentage (n) |
| 95 | (format nil "~@2,,,'0A" |
| 96 | (if (= n 100) 0 n)))) |
| 97 | (mapcar (lambda (i) |
| 98 | (prog1 |
| 99 | (cons (if (= (car i) 1) |
| 100 | (format nil " ~A " |
| 101 | (percentage base)) |
| 102 | (format nil "~A--~A" |
| 103 | (percentage base) |
| 104 | (percentage (+ base |
| 105 | (car i) |
| 106 | -1)))) |
| 107 | (mapcar #'princ-to-string |
| 108 | (cdr i))) |
| 109 | (incf base (car i)))) |
| 110 | table)))) |
| 111 | (widths (reduce (lambda (acc item) |
| 112 | (format t "*** ~S~%" item) |
| 113 | (mapcar #'max acc (mapcar #'length item))) |
| 114 | rangetab |
| 115 | :initial-value (mapcar (constantly 0) |
| 116 | (car rangetab)))) |
| 117 | (linesep nil)) |
| 118 | (dolist (item rangetab) |
| 119 | (when linesep |
| 120 | (write-string " \\\\ \\hlx{+}") |
| 121 | (terpri)) |
| 122 | (write-string " ") |
| 123 | (loop with sep = nil |
| 124 | for w in widths |
| 125 | and i in item |
| 126 | when sep do (format t " & ") |
| 127 | do (format t "~vA" w i) |
| 128 | (setf sep t)) |
| 129 | (setf linesep t)) |
| 130 | (when linesep |
| 131 | (write-string " \\\\ \\hlx*{vh}") |
| 132 | (terpri)))) |