Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!seismo!lll-lcc!ames!ucbcad!ucbvax!decvax!decwrl!sun!imagen!turner From: turner@imagen.UUCP (D'arc Angel) Newsgroups: comp.ai Subject: AI Expert Magazine source code posting for April (Part 03/05) Message-ID: <1003@imagen.UUCP> Date: Tue, 17-Mar-87 19:59:53 EST Article-I.D.: imagen.1003 Posted: Tue Mar 17 19:59:53 1987 Date-Received: Thu, 19-Mar-87 04:44:41 EST Organization: The Houses of the Holy Lines: 606 Keywords: source THEN scan(f,token) ; END ELSE BEGIN read_from_file(f) ; scan(f,token) ; END ; END ; (* scan *) PROCEDURE error(error_msg : string80) ; BEGIN writeln ; writeln(error_msg) ; wait ; END ; (* error *) FUNCTION get_expression_list(VAR f : text_file) : s_expr ; FORWARD ; FUNCTION get_expression(VAR f : text_file) : s_expr ; (* read an expression from f. This routine and get_expression_list work together to form a small recursive descent compiler for S-expressions. It follows the definition fo an S-expression from the article. It adds a quote to numbers and strings beginning with a ' mark *) BEGIN IF token = '(' THEN BEGIN scan(f,token) ; paren_level := paren_level + 1 ; get_expression := get_expression_list(f) ; IF token <> ')' THEN error('Missing '')''') ; END ELSE IF token = quote_char THEN BEGIN scan(f,token) ; get_expression := cons(alloc_str('QUOTE'),cons(get_expression(f),NIL)) ; END ELSE IF toupper(token) = 'NIL' THEN get_expression := NIL ELSE IF is_number(token) THEN get_expression := cons(alloc_str('QUOTE'), cons(alloc_num(toreal(token)),NIL)) ELSE get_expression := alloc_str(token) ; END ; (* get_expression *) FUNCTION get_expression_list (* VAR f : text_file) : s_expr *) ; (* read an S-expression list or dotted pair *) VAR p : s_expr ; BEGIN p := get_expression(f) ; scan(f,token) ; IF token = '.' THEN BEGIN scan(f,token) ; get_expression_list := cons(p,get_expression(f)) ; scan(f,token) ; END ELSE IF token = ')' THEN BEGIN paren_level := paren_level - 1 ; get_expression_list := cons(p,NIL) ; END ELSE get_expression_list := cons(p,get_expression_list(f)) ; END ; (* get_expression_list *) PROCEDURE print_expression(l : s_expr) ; (* recursively traverses the list and prints its elements. This is not a pretty printer, so the lists may look a bit messy. This routine tries to print the minimum possible number of parentheses. *) PROCEDURE print_list(list : s_expr) ; VAR p : s_expr ; BEGIN IF list <> NIL THEN CASE list^.tag OF number, symbol : write(string_val(list),' ') ; cons_node : BEGIN write('(') ; p := list ; WHILE tag_value(p) = cons_node DO BEGIN print_list(car(p)) ; p := cdr(p) ; END ; IF p <> NIL THEN BEGIN write('. ') ; print_list(p) ; END ; write(') ') ; END ; END ; END ; (* print_list *) BEGIN IF l = NIL THEN write('nil ') ELSE print_list(l) ; END ; (* print_expression *) FUNCTION eval(expr_list,name_list,value_list : s_expr) : s_expr ; (* The main evaluation routine. This routine is explained in the articles. expr_list contains the S-expression to be evaluated. name_list is the list of active variable names. value_list is the list of corresponding values. expr_list,name_list and value_list are attached to saved_list at the start of the routine so that if garbage collection takes place they won't be reclaimed. They are removed at the end of this routine. *) VAR f_name : string80 ; FUNCTION vars(list : s_expr) : s_expr ; (* make a list of variables from list *) BEGIN IF list = NIL THEN vars := NIL ELSE vars := cons(car(car(list)),vars(cdr(list))) ; END ; (* vars *) FUNCTION exprs(list : s_expr) : s_expr ; (* make a list of expressions *) BEGIN IF list = NIL THEN exprs := NIL ELSE exprs := cons(car(cdr(car(list))),exprs(cdr(list))) ; END ; (* exprs *) FUNCTION eval_list(list,name,value : s_expr) : s_expr ; (* evaluate a list, one item at a time. It does this by calling eval for each element of list *) BEGIN IF list = NIL THEN eval_list := NIL ELSE eval_list := cons(eval(car(list),name,value), eval_list(cdr(list),name,value)) ; END ; (* eval_list *) FUNCTION eval_if : s_expr ; BEGIN IF string_val(eval(car(cdr(expr_list)),name_list,value_list)) = 'T' THEN eval_if := eval(car(cdr(cdr(expr_list))),name_list,value_list) ELSE eval_if := eval(car(cdr(cdr(cdr(expr_list)))),name_list, value_list) END ; (* eval_if *) FUNCTION eval_let : s_expr ; VAR y,z : s_expr ; BEGIN y := vars(cdr(cdr(expr_list))) ; z := eval_list(exprs(cdr(cdr(expr_list))),name_list,value_list) ; eval_let := eval(car(cdr(expr_list)),cons(y,name_list), cons(z,value_list)) ; END ; (* eval_let *) FUNCTION eval_letrec : s_expr ; VAR v,y,z : s_expr ; BEGIN v := cons(cons(pending,NIL),value_list) ; y := vars(cdr(cdr(expr_list))) ; z := eval_list(exprs(cdr(cdr(expr_list))),cons(y,name_list),v) ; eval_letrec := eval(car(cdr(expr_list)),cons(y,name_list), rplaca(v,z)) ; END ; (* eval_letrec *) FUNCTION eval_read : s_expr ; (* read an expression from a file. The file must end in ".LSP". That's because we were too lazy to implement strings. The expression read from the file is evaluated. *) VAR f : text_file ; file_name : string80 ; old_line,old_saved_line : string255 ; BEGIN file_name := string_val(eval(car(cdr(expr_list)),name_list,value_list)) ; IF pos('.',file_name) = 0 THEN file_name := concat(file_name,'.LSP') ; IF open(f,file_name) THEN BEGIN old_line := line ; old_saved_line := saved_line ; line := '' ; scan(f,token) ; eval_read := eval(get_expression(f),name_list,value_list) ; close(f) ; line := old_line ; saved_line := old_saved_line ; END ELSE BEGIN error(concat('Unable to read ',file_name)) ; eval_read := NIL ; END ; END ; (* eval_read *) FUNCTION eval_f_call : s_expr ; (* evaluate a function call *) VAR c,z : s_expr ; BEGIN c := eval(car(expr_list),name_list,value_list) ; z := eval_list(cdr(expr_list),name_list,value_list) ; eval_f_call := eval(cdr(car(c)),cons(car(car(c)),car(cdr(c))), cons(z,cdr(cdr(c)))) ; END ; (* eval_f_call *) BEGIN saved_list := cons(expr_list,cons(name_list,cons(value_list,saved_list))) ; test_memory ; IF expr_list = NIL THEN eval := NIL ELSE IF atom(expr_list) THEN eval := assoc(expr_list,name_list,value_list) ELSE BEGIN f_name := toupper(string_val(car(expr_list))) ; IF f_name = 'QUOTE' THEN eval := car(cdr(expr_list)) ELSE IF f_name = 'CAR' THEN eval := car(eval(car(cdr(expr_list)),name_list,value_list)) ELSE IF f_name = 'CDR' THEN eval := cdr(eval(car(cdr(expr_list)),name_list,value_list)) ELSE IF f_name = 'ATOM' THEN eval := tf_node(atom(eval(car(cdr(expr_list)),name_list, value_list))) ELSE IF f_name = 'CONS' THEN eval := cons(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF f_name = 'EQ' THEN eval := tf_node(eq(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list))) ELSE IF f_name = 'LT' THEN eval := tf_node(lt(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list))) ELSE IF f_name = 'GT' THEN eval := tf_node(gt(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list))) ELSE IF f_name = 'NEQ' THEN eval := tf_node(NOT eq(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list, value_list))) ELSE IF (f_name = '+') OR (f_name = 'ADD') THEN eval := add(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF (f_name = '-') OR (f_name = 'SUB') THEN eval := sub(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF (f_name = '*') OR (f_name = 'MUL') THEN eval := mul(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF (f_name = '/') OR (f_name = 'DIV') THEN eval := div_f(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF f_name = 'MOD' THEN eval := mod_f(eval(car(cdr(expr_list)),name_list,value_list), eval(car(cdr(cdr(expr_list))),name_list,value_list)) ELSE IF f_name = 'IF' THEN eval := eval_if ELSE IF f_name = 'LAMBDA' THEN eval := cons(cons(car(cdr(expr_list)),car(cdr(cdr(expr_list)))), cons(name_list,value_list)) ELSE IF f_name = 'LET' THEN eval := eval_let ELSE IF f_name = 'LETREC' THEN eval := eval_letrec ELSE IF f_name = 'EXIT' THEN halt(0) ELSE IF f_name = 'READ' THEN eval := eval_read ELSE eval := eval_f_call ; END ; saved_list := cdr(cdr(cdr(saved_list))) ; END ; (* eval *) PROCEDURE initialize ; BEGIN line := '' ; saved_line := '' ; delim_set := ['.','(',')',' ',eof_mark,quote_char,';'] ; total_free := 0.0 ; paren_level := 0 ; free := NIL ; mark(initial_heap) ; pending := alloc_str('#PENDING') ; saved_list := cons(pending,NIL) ; clrscr ; writeln('VT-LISP - Copyright 1987 [c] Knowledge Garden Inc.') ; END ; (* initialize *) BEGIN initialize ; REPEAT scan(input,token) ; fn := get_expression(input) ; result := eval(fn,NIL,NIL) ; print_expression(result) ; writeln ; UNTIL false ; END. DIFF.LSP -------- ; ; Diff - symbolic diferentiation - From Henderson - Functional Programming ; enter S-expressions such as (* x c) and returns its derivative ; (letrec (diff '(+ x c)) (diff (lambda (e) (if (atom e) (if (eq e 'x) 1 0) (if (eq (car e) '+) (let (sum (diff p1) (diff p2)) (p1 (car (cdr e))) (p2 (car (cdr (cdr e))))) (if (eq (car e) '*) (let (sum (prod p1 (diff p2)) (prod (diff p1) p2)) (p1 (car (cdr e))) (p2 (car (cdr (cdr e))))) 'error))))) (sum (lambda (u v) (cons '+ (cons u (cons v nil))))) (prod (lambda (u v) (cons '* (cons u (cons v nil)))))) LAST.LSP -------- ; ; last - find the last element of a list ; (letrec (last '(a b c d e)) (last (lambda (x) (if (eq (cdr x) nil) x (last (cdr x)))))) APPEND.LSP ---------- ; ; Append one list to another ; Usage (append expr1 expr2) - change the lists in the letrec statement ; (letrec (append '(a b c) '(d e f g h i j k l m n o p)) (append (lambda (x y) (if (eq x nil) y (cons (car x) (append (cdr x) y)))))) ------------------------------------------------------------------------ S-expression ::- atom | '(' expression-list ')' atom ::- text-string | number expression-list ::- S-expression | S-expression '.' S-expression | S-expression expression-list Figure 1 The definition of S-expressions. "::-" means "is defined as" and "|" means "OR". __________________________________________________________________________ Variable x Constants (QUOTE s) 's Arithmetic expressions (ADD expr1 expr2) (+ expr1 expr2) (SUB expr1 expr2) (- expr1 expr2) (MUL expr1 expr2) (* expr1 expr2) (DIV expr1 expr2) (/ expr1 expr2) (MOD expr1 expr2) Comparisons (EQ expr1 expr2) (LEQ expr1 expr2) (GEQ expr1 expr2) (NEQ expr1 expr2) S-expression operations (CONS expr1 expr2) (CAR expr) (CDR expr) (ATOM expr) Conditional expression (IF expr1 expr2 expr3) Return to DOS (EXIT) Definition expressions (LAMBDA (x1 x2 x3 ....) expr) (LET expr (x1.expr1) (x2.expr2) .......) (LETREC expr (x1.expr1) (x2.expr2) ......) Function Call (expr expr1 expr2 expr3 ...) Figure 2 VT-LISP statements. x's represent variables, expr's represent S-expressions. SHAR_EOF if test 43847 -ne "`wc -c < 'aiapp.apr'`" then echo shar: "error transmitting 'aiapp.apr'" '(should have been 43847 characters)' fi fi echo shar: "extracting 'contnt.apr'" '(1573 characters)' if test -f 'contnt.apr' then echo shar: "will not over-write existing file 'contnt.apr'" else cat << \SHAR_EOF > 'contnt.apr' Table of Contents AI EXPERT Magazine April 1987 Theme: Conventional Languages in AI ARTICLES Conventional Languages & Expert Systems by Leslie DeGroff It has become imperative for yesterday's development efforts to fit in with today's Knowledge Based Systems (KBS). Here we look at five key ingredients for successfully mixing conventional programming environments and AI shell systems. AI & Ada by Louis Baker While LISP may be the language of choice for the development of artifical intelligence systems, there are reasons for selecting Ada. C on the Horizon by Jon Roland If one HAS to use C and its environment for the final stage of a commercial product development, consider prototyping in LISP, PROLOG, or another AI tool first. Learning AI on Video by Ashley Grayson Let's look closely at three video training packages. Each is presented from a different type of organization: a training company, a computer hardware vendor, and a professional book publisher. DEPARTMENTS Brain Waves "Real-Time Expert Systems in the Information Age" by Robert L. Moore AI Insider by Susan Shepard Expert's Toolbox by Marc Rettig AI Apprentice by Beverly and Bill Thompson In Practice by Harvey Newquist Book Store Software Reviews: Objective C SHAR_EOF if test 1573 -ne "`wc -c < 'contnt.apr'`" then echo shar: "error transmitting 'contnt.apr'" '(should have been 1573 characters)' fi fi echo shar: "extracting 'expert.apr'" '(5504 characters)' if test -f 'expert.apr' then echo shar: "will not over-write existing file 'expert.apr'" else cat << \SHAR_EOF > 'expert.apr' "Expert's Toolbox" April 1987 AI EXPERT magazine LISTING 1 - GPS in Prolog /* If the STARTSTATE satisfies the GOAL then no actions need be taken. This is the base case of GPS's recursion. */ gps(STARTSTATE, GOAL, STARTSTATE, []) :- satisfy(STARTSTATE, GOAL), !. /* Otherwise, work through the algorithm given in pseudocode in the body of the article. This is a four place relation, meaning that starting in the STARTSTATE and trying to achieve the GOAL, gps prescribes performing the ACTS, which will place you in the ENDSTATE. */ gps(STARTSTATE, GOAL, ENDSTATE, ACTS) :- majordiff(STARTSTATE, GOAL, DIFF), suitableact(DIFF, ACT), prereqs(ACT, PREREQS), achieve(STARTSTATE, PREREQS, READYSTATE, PREACTS), result(READYSTATE, ACT, AFTERSTATE), gps(AFTERSTATE, GOAL, ENDSTATE, POSTACTS), append(PREACTS, [ACT | POSTACTS], ACTS). /* This achieves a list of prerequisites PREREQS starting from a STARTSTATE, using actions PREACTS and ending in ENDSTATE. It does so by calling gps on each prerequisite in turn, and appending the actions together. */ /* Base case: if no prerequisites, then no actions are required. */ achieve(STARTSTATE, [], STARTSTATE, []). /* Recursive case. Save the acts prescribed by gps in FIRSTACTS, and the state resulting from the action in MIDSTATE. */ achieve(STARTSTATE, [PREREQ1 | PREREQS], ENDSTATE, ACTS) :- gps(STARTSTATE, PREREQ1, MIDSTATE, FIRSTACTS), achieve(MIDSTATE, PREREQS, ENDSTATE, RESTACTS), append(FIRSTACTS, RESTACTS, ACTS). /* Well known definition of append. */ append([], L, L). append([A|X], Y, [A|Z]) :- append(X, Y, Z). _______________________________ Listing 2 - Domain dependent knowledge for trip planning. /* The geographic model consists of individual "places", which the program thinks of as point-like, and "regions", which are areas containing places. In the axioms below, regions are any of the place names which have something in them; places are all the place names which have nothing in them. Thus, metmuseum and sanfrancisco are places, the village and Boston are regions. Regions are organized hierarchically by containment. We record that the Village is in New York City, which is in the northeast, which is in the US. States are simply places - namely, the place where the "robot" is now. Goals may be either places or regions, where the robot wishes to end up. Differences are recorded as two regions containing the starting state and the goal, at the hightest level, together with a thrid region containing them both. For example, if the state is Astor Place, and the goal is Berkeley, then the difference is the triple [northeast, bayarea, usa], since Astor Place is in the north-east, Berkeley is in the Bay area, and the next level up in the hierarchy is the US, which doesn't distinguish between the two. Acts are a list of the form [motiontype, startingplace, endingplace]; for example, [fly, kennedy, sfairport]. */ /* Basic geography. */ in(courant, village). in(bottomline, village). in(astorpl, village). in(sheridansq, village). in(pennstn, midtown). in(metmuseum, uppereast). in(guggenheim, uppereast). -- --------------- C'est la vie, C'est la guerre, C'est la pomme de terre Mail: Imagen Corp. 2650 San Tomas Expressway Santa Clara, CA 95052-8101 UUCP: ...{decvax,ucbvax}!decwrl!imagen!turner AT&T: (408) 986-9400