THE PAST MASTER CLUB

LOGIC.LSP

/n)") (setq z(char-code (read-char))) (if(= z 110)(exit)) (setq zp (/(get-internal-run-time) internal-time-units-per-second)) (setq ts 0)(tm) (pa) (print "Time = 3 minutes or 43 seconds on IBM's PS/VALUEPOINT/CREY") (setq oo 'SPARES) (defun rtn() (setq oc 't ot 't oj 0 op 0 q 4 p 1) (sqx)(ezz)(plchr$)(fndchr$)(flgtst)(plchr$)(setq q 0)(fndchr$) ) ;---------------------------------* ; FIRST SATELITE SOLAR R. LIFTOFF | ;---------------------------------* ; DON LYRA 2 M | ; FRED ZUES 3 T | ; DAVE LEO 2.5 W | ; RON ORION 1.5 Th | ; RUSTY DELTA 1 F | ;---------------------------------* (setq l 5 n 4 k 3 lk (* l k) ks (+(* lk lk)3) kl (+ lk 1)) (setq km (+(* l n)1) c 97 flags nil p 0) (setq al "abcdefghijklmnopqrstuvwxyz") (setq listitle '((1 satel)(2 solar)(3 lftof)(4 first)(5 end))) (setq listij '( (satel (Leo i 1)(Delta i 2)(Zues i 3)(Lyra i 4)(Orion i 5)) (solar (1 i 6 j 15)(15 i 7 j 14)(2 i 8 j 13)(25 i 9 j 12)(3 i 10 j 11)) (lftof (M i 11 j 10)(T i 12 j 9)(W i 13 j 8)(Th i 14 j 7)(F i 15 j 6)) (first (Don j 1)(Fred j 2)(Dave j 3)(Ron j 4)(Rusty j 5)) (end (spare1 i ks j ks )(spare2 i (+ ks l) j ks )) )) (setq listques '( (1 (/) (Don - 1 - 25 - 3)(Ron - 1 - 25 - 3 - Lyra)(Dave - Orion - Th) (Fred - Orion - Th)(Rusty - Zues - Orion - W - Th) ) (2 (/)(Leo - 15 - 2 - T)(Delta - 15 - 2)) (3 (flg lftof 2 15 * 1)) ;The captain headed for the satelite at 1.5 solar radius lifted off ;the day before the captain now located at 1 solar radius. (5 (flg solar 4 Orion / spare1 / spare2 / Zues) (/)(Fred - F)(Leo = W - Rusty) ;The captain of the satelite Zues lifted off atleast 3 days after the ;Orion's. ;non associative list -Fred didn't leave on Friday and ;Leo's captain, who isn't Rusty, left on Wednesday ) (4 (/)(M - 25)) (6 (flg lftof 2 Don * 3)(Don)(3 - Dave)) ;The captain of the space station located at 3 solar radius, who isn't ;Dave, blasted off from KENNEDY SPACE CENTER the day after his school ;cadet chum Don. (0 (Zues - M - Th - 1 - 25)) )) (logic) (format t "~& To see a more complex example hit enter (/n)") (setq z(char-code (read-char))) (if(= z 110)(exit)) (setq zp (/(get-internal-run-time) internal-time-units-per-second)) (setq ts 0)(tm) (pa) (print "Time = 9 minutes or 1.5 minutes on IBM's PS/VALUEPOINT/CREY") (setq oo 'BUILDINGS) (defun rtn() (setq oc nil ot 't oj 1 op 0 q 4 p 1) (ezz)(flgtst)(plchr$)(fndchr$)(plchr$)(fndchr$)(flgtst) (plchr$)(setq q 0)(fndchr$) ) ;-----------------------------------------------------* ; BUILDING AVE. FIRST SURNM BUILDING DOORS PEOPLE | ;-----------------------------------------------------* ; NSCO 1st. JONES RIDGE GOLD BROWN 9 | ; TDCO 2nd. BUCK COLE GRAY BLACK 7 | ; CNCO 3rd. CURTIS WEST MARBLE BLUE 8 | ; CICO 4th. RICE PORT WHITE RUST 12 | ; NBCO 5th. BRUCE AJAX GREEN PINK 16 | ;-----------------------------------------------------* (setq l 5 n 7 k (- n 1) lk (* l k) ks (+(* lk lk)3) kl (+ lk 1)) (setq km (+(* l n)1) c 97 flags nil p 0) (setq al "abcdefghijklmnopqrstuvwxyz") (setq listitle '((1 avenu)(2 first)(3 surnm)(4 bldng)(5 doors)(6 peopl) (7 cmpny)) ) (setq listij '( (avenu (1st i 1)(2nd i 2)(3rd i 3)(4th i 4)(5th i 5)) (first (JONES i 6 j 30)(RICE i 7 j 29)(CURTIS i 8 j 28) (BUCK i 9 j 27)(BRUCE i 10 j 26)) (surnm (COLE i 11 j 25)(RIDGE i 12 j 24)(AJAX i 13 j 23) (WEST i 14 j 22)(PORT i 15 j 21)) (bldng (gray i 16 j 20)(gold i 17 j 19)(green i 18 j 18) (white i 19 j 17)(marble i 20 j 16)) (doors (brown i 21 j 15)(black i 22 j 14)(rust i 23 j 13) (pink i 24 j 12)(blue i 25 j 11)) (peopl (7 i 26 j 10)(8 i 27 j 9)(9 i 28 j 8)(12 i 29 j 7)(16 i 30 j 6)) (cmpny (NSCO j 1)(TDCO j 2)(CNCO j 3)(CICO j 4)(NBCO j 5)) )) (setq listques '( (1 (flg avenu 2 brown * 7)(brown)(7)) (2 (/)(1st = 9 - pink - blue)(WEST = 8)) (3 (AJAX = 5th - 8 - 9 - 12)) (4 (flg avenu 3 black * CURTIS * 12)(black - white - marble)(CURTIS)(12)) ;Curtis lived on one higher Ave than the company with the black door, ;which wasn't white or marbled, but one Ave lower than the company with ;a staff of 12. (5 (/)(BUCK = 2nd - CICO - CNCO - NBCO) (5th - NSCO - TDCO) (rust - marble) ) (6 (flg avenu 3 CNCO * PORT * BRUCE)(CNCO)(PORT)(BRUCE)) (7 (flg peopl 2 4th * green) (green = pink - 12)(4th - 9)) (8 (flg avenu 2 gold * TDCO)(gold)(TDCO)) (9 (RICE = CICO - 1st - 5th)) (0 (flg avenu 3 JONES * COLE * marble)(JONES)(COLE)(marble)) )) (logic) (format t "~& To see a more complex and auto example hit enter (/n)") (setq z(char-code (read-char))) (if(= z 110)(exit)) (setq zp (/(get-internal-run-time) internal-time-units-per-second)) (setq ts 0)(tm) (pa) (print "Time = 7 auto minutes or 1' 23 seconds on IBM's PS/VALUEPOINT/CREY") (setq oc 't ot 't oj 1 op 0 q 4 p 1) (setq oo 'RUSTY_) (defun rtn() (auto) ) ;---------------------------------* ; FIRST SATELITE SOLAR R. LIFTOFF | ;---------------------------------* ; ERIC ZUES 1 M | ; RUSTY LEO 2.5 T | ; TED TAU 2 W | ; DON LYRA 3 Th | ; RON ORION 1.5 F | ;---------------------------------* (setq l 5 n 4 k 3 lk (* l k) ks (+(* lk lk)3) kl (+ lk 1)) (setq km (+(* l n)1) c 97 flags nil p 0) (setq al "abcdefghijklmnopqrstuvwxyz") (setq listitle '((1 satel)(2 solar)(3 lftof)(4 first))) (setq listij '( (satel (Leo i 1)(Tau i 2)(Zues i 3)(Lyra i 4)(Orion i 5)) (solar (1 i 6 j 15)(15 i 7 j 14)(2 i 8 j 13) (25 i 9 j 12)(3 i 10 j 11)) (lftof (M i 11 j 10)(T i 12 j 9)(W i 13 j 8) (Th i 14 j 7)(F i 15 j 6)) (first (Eric j 1)(Rusty j 2)(Ted j 3)(Don j 4)(Ron j 5)) )) (setq listques '( (0 (flg lftof 3 Rusty * Ted / 15) (Rusty = Leo )(Ted)(15) ;associative list - LEO' Captain RUSTY lifted off 'flg' the day before ;'*' TED who took off 'flg' some time before '/' the Captain located at ;1.5 solar radius. ) (1 (Rusty - Lyra)(Orion - 3)(1 - Leo)(2 - Lyra)) ;associative list - Neither RUSTY (who isn't on the LYRA) nor the ;ORION's Captain are located at 1 (not the LEO satalite) or 2 (not the ;LYRA satalite) solar radii. (2 (T - Tau - Lyra - Orion)) ;associatively - The 4 different captains are: the one who lifted off ;on Tuesday, the ones on satalite TAU, LYRA and ORION -logic. ;;;or ;unassociatively Tuesday's liftoff wasn't heading for TAU, LYRA or the ;ORION satalite. (3 (Don - M - F)(Ted - M - F)) ;associative list - Neither DON nor RON left on Monday or Friday. (4 (Ted)(3 )(1 - Don)) ;;or [Ted - 3 - [1 - Don]] ;associative list - TED is not the Captain located at 1 or 3 solar radii. ;unassociatively - DON is not located at 1 solar radius. (5 (Orion)(Eric - Th)(W - 3)) ;Neither ORION nor ERIC lifted off on Wednesday. ;ERIC didn't leave on Thursday. ;Wednesday's liftoff wasn't headed for the satalite at 3 solar radii. (6 (25 - (Tau - Eric) - (Lyra - M) - (Ron - M) - (Th - 15))) ;associatively - The 5 Captains are: the one located at 2.5 solar ;radii, the one on satalite TAU, the one on satalite LYRA, RON, and ;the one who lifted off on Thursday. ;unassociatively - ERIC isn't Captain of TAU. Neither LYRA's Captain nor ;RON lifted off on Monday. Thursday's liftoff' captain is not located at ;1.5 solar radius. )) (logic) (format t "~& To see a more complex and auto example hit enter (/n)") (setq z(char-code (read-char))) (if(= z 110)(exit)) (setq zp (/(get-internal-run-time) internal-time-units-per-second)) (setq ts 0)(tm) ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ;---------------------------------------------------------------------* ; NAM TIM ITM BEV HTL WLK DNR COL SGN VST AMT PMT EVT FLR LCL INS OTS | ;---------------------------------------------------------------------* ; GER 6:3 GUM TEA MRY 11 NCK CRM FLW 3 CAS RTC PLA 32 3 7 8 | ; BEN 7 MAG MLK QGL 7 BMB RUS STG 2 ART ORS MOV 3 7 4 10 | ; ALX 7:3 MAP CCO CEN 18 OLV WHT CAT 1 TAY OMP BSK 40 6 5 9 | ; DES 8 BKS CFF STN 3 MRL BLU YHT 5 TOR AST OPR 27 2 8 6 | ; MAX 8:3 PPR JCE PLC 14 LEP GRN CAR 5 TOM AYL MUS 12 4 9 7 | ;---------------------------------------------------------------------* (pa) (print "Time = 1.25 hours or 11 minutes on IBM's PS/VALUEPOINT/CREY") (print "and 45 times larger !") (defun logic() nil)(gc) (load "lsp\\pink\\pnkpnthr.lsp") (nl) (print "TOTAL PROGRAM TIME => ")(setq zp 0 ts 0)(tm)(nl) )(time(in)) (nl) (format t "~& Do you wish to (exit)? or ctrl C ") (read-line) (exit) ;;I COULD HAVE ADDED PNKPNTHR.LSP AS A TAIL TO MY LOGIC.BAT ;;;;;;;;;;;;;;;;;;;;;;;;;;; logic loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic4\logic\logic.lsp-- (defun logic() (defun rl()(read-line)) (defun sp()(princ " ")) (defun nl()(terpri)) (defun pa()(do((i 1(1+ i)))((> i 24))(nl))) (unless(fboundp 'strcat) (defun strcat(&rest str) (apply #'concatenate 'string str)) ) (defun mmp(x y) (setq zz nil) (do((i 0(1+ i)))((> i(-(length y) 1))) (when(eq x(char y i))(setq zz 't j ks)) ) (setq zz zz) ) (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) (princ " X= ") (princ(grid x y)) (setf(aref gridtbl(grid x y))'X) (setq f nil) ) (defun fr(x y)(hv x y(int-char c))(setq c(+ c 1))) (defun hv(x y z)(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 ln(x y) (nl) (princ "*-----*-") (do((w 1(1+ w)))((> w(* 2 x y))) (if(=(inteql w(* l 2))1)(princ "*")) (princ "-") ) (princ "*") ) (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(file x y) (do((j 1(1+ j)))((> j(* y x))) (do((i 1(1+ i)))((> i(* y x))) (if(limit i j) (setf(aref file(+(*(- j 1)(* y x))(- i 1)))'+) (setf(aref file(+(*(- j 1)(* y x))(- i 1)))" ") ))) (do((j 0(1+ j)))((> j lk))(setf(aref file(+ ks j))'+)) ) (setup gridtbl l k) (defun screen(x y u$) (princ(int-char 7)) (nl) (princ " NICK'S |") (setq z " ") (setq o(-(* 2 l)6)) (do((j 1(1+ j)))((> j o))(setq z(strcat " " z))) (do((w 1(1+ w)))((> w k))(princ(cadr(assoc w listitle)))(princ z)(princ "|")) (nl) (princ " LOGIC ") (setq z 1) (do((w 1(1+ w)))((> w lk)) (if(and(= z 1)(=(inteql w l)1)) (progn(setq z 0)(setq w(- w 1))(princ "|")) (progn(setq yy(+ 64 w))(princ(int-char yy))(princ " ")(setq z 1)) )) (princ "|") (setq cnt(+ yy l)) (do((j 1(1+ j)))((> j(* x y))) (if(=(inteql j x)1) (progn (ln x y) (nl) (princ "|") (princ(cadr(assoc(-(+ y 1)(truncate(- j 0.5) x)) listitle))) (princ "|") ) (progn(nl)(princ "| |")) ) (princ(int-char cnt)) (setq cnt(- cnt 1)) (do((i 1(1+ i)))((> i(* x y))) (if(=(inteql i x) 1)(princ "|")) (princ(aref gridtbl(+(*(- j 1)(* x y))(- i 1)))) (princ " ") ) (princ "|") (when(and(> n 6)(= op 1)(= j(*(truncate n 2) l)))(princ"Hit enter")(rl)) (if(and(> p 0)(or(= q 0)(= q 2))(>= j l))(setq j ks)) (if(and(> p 0)(>= j l)(= oj 1))(setq j ks)) ) (ln x y) (nl) (when(= op 1)(print "Hit enter")(rl)) (format t " ~a SOLUTION ~a SCREEN: pass ~d " oo u$ p) (tm) (nl) ) (defun id(x) (do((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))))) (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 sumti(x y) (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) (cond ((eq y '=) (progn (cond ((id(car z)) (progn (setq a1(sumti x(car z))) (hv(car lij)(cadr lij)(int-char c)) (setq c(+ c 1)) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) ((id(caar z)) (progn (setq a1(sumti x(caar z))) (hv(car lij)(cadr lij)(int-char c)) (setq c(+ c 1)) (if(eq(cadar z)'-)(sgn w(caar z) '-(cddar z))) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) (t nil) ))) ((eq y '-) (cond ((id(car z)) (progn (setf(aref gridtbl(sumti x(car z)))w) (if(eq(cadr z)'-)(sgn w x '-(cddr z))) )) ((id(caar z)) (progn (setf(aref gridtbl(sumti x(caar z))) w) (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) (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(sumti frst nxt)(setf(aref gridtbl(sumti frst nxt)) x)) (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) (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) (setq lst nil) (mask x o) (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(sumti(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(sumti(car flag)(cadr(assoc m msk))))'F) (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$() (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 "~& plchr$ ~2,d ~2,d ~3,d " j i(grid i j))(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 al)(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 al)(setq m1 km)) ) (when(= m1 1)(fr x1 x2)(setq f 't)) ) (unless f(setq h ks)) )) (if(= q 0)(setq j ks)) ) (screen l k "(plchr$)") (nl) ) (defun sqx() (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 "~& sqX ~2,d ~2,d ~3,d ~a " j i(grid i j) aa)(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)))) (cond ((not f)(setq m1 km w l)) ((and(eq x1 '+)(eq x2 '+))(setq m1 km w l)) ((and(mmp x1 al)(mmp x2 al))(hv i j x1)(setq m1 km w l f nil)) ((and(or(mmp x1 al)(mmp x2 al))(or(eq x1 '+)(eq x2 '+))) (setq m1 km w l) ) ((or(and(mmp x1 al)(not(eq x2 '+)))(and(mmp x2 al)(not(eq x1 '+)))) (setq m1 l w l) ) (t (setq m1(+ m1 1))) )) (if(= m1 l)(imp i j)) )) (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)))) (cond ((not f)(setq m1 km w l)) ((and(eq x1 '+)(eq x2 '+))(setq m1 km w l)) ((and(mmp x1 al)(mmp x2 al))(hv i j x1)(setq m1 km w l f nil)) ((and(or(mmp x1 al)(mmp x2 al))(or(eq x1 '+)(eq x2 '+))) (setq m1 km w l) ) ((or(and(mmp x1 al)(not(eq x2 '+)))(and(mmp x2 al)(not(eq x1 '+)))) (setq m1 l w l) ) (t (setq m1(+ m1 1))) )) (if(= m1 l)(imp i j)) )) (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))) (cond ((not f)(setq m1 km w l)) ((and(eq x1 '+)(eq x2 '+))(setq m1 km w l)) ((and(mmp x1 al)(mmp x2 al))(hv i j x1)(setq m1 km w l f nil)) ((and(or(mmp x1 al)(mmp x2 al))(or(eq x1 '+)(eq x2 '+))) (setq m1 km w l) ) ((or (and(mmp x1 al)(not(eq x2 '+))) (and (mmp x2 al)(not(eq x1 '+))) ) (setq m1 l w l) ) (t (setq m1(+ m1 1))) )) (if(= m1 l)(imp i j)) ))))))) (screen l k "(sqX)") (nl) ) (defun fndchr$() (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 "~& fndchr$ ~2,d ~2,d ~3,d ~a " j i(grid i j) aa)(tm)) (when(mmp aa al) (hv i j 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)) ((eq x2 '+)(setf(aref gridtbl(grid i jj))x1)) (t nil) ))) (when(> j l) (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)) ((eq x2 '+)(setf(aref gridtbl(grid i w))x1)) (t nil) ))) (when(> i l) (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)) ((eq x2 '+)(setf(aref gridtbl(grid w j))x1)) (t nil) ))))) (if(and(>= j l)(= q 0))(setq j ks)) ) (unless(>= j ks) (do((j 1(1+ j)))((> j l)) (do((i 1(1+ i)))((> i l)) (setq aa(aref gridtbl(grid i j))) (when oc(format t "~& fndchr$ ~2,d ~2,d ~3,d ~a " j i(grid i j) aa)(tm)) (when(mmp aa al) (hv i j aa) (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)) ((eq x2 '+)(setf(aref gridtbl(grid i jj))x1)) (t nil) )))))) (screen l k "(fndchr$)") (nl) ) (defun tsti(u v w x y z) (when oc(format t "~& FLG ")(tm)) (when(> w 0) (setq msk z) (do((i 0(1+ i)))((> i(- y 1))) (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 al)(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 al) fl)(setf(aref gridtbl x1)'Y)) (unless(or(mmp aa al)(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 al) fl)(setf(aref gridtbl x1)'Y)) (unless(or(mmp aa al)(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() (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)) ))) (screen l k "(flgtst)") (nl) ) (defun ezz() (do((j 1(+ j l)))((> j(- kl l))) (do((i 1(+ i l)))((> i(maxi j))) (when oc(format t "~& eZZ ~2,d ~2,d ~3,d " j i(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) )))))))) (screen l k "(eZZ)") (nl) ) (defun lp() (setq z nil) (do((oo 0(1+ oo)))((> oo(-(* lk l)1))) (setq aa(aref gridtbl oo)) (when(eq aa '+)(setq z 't)(setq oo(* l(length al)))) ) (setq z z) ) (defun soltn() (setq x(cadr(assoc n listitle))) (format t "\n~9,,,a" x) (do((j 1(1+ j)))((> j k)) (format t "~9,,,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~9,,,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 al)(progn(format t "~9,,,a"(caar h)))) )))) (defun auto() (setq p(+ p 1)) (if(evenp p)(ezz)) (if(evenp p)(sqx)) (flgtst) (plchr$) (flgtst) (fndchr$) (if(lp)(auto)) ) (defun solvng() (setq q 2 oj 1) (pa) (screen l k "FINAL") (nl) (princ(int-char 7)) (princ " <<<< THEE SOLUTION! >>>>") (nl) (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) c 97 flags nil p 0 ts 0 q 4) (setq al "abcdefghijklmnopqrstuvwxyz") (format t "\n ~a SOLUTION \n" oo) (format t "\n TITLES:N= ~d ELEMENTS:L= ~d WIDTH:K= ~d ARRAY SIZE: KS-3 = ~d " n l k (- ks 3)) (nl) (setq ou nil oc 't ot 't oj 0 op 0 q 4 p 1) (setq ou 't) (screen l k " EMPTY ARRAY") (nl) (princ " READING EACH QUESTION INTO GRID !") (tm) (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) (screen l k "MAIN QUESTION\n") (setq p 1) (if ou(rtn)(auto)) (solvng) (princ(int-char 7)) (princ(int-char 7)) (princ(int-char 7)) (nl) (nl) (print "HIT ENTER TO CONTINUE!");(rl) )

---

RETURN TO TOP
LOGIC MENU
HOME PAGE
You are visitor no. to this page.