THE
PAST
MASTER
CLUB
PINKPANTHER.LSP
To see a detailed table, click here ;;;;;;;;;;;;;;;;;;;;;;; START.BAT ;;;;;;;;;;;;;;;;;;; --c:\n\nic4\pink.bat-- @echo off set lispheap=40000 set lispstack=80000 del *.bak del lsp\*.bak lisp lsp\pnkpnthr.lsp del *.bak del lsp\*.bak set lispheap= set lispstack= ;;;;;;;;;;;;;;;;;;;;;;;;; INIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic4\lsp\pnkpnthr.lsp-- (defun logic() ;1:24:31 -TANDY:APR/97 (setq wr nil pl 0 oo 'PINKPANTHER) (setq z 0 ts 0 ot 't zp 0) (defun tm() (when ot (setq z (-(/(get-internal-run-time) internal-time-units-per-second)zp)) (setq z1 (- z ts)) (setq ts z) (setq i(truncate z 3600)) (setq z(- z (* 3600 i))) (setq j(truncate z 60)) (setq z(- z -0.5 (* 60 j))) (setq w(truncate z 1)) (setq y1(truncate z1 60)) (setq z1(- z1 -0.5 (* 60 y1))) (setq z1(truncate z1 1)) (format t "~1,56tTIME ~d:~2,d:~2,d << ~2,@d~a~2,d~a" i j w y1 "'" z1 (int-char 34)) )) (unless (fboundp 'strcat) (defun strcat (&rest str) (apply #'concatenate 'string str)) ) (defun rtn() (setq oc 't ot 't oj 0 op 0 q 4 p 1) ;see screenl program (auto) ) (setq l 5 n 17 k(- n 1) lk(* l k) ks (+(* lk lk)3) kl (+ lk 1)) (setq km(+(* l n)1) flags nil p 0 xt 1) (setq listitle '( ;3 char titles (1 tim) ;time (2 itm) ;item (3 bev) ;beverage (4 htl) ;hotel (5 wlk) ;walk (6 dnr) ;diner (7 col) ;diner-color (8 sgn) ;diner-sign (9 vst) ;visits (10 amt) ;morning-appointment (11 pmt) ;afternoon-appointment (12 evt) ;event (13 flr) ;hotel-floor (14 lcl) ;local-calls (15 ins) ;in-calls (16 ots) ;out-calls (17 nam) ;suspect-name (18 end) ;spare-flag )) (setq listij '( ;3 char sub title list (tim (6:3 i 1) ;6:30 (7:0 i 2) ;7:00 (7:3 i 3) ;7:30 (8:0 i 4) ;8:00 (8:3 i 5) ;8:30 ) (itm (bks i 6 j 80) ;books (gum i 7 j 79) ;gum (mag i 8 j 78) ;magazine (map i 9 j 77) ;map (ppr i 10 j 76) ;paper ) (bev (cff i 11 j 75) ;coffee (cco i 12 j 74) ;coccoa (jce i 13 j 73) ;juice (mlk i 14 j 72) ;milk (tea i 15 j 71) ;tea ) (htl (CEN i 16 j 70) ;CENTURY HOTEL (MRY i 17 j 69) ;MERCURY (PLC i 18 j 68) ;PALACE (QGL i 19 j 67) ;QUINCY (STN i 20 j 66) ;STATION ) (wlk (w3 i 21 j 65) ;3 km walk (w7 i 22 j 64) ;7 (w11 i 23 j 63) ;11 (w14 i 24 j 62) ;13 (w18 i 25 j 61) ;18 ) (dnr (BMB i 26 j 60) ;BAMBAM DINER (LEP i 27 j 59) ;LE PUE (MRL i 28 j 58) ;MARYLIN (NCK i 29 j 57) ;NICK DINER (OLV i 30 j 56) ;OLYVERA ) (col (blu i 31 j 55) ;blue (crm i 32 j 54) ;yellow (grn i 33 j 53) ;gren (rus i 34 j 52) ;rustic (wht i 35 j 51) ;offwhite ) (sgn (cat i 36 j 50) ;cat (flw i 37 j 49) ;boquet (stg i 38 j 48) ;deerhorns (car i 39 j 47) ;mercedese (yht i 40 j 46) ;yatch ) (vst (v1 i 41 j 45) ;1st (v2 i 42 j 44) ;2nd (v3 i 43 j 43) ;3rd (v5 i 44 j 42) ;5th (v6 i 45 j 41) ;6th ) (amt (ART i 46 j 40) ;AURTHUR-MURRAY ASSOC. -morning (CAS i 47 j 39) ;CASANDRA INC. (TAY i 48 j 38) ;TALORS (TOM i 49 j 37) ;TOMPSONS (TOR i 50 j 36) ;TORNADO CO. ) (pmt (RTC i 51 j 35) ;AURTHUE-MURRAY -afternoon (AST i 52 j 34) ;CASANDRA INC. (AYL i 53 j 33) ;TAYLORS (OMP i 54 j 32) ;TOMPSONS (ORS i 55 j 31) ;TORNADO CO. ) (evt (bsk i 56 j 30) ;basketball (mov i 57 j 29) ;movie (mus i 58 j 28) ;musical (opr i 59 j 27) ;opera (pla i 60 j 26) ;little-theatre ) (flr (f3 i 61 j 25) ;3rd floor (f12 i 62 j 24) ;12th flr (f27 i 63 j 23) ;27th (f32 i 64 j 22) ;32nd (f40 i 65 j 21) ;30th ) (lcl (l2 i 66 j 20) ;2 local phone calls (l3 i 67 j 19) ;3 (l4 i 68 j 18) ;4 (l6 i 69 j 17) ;6 (l7 i 70 j 16) ;7 ) (ins (i4 i 71 j 15) ;4 phond calls in (i5 i 72 j 14) ;5 (i7 i 73 j 13) ;7 (i8 i 74 j 12) ;8 (i9 i 75 j 11) ;9 ) (ots (o6 i 76 j 10) ;6 phone calls out (o7 i 77 j 9) ;7 (o8 i 78 j 8) ;8 (o9 i 79 j 7) ;9 (o10 i 80 j 6) ;10 ) (nam (GER j 1) ;GERMAIN (BEN j 2) ;BEN (ALX j 3) ;ALEXIS (DES j 4) ;DESSI (MAX j 5) ;MAX ) (end (spare1 i ks j ks ) ;3 UNITS APART (spare2 i (+ ks l) j ks ) ) )) (setq listques '( ;question list (1 (flg tim 2 mag / cco)(mag)(cco = CEN)) ;ASSOCIATIVE TIME LIST (2 (flg tim 2 cff * ppr)(cff)(ppr = PLC)) ;(associatively==flg) ;The detective spotted the suspect drinking coffee just before (just==tim *) ; the suspect who was reading the morning paper at the PALACE. (3 (flg tim 2 gum / QGL)(gum)(QGL)) (4 (flg tim 2 map * STN)(map - tea)(STN)) (5 (flg tim 2 MRY * mlk)(MRY)(mlk)) (6 (flg tim 2 bks / jce)(bks)(jce)) (7 (flg wlk 3 BMB * flw / wht)(BMB - w11)(flw - w14)(wht)) (8 (flg wlk 2 grn * OLV)(grn - yht - w11)(OLV = cat - w14)) (9 (flg wlk 2 stg * NCK)(stg - blu - w11)(NCK = crm - w14)) (10 (/)(MRL = w3)) ;(unassociatively a list=='(/)') (11 (flg lcl 2 f32 * i9)(f32 - l4)(i9 - l6)) (12 (flg ots 2 i9 * f32)(i9)(f32)) (13 (flg ins 2 o10 * f40)(o10 - i5)(f40 - i7)) (14 (flg lcl 2 f40 / o10)(f40)(o10)) (15 (flg ins 2 f27 / l4)(f27)(l4)) (16 (flg ots 2 f27 / l4)(f27)(l4)) (17 (flg lcl 2 i7 * f12)(i7 - l4)(f12 - l6)) (18 (flg ots 2 f12 * i7)(f12)(i7)) (19 (flg ins 2 f3 * l6)(f3 - i5)(l6 - i7)) (20 (flg ots 2 l6 * f3)(l6)(f3)) (21 (flg lcl 2 w18 / mov)(w18 = v1)(mov)) (22 (flg tim 2 blu * MAX)(blu)(MAX = PLC)) (23 (flg ins 2 bsk / GER)(bsk - i4 - i8 - i9)(GER = pla - cff - i4 - i5 - i8)) (24 (flg tim 2 f32 / BEN)(f32 = flw)(BEN = mlk))(25(flg tim 2 DES / LEP)(DES)(LEP)) (26 (flg vst 2 DES / LEP)(DES)(LEP)) (27 (flg ots 2 LEP * v3)(LEP)(v3)) (28 (/)(ALX = map - w7)(w7 = ORS)) (29 (flg vst 2 ART * RTC)(ART - opr - v3)(RTC - opr)) (30 (flg vst 2 mov * CAS)(mov - TAY - AYL - v3)(CAS - v5)) (31 (/)(ART - RTC)(CAS - AST)(TAY - AYL)(TOM - OMP)(TOR - ORS)(v6 = mus)(TOR = v5)(TAY = bsk - v6)(pla - v6 - v5 - v2)(v1 = OMP)(v5 - AYL)) (32 (/)(MAX = i9)(o10 - i7)) ;UNASSOCIATIVE LIST ;;[the last clue is the killer] )) (unless(fboundp 'strcat) (defun strcat(&rest str) (apply #'concatenate 'string str) )) (defun sp() (princ " ")) (defun nl()(terpri)) (defun pa()(do((i 1(1+ i)))((> i 24))(nl))) (pa) (defun o()(exit)) (defun type(x) (if wr (setq f(open x))) (do((i 0(1+ i)))((eq i 'eof)) (princ(read-line f)) (nl) ) ) (setq ot 't ui 0) (pa) (princ " LOGIC PUZZLES SOLVED! Nick K. Van Vliet, PO Box 92544 Carlton RPO., Toronto, Ont M5A 4N9\n\n") (princ (strcat "\n HI " "from " "NICK " "!!" " LOADING FILES: BE PATIENT")) (nl) (nl) (setq *print-case* :downcase) (setq c 97) (defun mmp(x)(if(eq x(int-char c))(setq zz 't)(setq zz nil))) (defun grid(x y)(+(*(- y 1) lk)(- x 1) )) (defun minp(x y)(* y(truncate(- x 0.5) y))) (defun minn(x y)(/(minp x y) -1)) (defun maxi(y)(+ lk(minn y l))) (defun maxid(y)(-(maxi y) l)) (defun limit(x y)(if(>(+ x y)(+ lk y(minn y l)))(setq z nil)(setq z 't))) (defun limitd(x y) (if (>(+ x y)(+(*(- k 1) l) y(minn y l)))(setq z nil)(setq z 't)) ) (defun imp(x y z) (princ " X= ") (princ(grid x y)) (setq ui(+ ui 1)) (setf(aref gridtbl (grid x y))'X) (setq z ks f nil) ) (defun fr(x y)(hv x y(int-char c))) (defun hv(x y z) (setq ui(+ ui 1) pl(+ pl 1)) (do((o 1(1+ o)))((> o l)) (setf(aref gridtbl (+(*(- (+ (minp y l) o) 1) lk) x -1))'-) (setf(aref gridtbl (+(*(- y 1)lk)(-(+ (minp x l) o) 1)))'-) ) (setf(aref gridtbl(grid x y)) z) (princ " hv= ") (princ z) (sp) ) (defun inteql(a b)(if(=(- a 1)(* b(truncate a b)))(setq z 1)(setq z 0))) (defun mmbrp(x y) (setq z nil) (cond ((= x(car y))(setq z 't)) ((cdr y)(mmbrp x(cdr y))) (t (setq z nil)) ) (setq z z) ) (setq gridtbl(make-array(+ ks kl l))) (defun setup() (do((j 1(1+ j)))((> j lk)) (do((i 1(1+ i)))((> i lk)) (if(limit i j) (setf(aref gridtbl(+(*(- j 1) lk)(- i 1) )) '+) (setf(aref gridtbl(+(*(- j 1) lk)(- i 1) ))" ") ))) (do((j 0(1+ j)))((> j lk)) (setf(aref gridtbl(+ ks j))'+) ) ) (setup) (defun screenl(u$) ;3 char labels to fit 80 char screen (setq gf(open (strcat "lsp\\" u$) :direction :output)) ;only the above line is different from LOGIC.LSP (defun ln(x) (if wr (princ(int-char 10) gf)) (if wr (princ "-----" gf)) (do((w 1(1+ w)))((> w (maxi x))) (when(=(inteql w l)1)(if wr (princ "*" gf))) (if wr (princ "-" gf)) ) (if wr (princ "*" gf)) ) (princ "\nNick\n") (if wr (princ "NICK |" gf)) (setq z "") (do((j 1(1+ j)))((> j(- l 3)))(setq z(strcat " " z))) (do((w 1(1+ w)))((> w k)) (princ(cadr(assoc w listitle))) (princ z) (if wr (princ(cadr(assoc w listitle)) gf)) (if wr (princ z gf)) (if wr (princ "|" gf)) ) (princ "logic\n") (if wr (princ(int-char 10) gf)) (if wr (princ "LOGIC" gf)) (do((w 0(1+ w)))((>= w lk)) (setq yy(+ 64 w)) (if(=(*(truncate w l) l)w)(if wr (princ "|" gf))) (princ(+ 1(- w(* 5(truncate w 5))))) (if wr (princ(+ 1(- w(* 5(truncate w 5)))) gf)) ) (if wr (princ "|" gf)) (setq cnt(+ 1(+ yy l))) (do((j 1(1+ j)))((> j lk)) (if(=(inteql j l)1) (progn (if(and(>= lk 80)(> j (+ 1 l)))(nl)) (princ(cadr(assoc(-(+ k 1)(truncate(- j 0.5) l))listitle))) (nl) (ln(- j 1)) (if wr (princ(int-char 10) gf)) (if wr (princ(cadr(assoc(-(+ k 1)(truncate(- j 0.5) l)) listitle)) gf)) (if wr (princ " " gf)) ) (progn (if(and(>= lk 80)(> j (+ 1 l)))(nl)) (if wr (princ(int-char 10) gf)) (if wr (princ " " gf))) ) (if(and(>= lk 80)(> j l)) (princ(+ 1(- cnt(* l(truncate cnt l)))))) (if wr (princ(+ 1(- cnt(* l(truncate cnt l)))) gf)) (setq cnt(- cnt 1)) (do((i 1(1+ i)))((> i(maxi j))) (if(=(inteql i l) 1)(if wr (princ "|" gf))) (princ(aref gridtbl(+(*(- j 1) lk)(- i 1)))) (if wr (princ(aref gridtbl(+(*(- j 1)lk)(- i 1) )) gf)) ) (if wr (princ "|" gf)) (when(and(> n 6)(= op 1)(= j(*(truncate n 4)l))) (princ"Hit enter") (read-line) ) (if(and(> p 0)(or(= q 0)(= q 2))(>= j l))(setq j ks)) (when(and(> p 0)(>= j 15)(= oj 1))(setq j ks)(if wr (close gf))) ) (ln lk) (if wr(close gf)) (when(= op 1)(print "Hit enter")(read-line)) (format t "\n ~a SOLUTION(~a) SCREEN DISPLAY ~a" oo u$ p) (tm) (nl) ) (defun id(x)(do ;id title ((w 1(1+ w)))((> w(+ n 1)))(setq ttl nil)(setq ttl(cadr(assoc w listitle))) (setq z(assoc x(cdr(assoc ttl listij))))(if z(setq w(* n n))(setq z nil))) (setq z ttl) ) (defun vl(x)(cdr(assoc x(cdr(assoc(id x) listij))))) ;value (x,y) (defun ij(x y) (cond ((equal y(car(vl x)))(setq z(eval(cadr(vl x))))) ((equal y(caddr(vl x)))(setq z(eval(cadddr(vl x))))) (t nil) ) ) (defun sum(x y) ;offset value (setq lij nil) (cond ((and(ij x 'j)(ij y 'i)(limit(ij x 'j)(ij y 'i))) (setq lij(list(ij y 'i)(ij x 'j))) (setq z(+(*(-(ij x 'j) 1) lk) -1(ij y 'i))) ) ((and(ij x 'i)(ij y 'j)(limit(ij x 'i)(ij y 'j))) (setq lij(list(ij x 'i)(ij y 'j))) (setq z(+(*(-(ij y 'j) 1) lk) -1(ij x 'i))) ) (t (setq z ks)) ) ) (defun sgn(w x y z) ;read question line of symbols (cond ((eq y '=) ;owns property (progn (cond ((id(car z)) (progn (setq a1(sum x(car z))) (hv(car lij)(cadr lij)(int-char c)) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) ((id(caar z)) (progn (setq a1(sum x(caar z))) (hv(car lij)(cadr lij)(int-char c)) (if(eq(cadar z)'-)(sgn w(caar z)'-(cddar z))) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) (t nil) ))) ((eq y '-) ;not its property (cond ((id(car z)) (progn (setf(aref gridtbl(sum x(car z)))(- w(* 10(truncate w 10)))) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) ((id(caar z)) (progn (setf(aref gridtbl(sum x(caar z)))(- w(* 10(truncate w 10)))) (if(eq(cadar z)'-)(sgn w(caar z)'-(cddar z))) (if(eq(cadr z)'-)(sgn w x '- (cddr z))) )) (t nil) )) (t nil)) ) (defun lup(x y) ;loop id search till done (setq nxt(cadr y)) (setq lenxt(length nxt)) (cond ((id(car nxt))(setq nxt(car nxt))) ((id(caar nxt))(setq nxt(caar nxt))) (t (setq nxt(car nxt))) ) (if(sum frst nxt) (setf(aref gridtbl(sum frst nxt))(- x(* 10(truncate x 10)))) ) (if(and f(cdr y))(lup x(cdr y))) ) (defun questn(x)(assoc x listques)) (defun questns(x y z) (setq frst(car y)) (setq lenfrst(length frst)) (if(> lenfrst 1)(progn(sgn x(car frst)(cadr frst)(cddr frst)))) (setq frst(car frst)) (if(and f(cdr y))(lup x y)) (if(cdr y)(questns x(cdr y)(- z 1))) ) (defun mask(x y) ;mask off before and after and store msk3 (setq msk nil) (setq msk1(assoc(car y) listij)) (setq yy(car msk1)) (setq len(cadr y)) (setq msk3()) (do((j 1(1+ j)))((> j x)) (setq msk1(cdr msk1)) (setq msk2(cons j(list(caar msk1) '=))) (setq msk3(cons msk2 msk3)) ) (setq msk3(reverse msk3)) ) (defun prntmsk(x y o) ;mark off before '/', just before '*', after '/' and (setq lst nil) ;just after '*' and same time '=' and store them all (mask x o) ; in flags (setq flag o) (do((j 1(1+ j)))((> j len)) (setq msk msk3) (do((w j(1+ w)))((> w(+ j(- x len)))) (setq msk(subst(cons w(cons(cadr(assoc w msk))(list '+)))(assoc w msk)msk))(setq mm(length msk)) ) (when(caddr flag) (setq lst(cons(cons(caddr flag) msk) lst)) (setq flag(cddr flag)) (if(or(eq(car flag)'spare1)(eq(car flag)'spare2))(setq bb 't)(setq bb nil)) (setq xy(car flag)) (setq ba 0) (do((m 1(1+ m)))((> m x)) (setq ba(+ ba 1)) (setq xx(cdr(assoc xy lst))) (if bb (setq sm(+(ij(car flag)'j) ba)) (setq sm(sum(car flag)(cadr(assoc m msk)))) ) (setq xx(subst(append(assoc m xx) (list sm))(assoc m xx) xx)) (setq lst(subst xx(cdr(assoc xy lst)) lst)) ) (do((m 1(1+ m)))((> m x)) (setq zt(caddr(assoc m msk))) (if(eq zt '=) (setf(aref gridtbl(sum(car flag)(cadr(assoc m msk)))) (- y(* 10(truncate y 10))) ) (setq zz '1) )))) (setq msk2 'nil) (do((w 1(1+ w)))((> w(+(- l len)1))) (setq msk o) (setq msk1 'nil) (do((i 0(1+ i)))((> i(- len 1))) (setq msk(cddr msk)) (setq z (cadddr(assoc(+ w i)(cdr(assoc(car msk) lst))))) (setq msk1(cons z msk1)) ) (setq msk2(cons(reverse msk1) msk2)) ) (setq j 0) (setq a1 o) (setq xt 't) (setq m 0) (do((w 2(1+ w)))((> w(* 2 len))) (if xt(setq x1 a1)) (setq a1(cdr a1)) (if(eq(car a1)'*)(progn(setq j(+ j 1))(setq xt nil)(setq m(-(/ w 2)1)))) ) (setq flags (cons (append(list y(-(+ m 1)j) j len(+(- l len) 1))(reverse msk2)) flags) ) ) (defun plchr$() ;if all but one '+' has been eliminated poke a letter 'a' (setq pl 0) ;in each row or column of each square (do((j 1(+ j l)))((> j(- kl l))) (do((i 1(+ i l)))((> i(maxi j))) (if(> c 107)(setq c 97)) (when oc (format t "\n plchr$ ~2,d ~2,d ~4,d ~10,d placed a's" (truncate(+ j l) l) (truncate(+ i l) l) (grid i j) pl ) (tm) ) (do((h 0(1+ h)))((> h l)) (setq f nil) (do((m 0(1+ m)))((> m(- l 1))) (setq m1 0) (do((w 0(1+ w)))((> w(- l 1))) (setq aa (aref gridtbl(grid(+ i w)(+ j m)))) (when(eq aa '+)(setq m1(+ m1 1))(setq x1 (+ i w))(setq x2(+ j m))) (if(mmp aa)(setq m1 km)) ) (when(= m1 1)(fr x1 x2)(setq f 't)) ) (do((m 0(1+ m)))((> m(- l 1))) (setq m1 0) (do((w 0(1+ w)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i m)(+ j w)))) (when(eq aa '+)(setq m1(+ m1 1))(setq x1(+ i m))(setq x2(+ j w))) (if(mmp aa)(setq m1 km)) ) (when(= m1 1)(fr x1 x2)(setq f 't)) ) (unless f(setq h ks)) )) (if(= q 0)(setq j ks)) ) (screenl "plchr$") (nl) (princ pl) ) (defun sqx() ;check each intersection for all-options-impossible in each (setq ui 0) ;respective square and poke an 'X' (do((j 1(1+ j)))((> j lk)) (do((i 1(1+ i)))((> i(maxi j))) (setq aa(aref gridtbl(grid i j))) (when oc (format t "\n sqX ~2,d ~2,d ~4,d ~a ~10,d imp sqX's" j i (grid i j) aa ui ) (tm) ) (when(eq aa '+) (setq f 't) (when(limitd i j) (do((ii(+(minp i l) l 1)(+ ii l)))((>= ii(maxi j))) (setq jj(- km ii)) (setq m1 0) (do((w 0(1+ w)))((> w(- l 1))) (setq x1(aref gridtbl(grid(+ ii w) j))) (setq x2(aref gridtbl(grid i(- jj w)))) (when f (cond ((and(mmp x1)(mmp x2))(hv i j x1)(setq m1 ks w ks ii ks f nil)) ((or(and(eq x1 '+)(eq x2 '+)) (and(or(mmp x1)(mmp x2))(or(eq x1 '+)(eq x2 '+))) ) (setq m1 ks w ks) ) ((or(and(mmp x1)(not(eq x2 '+))) (and (mmp x2)(not(eq x1 '+))) ) (setq m1 l w ks) ) (t (setq m1(+ m1 1))) ))) (when(= m1 l)(imp i j ii)) )) (when f (when(> j l) (do((jj 1(+ jj l)))((> jj(minp j l))) (setq ii(- km j)) (setq m1 0) (do((w 0(1+ w)))((> w(- l 1))) (setq x1(aref gridtbl(grid i(+ jj w)))) (setq x2(aref gridtbl(grid ii(+ jj w)))) (when f (cond ((and(mmp x1)(mmp x2))(hv i j x1)(setq m1 ks w ks jj ks f nil)) ((or(and(eq x1 '+)(eq x2 '+)) (and(or(mmp x1)(mmp x2))(or(eq x1 '+)(eq x2 '+))) ) (setq m1 ks w ks) ) ((or(and(mmp x1)(not(eq x2 '+))) (and(mmp x2)(not(eq x1 '+))) ) (setq m1 l w ks) ) (t (setq m1(+ m1 1))) ))) (when(= m1 l)(imp i j jj)) ) ) (when f (when(> i l) (do((ii 1(+ ii l)))((> ii(minp i l))) (setq jj(- km i)) (setq m1 0) (do((w 0(1+ w)))((> w(- l 1))) (setq x1(aref gridtbl(grid(+ ii w) j))) (setq x2(aref gridtbl(grid(+ ii w) jj))) (when f (cond ((and(mmp x1)(mmp x2))(hv i j x1)(setq m1 ks w ks ii ks f nil)) ((or(not f) (and(eq x1 '+)(eq x2 '+)) (and(or(mmp x1)(mmp x2))(or(eq x1 '+)(eq x2 '+))) ) (setq m1 ks w ks) ) ((or(and(mmp x1)(not(eq x2 '+))) (and(mmp x2)(not(eq x1 '+))) ) (setq m1 l w ks) ) (t (setq m1 (+ m1 1))) ))) (when(= m1 l)(imp i j ii)) ))))))) (screenl "sqX") (nl) (print ui) ) (defun fndchr$() ;find an 'a' and then duplicate verticle and horizontal arms (setq ui 0) (do((j 1(1+ j)))((> j lk)) (do((i 1(1+ i)))((> i(maxi j))) (setq aa(aref gridtbl(grid i j))) (when oc (format t "\n fndchr$ ~2,d ~2,d ~4,d ~a ~10,d translated a's" j i (grid i j) aa ui ) (tm) ) (when(mmp aa) (when(limitd i j) (do((ii(+(minp i l) l 1)(1+ ii)))((> ii(maxi j))) (setq jj(- km ii)) (setq x1(aref gridtbl(grid ii j))) (setq x2(aref gridtbl(grid i jj))) (cond ((and(eq x1 '+)(eq x2 '+))) ((eq x1 '+)(setf(aref gridtbl(grid ii j))x2)(if(mmp x2)(hv ii j x2))) ((eq x2 '+)(setf(aref gridtbl(grid i jj))x1)(if(mmp x1)(hv i jj x1))) (t nil) ))) (when(> j l) ;horizontal (setq ii(- km j)) (do((w 1(1+ w)))((> w(minp j l))) (setq x1(aref gridtbl(grid ii w))) (setq x2(aref gridtbl(grid i w))) (cond ((and(eq x1 '+)(eq x2 '+))) ((eq x1 '+)(setf(aref gridtbl(grid ii w))x2)(if(mmp x2)(hv ii w x2))) ((eq x2 '+)(setf(aref gridtbl(grid i w))x1)(if(mmp x1)(hv i w x1))) (t nil) ))) (when(> i l) ;vertical (setq jj(- km i)) (do((w 1(1+ w)))((> w(minp i l))) (setq x1(aref gridtbl(grid w jj))) (setq x2(aref gridtbl(grid w j))) (cond ((and(eq x1 '+)(eq x2 '+))) ((eq x1 '+)(setf(aref gridtbl(grid w jj))x2)(if(mmp x2)(hv w jj x2))) ((eq x2 '+)(setf(aref gridtbl(grid w j))x1)(if(mmp x1)(hv w j x1))) (t nil) ))))) (if(and(>= j l)(= q 0))(setq j ks)) ) ;++++ ;;diagonal is not needed 1:21:19 a savings of 4'5" ) (defun tsti(u v w x y z) ;saves 9sec. standing alone 1:21:42 TANDY (when(> w 0) (setq msk z) ;eliminate ends when all '-' (do((i 0(1+ i)))((> i(- y 1))) ;and equate '=' flags (setq msk(cdr msk)) (setq msk1(car msk)) (when(> v 1) (do((j 1(+ j l)))((> j v))(setq msk1(cdr msk1))) ) (setq msk2 msk1) (setq a2 nil) (setq a3 nil) (setq fl nil) (do((j 0(+ j 1)))((> j w)) (setq sm(car msk2)) (setq a1(aref gridtbl sm)) (unless(eq a1 '+)(if(mmp a1)(setq a2 a1))(setq a3 a1)(setq fl 't)) (setq msk2(cdr msk2)) ) (if a2(setq a3 a2)) (when fl (princ " flg= ") (setq msk3 msk1) (do((m 0(+ m 1)))((> m w)) (setq sm(car msk3)) (setf(aref gridtbl sm)a3) (setq msk3(cdr msk3)) )))) (setq msk z) (setq msk(cdr msk)) (when(>(length msk) 1) (setq msk1(car msk)) (setq f 't) (setq fl 't) (do((i 0(1+ i)))((> i(- x 1))) (setq x1(car msk1)) (setq aa(aref gridtbl x1)) (unless(or(not(eq aa '+))(mmp aa) fl)(setf(aref gridtbl x1)'Y)) (unless(or(mmp aa)(eq aa '+))(setq fl nil)) (if(and fl(eq aa '+))(setq f nil)) (setq msk1(cdr msk1)) ) (when f(setq msk(cdr msk))(princ " flg+ ")) (setq y (length msk)) (setq aa(append(list u v w x y) msk)) (setq flags(subst aa o flags)) (setq o aa) ) (setq msk(reverse msk)) (when(>(length msk) 1) (setq msk1(reverse(car msk))) (setq f 't) (setq fl 't) (do((i 1(1+ i)))((> i x)) (setq x1(car msk1)) (setq aa(aref gridtbl x1)) (unless(or(not(eq aa '+))(mmp aa) fl)(setf(aref gridtbl x1)'Y)) (unless(or(mmp aa)(eq aa '+))(setq fl nil)) (if(and fl(eq aa '+))(setq f nil)) (setq msk1(cdr msk1)) ) (when f(setq msk(cdr msk))(princ " flg- ")) (setq y(length msk)) (setq aa(append(list u v w x y)(reverse msk))) (setq flags(subst aa o flags)) ) ) (defun flgtst() ;ensure before and after options stay that way and trim ends (setq ln(caar flags)) (unless(not flags) (do((w 0(+ w 1)))((> w ln)) (setq o(assoc w flags)) (when o (setq g(cadr o)) (setq h(caddr o)) (setq i(cadddr o)) (setq j(cddddr o)) (if(>(car j) 1)(tsti w g h i(car j) j)) ) ) ) ) (defun ezz() ;if 2 rows or columns have exactly 2 solutions reject other (do((j 1(+ j l)))((> j(- kl l))) ;rows or columns of those (sol.s) with a 'Z' (do((i 1(+ i l)))((> i(maxi j)));same for 3/3 and 4/4 etc. (when oc (format t "\n eZZ ~2,d ~2,d ~4,d " (truncate(+ j l) l)(truncate(+ i l) l)(grid i j) ) (tm) ) (do((m 0(+ m 1)))((> m(- l 2))) (setq z1 0 a1 nil) (setq mi nil wi nil) (setq mi(cons m mi)) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i m)(+ j w)))) (if(eq aa '+) (progn(setq z1(+ z1 1))(setq wi(cons w wi))(setq a1(cons '+ a1))) (setq a1(cons '= a1)) )) (setq z2 1) (do((n(+ m 1)(+ n 1)))((> n(- l 1))) (setq a2 nil) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i n)(+ j w)))) (if(eq aa '+)(setq a2(cons '+ a2))(setq a2(cons '= a2))) ) (when(equal a1 a2)(setq z2(+ z2 1))(setq mi(cons n mi))) ) (when(and(> z1 1)(= z1 z2)(<= z1(- l 2))) (princ " Z ") (do((n 0(1+ n)))((> n(- l 1))) (unless(mmbrp n mi) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i n)(+ j w)))) (when(and(mmbrp w wi)(equal aa '+)) (setf(aref gridtbl(grid(+ i n)(+ j w)))'Z) )))))) (do((m 0(+ m 1)))((> m(- l 2))) (setq z1 0 a1 nil) (setq mi nil wi nil) (setq mi(cons m mi)) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i w)(+ j m)))) (if(eq aa '+) (progn(setq z1(+ z1 1))(setq wi(cons w wi))(setq a1(cons '+ a1))) (setq a1(cons '= a1)) )) (setq z2 1) (do((n(+ m 1)(+ n 1)))((> n(- l 1))) (setq a2 nil) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i w)(+ j n)))) (if(eq aa '+)(setq a2(cons '+ a2))(setq a2(cons '= a2))) ) (when(equal a1 a2)(setq z2(+ z2 1))(setq mi(cons n mi))) ) (when(and(> z1 1)(= z1 z2)(<= z1(- l 2))) (princ " Z ") (do((n 0(1+ n)))((> n(- l 1))) (unless(mmbrp n mi) (do((w 0(+ w 1)))((> w(- l 1))) (setq aa(aref gridtbl(grid(+ i w)(+ j n)))) (when(and(mmbrp w wi)(equal aa '+)) (setf(aref gridtbl(grid(+ i w)(+ j n)))'Z) ) ) ) ) ) ) ) ) ) (defun lp() ;done= are all '+'s gone in l rows? t/f (setq z nil) (do((ooo 0(1+ ooo)))((> ooo(-(* lk l)1))) (setq aa(aref gridtbl ooo)) (when(eq aa '+)(setq z 't)(setq ooo ks)) ) (setq z z) ) (defun soltn() ;display solution format (setq x(cadr(assoc n listitle))) (format t "\n~4,,,a" x) (do((j 1(1+ j)))((> j k))(format t "~4,,,a"(cadr(assoc j listitle)))) (nl) (setq y(assoc x listij)) (do((j 1(+ j 1)))((> j l)) (setq y(cdr y)) (format t "\n~4,,,a"(caar y)) (setq w(-(*(- j 1) lk)1)) (do((m 0(+ m 1)))((>= m k)) (setq s(cadr(assoc(+ m 1) listitle))) (setq h(assoc s listij)) (do((o 0(+ o 1)))((>= o l)) (setq w(+ w 1)) (setq h(cdr h)) (setq a1(aref gridtbl w)) (if(mmp a1)(progn(format t "~4,,,a"(caar h)))) ) ) ) ) (defun auto() ;automatic solver see RUSTY solution (flgtst) (nl) (flgtst) (plchr$) (flgtst) (nl) (flgtst) (if(= p 7)(setq q 0)) (fndchr$) (when(=(+ pl ui)0)(print "ui + pl = 0")(ezz)(sqX)) (setq p (+ p 1)) (if(lp)(auto)) ) (defun solvng() (setq q 0 oj 1) (pa) (screenl "FINAL") (princ "\n <<<< THEE SOLUTION! >>>>\n") (soltn) (tm) ) (pa) (setq n(length listitle)) (if(eq 'end(cadr(assoc n listitle)))(setq n(- n 1))) (setq l(length (cdr(assoc(cadr(assoc n listitle)) listij)))) (setq k(- n 1) lk(* l k) ks(+ (* lk lk)3) kl(+ lk 1)) (setq km(+(* l n)1) flags nil p 0 ts 0 q 4) (format t "\n ~a SOLUTION \n" oo) ;<<< start of display routines >>> (format t "\n TITLES:N= ~d ELEMENTS:L= ~d WIDTH:K= ~d ARRAY SIZE: KS-3= ~d " n l k (- ks 3) ) (setq ou nil oc 't ot 't oj 0 op 0 q 4 p 1) (setq ou 't) (nl) (nl) (screenl "EMPTY-ARRAY") (nl) (nl) (princ " READING EACH QUESTION INTO GRID !") (tm) (nl) (do((i 0(1+ i)))((> i(length listques))) (format t "\n AT QUESTION: ~3,d " i) (setq za(cdr(questn i))) (setq flag(cdr(assoc 'flg za))) (when flag(setq za(cdr za))(prntmsk l i flag)) (setq f 't) (when(eq(caar za)'/)(setq za(cdr za))(setq f nil)) (questns i za(length za)) (tm) ) (nl) (nl) (screenl "MAIN") (setq p 1) (if ou(rtn) (auto)) (solvng) (format t "\nDo you wish to exit
RETURN TO TOP
LOGIC MENU
HOME PAGE