#| This CommonLisp program in the file ramsey-upper-limit.lisp may be used according to the GNU General Public Licence. (c) Manfred Kerber, Colin Rowat, University of Birmingham, England The version of this file is 0.91, 1 April 2009 Compared to version 0.9 all upper values of the paper were added. A bug corrected. It can be found as http://www.cs.bham.ac.uk/~mmk/demos/ramsey-upper-limit.lisp IT COMES WITHOUT ANY WARRANTEE WHATSOEVER. IT MUST NOT BE USED IN ANY SAFETY CRITICAL APPLICATION. The procedure r computes an UPPER BOUND of the Ramsey number according to Stanislaw P. Radziszowski's paper on "Small Ramsey Numbers" THE ELECTRONIC JOURNAL OF COMBINATORICS (2006), DS1.11 The arguments to R(a1,a2,...,an) are given to r as a list, that is, you call (r '(a1 a2 ... an)) We would like to thank Prof Radziszowski for helping us in understanding the subtleties of finding tight bounds. Any remaining errors, insufficiencies, etc. of the code are exclusively ours. If you find any bugs please send an email to M.Kerber at cs dot bham dot ac dot uk. |# (defvar a) ;;; To hold a hashtable with the Ramsey numbers for memoization ;;; Note: we never delete from the hashtable. (defun n-0-vec(n) ;;; generates a vector of zeros of length n (let ((res nil)) (dotimes (i n) (setq res (cons 0 res))) res)) (defun n-1-vec(n) ;;; generates a vector of ones of length n (let ((res nil)) (dotimes (i n) (setq res (cons 1 res))) res)) (defun nonz-even(n) ;;; true if and only if n is an even number unequal 0. (if (and (not (= n 0)) (= (mod n 2) 0)) t nil)) (defun first-non-zero(list) ;;; computes in a list of numbers the position of the first non-zero element, ;;; e.g. '(0 0 0 1 1 1) --> 3 (cond ((null list) nil) ((not (= (car list) 0)) 0) ((and (= (car list) 0) (first-non-zero (cdr list))) (1+ (first-non-zero (cdr list)))) (t nil))) (defun r1(list l) ;;; Auxiliary procedure, assumes that list is sorted (smallest first). ;;; l the length of the list (let* ((fnz (first-non-zero list))) (cond ((= fnz (1- l)) 0) ;;; if it's all zeros except one the result is 0 ((and fnz (= (nth fnz list) 1)) 1) ;;; if there is a one in the list then the result is 1 ((and fnz (not (= fnz (- l 2))) (= (nth fnz list) 2)) (setf (nth fnz list) 0) (r1 list l)) ;;; if there is a 2 in the list then the first 2 can be changed to a zero ;;; assumed it is not the second last element ((gethash list a) (gethash list a)) ;;; if the value has been computed previously, look it up in the hashtable (t (setf (gethash list a) ;;; else compute it (let ((non-zero-counter 0) (auxlist nil) (one-even nil) ;;; looks whether one of the summands is even (sum 0)) (if (= (- (length list) 2) 0) 0 ;;; i.e., the list is zero except possibly for the last element (progn (dotimes (pos l) (setq auxlist (copy-list list)) ;;; computes the sum according to ;;; equation (a) on page 25 of [Radziszowski06] (if (not (= (nth pos auxlist) 0)) (progn (setq non-zero-counter (1+ non-zero-counter)) (setf (nth pos auxlist) (1- (nth pos auxlist))) (setq auxlist (sort auxlist '<)) (setq sum (+ sum (r1 auxlist l))) (if (nonz-even (r1 auxlist l)) (setq one-even t))))) (setq sum (+ sum 2 (- non-zero-counter))) (if (and (nonz-even sum) one-even) (1- sum) sum))))))))) (defun set-special(length list a value) (setf (gethash (append (n-0-vec length) list) a) value)) (defun r(list) ;;; computes an upper bound of the Ramsey number ;;; e.g. (r '(4 4 4 4 4 4)) --> 19100738 ;;; i.e. R(4,4,4,4,4,4) <= 19100738. (setq list (sort list '<)) (setq a (make-hash-table :test #'equal :size 1009 :rehash-size (/ pi 2) :rehash-threshold 0.6)) ;;; an initial hashtable (let* ((l (max 4 (length list))) ;;; since some special values are explicitly stored the minimal length ;;; of the list must be 4. If it is not, zeros will be prefixed accordingly (1-vec (n-0-vec l))) (if (< (length list) l) (setq list (append (n-0-vec (- l (length list))) list))) ;;; the next 3 lines set all expressions of type R(0,i)=0 (setf (nth (- l 2) 1-vec) 0) (dotimes (i (car (last list))) (progn (setf (nth (1- l) 1-vec) (1+ i)) (setf (gethash 1-vec a) 0))) ;;; the next 3 lines set all expressions of type R(1,i)=1 (setf (nth (- l 2) 1-vec) 1) (dotimes (i (car (last list))) (progn (setf (nth (1- l) 1-vec) (1+ i)) (setf (gethash 1-vec a) 1))) ;;; the next 3 lines set all expressions of type R(2,i)=i (setf (nth (- l 2) 1-vec) 2) (dotimes (i (car (last list))) (progn (setf (nth (1- l) 1-vec) (1+ i)) (setf (gethash 1-vec a) (1+ i)))) ;;; Some special two-colour values from the paper ;;; (p.4) of [Radziszowski06] (set-special (- l 2) '(3 3) a 6) ;;; R(3,3) = 6 (set-special (- l 2) '(3 4) a 9) ;;; R(3,4) = 9 (set-special (- l 2) '(3 5) a 14) ;;; R(3,5) = 14 (set-special (- l 2) '(3 6) a 18) ;;; R(3,6) = 18 (set-special (- l 2) '(3 7) a 23) ;;; R(3,7) = 23 (set-special (- l 2) '(3 8) a 28) ;;; R(3,8) = 28 (set-special (- l 2) '(3 9) a 36) ;;; R(3,9) = 36 (set-special (- l 2) '(3 10) a 43) ;;; R(3,10) <= 43 (set-special (- l 2) '(3 11) a 51) ;;; R(3,11) <= 51 (set-special (- l 2) '(3 12) a 59) ;;; R(3,12) <= 59 (set-special (- l 2) '(3 13) a 69) ;;; R(3,13) <= 69 (set-special (- l 2) '(3 14) a 78) ;;; R(3,14) <= 78 (set-special (- l 2) '(3 15) a 88) ;;; R(3,15) <= 88 (set-special (- l 2) '(4 4) a 18) ;;; R(4,4) = 18 (set-special (- l 2) '(4 5) a 25) ;;; R(4,5) = 25 (set-special (- l 2) '(4 6) a 41) ;;; R(4,6) <= 41 (set-special (- l 2) '(4 7) a 61) ;;; R(4,7) <= 61 (set-special (- l 2) '(4 8) a 84) ;;; R(4,8) <= 84 (set-special (- l 2) '(4 9) a 115) ;;; R(4,9) <= 115 (set-special (- l 2) '(4 10) a 149) ;;; R(4,10) <= 149 (set-special (- l 2) '(4 11) a 191) ;;; R(4,11) <= 191 (set-special (- l 2) '(4 12) a 238) ;;; R(4,12) <= 238 (set-special (- l 2) '(4 13) a 291) ;;; R(4,13) <= 291 (set-special (- l 2) '(4 14) a 349) ;;; R(4,14) <= 349 (set-special (- l 2) '(4 15) a 417) ;;; R(4,15) <= 417 (set-special (- l 2) '(5 5) a 49) ;;; R(5,5) <= 49 (set-special (- l 2) '(5 6) a 87) ;;; R(5,6) <= 87 (set-special (- l 2) '(5 7) a 143) ;;; R(5,7) <= 143 (set-special (- l 2) '(5 8) a 216) ;;; R(5,8) <= 216 (set-special (- l 2) '(5 9) a 316) ;;; R(5,9) <= 316 (set-special (- l 2) '(5 10) a 442) ;;; R(5,10) <= 442 (set-special (- l 2) '(5 12) a 848) ;;; R(5,12) <= 848 (set-special (- l 2) '(5 14) a 1461) ;;; R(5,14) <= 1461 (set-special (- l 2) '(6 6) a 165) ;;; R(6,6) <= 165 (set-special (- l 2) '(6 7) a 298) ;;; R(6,7) <= 298 (set-special (- l 2) '(6 8) a 495) ;;; R(6,8) <= 495 (set-special (- l 2) '(6 9) a 780) ;;; R(6,9) <= 780 (set-special (- l 2) '(6 10) a 1171) ;;; R(6,10) <= 1171 (set-special (- l 2) '(6 12) a 2566) ;;; R(6,12) <= 2566 (set-special (- l 2) '(6 14) a 5033) ;;; R(6,14) <= 5033 (set-special (- l 2) '(7 7) a 540) ;;; R(7,7) <= 540 (set-special (- l 2) '(7 8) a 1031) ;;; R(7,8) <= 1031 (set-special (- l 2) '(7 9) a 1713) ;;; R(7,9) <= 1713 (set-special (- l 2) '(7 10) a 2826) ;;; R(7,10) <= 2826 (set-special (- l 2) '(7 11) a 4553) ;;; R(7,11) <= 4553 (set-special (- l 2) '(7 12) a 6954) ;;; R(7,12) <= 6954 (set-special (- l 2) '(7 13) a 10581) ;;; R(7,13) <= 10581 (set-special (- l 2) '(7 14) a 15263) ;;; R(7,14) <= 15263 (set-special (- l 2) '(7 15) a 22116) ;;; R(7,15) <= 22116 (set-special (- l 2) '(8 8) a 1870) ;;; R(8,8) <= 1870 (set-special (- l 2) '(8 9) a 3583) ;;; R(8,9) <= 3583 (set-special (- l 2) '(8 10) a 6090) ;;; R(8,10) <= 6090 (set-special (- l 2) '(8 11) a 10630) ;;; R(8,11) <= 10630 (set-special (- l 2) '(8 12) a 16944) ;;; R(8,12) <= 16944 (set-special (- l 2) '(8 13) a 27490) ;;; R(8,13) <= 27490 (set-special (- l 2) '(8 14) a 41525) ;;; R(8,14) <= 41525 (set-special (- l 2) '(8 15) a 63620) ;;; R(8,15) <= 63620 (set-special (- l 2) '(9 9) a 6588) ;;; R(9,9) <= 6588 (set-special (- l 2) '(9 10) a 12677) ;;; R(9,10) <= 12677 (set-special (- l 2) '(9 11) a 22325) ;;; R(9,11) <= 22325 (set-special (- l 2) '(9 12) a 39025) ;;; R(9,12) <= 39025 (set-special (- l 2) '(9 13) a 64871) ;;; R(9,13) <= 64871 (set-special (- l 2) '(9 14) a 89203) ;;; R(9,14) <= 89203 (set-special (- l 2) '(10 10) a 23556) ;;; R(10,10) <= 23556 (set-special (- l 2) '(10 12) a 81200) ;;; R(10,12) <= 81200 ;;; The three special more-colour values from the paper ;;; (p.25) of [Radziszowski06] (set-special (- l 3) '(3 3 3) a 17) ;;; R(3,3,3) = 17 (set-special (- l 3) '(3 3 4) a 31) ;;; R(3,3,4) <= 31 (set-special (- l 4) '(3 3 3 3) a 62) ;;; R(3,3,3,3) <= 62 (r1 list l))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;; END ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;