Turbo Toolbox/Turbo_Toolbox.iso/sharew/pdpro/expert/rules.

Text File | 1994-02-22 | 219.5 KB | 7,478 lines

                  NYACC MEMBERSHIP APPLICATION
              New York Amateur Computer CLub, Inc.
                           PO Box 106
            Church Street Station, New York NY 10008


         [ ] New Member    [ ] Renewal    Dues are $15.00
               Please make checks payable to NYACC

First name:__________________  Last name: _______________________

Mailing Address: ________________________________________________

City: ___________________ State: _____ Zip: ______ Country: _____

Business phone: (___) ___-____          Home phone: (___)___-____

What topics would you like covered at club meetings:



Would you like to speak at a club meeting? [ ] yes [ ] no
Topic(s):



Can you help the club? [ ] general   [ ] newsletter  [ ] flea market
[ ] meetings  [ ] user group



Comments:



MZ[

ß  ┤!
brÇ═
-?dâ╛╓F
╤
··
0HX┐
[¿ 













                           AUTOMATA DESIGN ASSOCIATES



                                                          1570 Arran Way
                                                          Dresher, Pa.
                                                          19025
                                                          (215)-646-4894
                                                          December 14,1985
        Dear PD user:

             Here's version 1.8 of PD PROLOG. It's better, of course. And
        now I must ask a favor of you.

             The   AAAI   fifth   national   conference   on   artificial
        intelligence is on August 11 to 15th, 1986 in Philadelphia. Since
        I live next to Philly,  I'd love to exhibit there. The problem is
        that  the rate is $2200 for a 10' x 10' booth,  with a $600  rate
        for publishers.

             I  am  appealing to the coordinator of the  conference,  Ms.
        Claudia   Mazzetti,   for  a  publishers  rate  break  with   the
        justification  of my contribution to the public  domain.  I  have
        sent  to Ms.  Mazzetti a financial statement which shows  clearly
        that  I  cannot afford the standard rate.  Ms.  Mazzetti was  not
        particularly   impressed  with  my  request,   but  perhaps  some
        substantiation of my contribution will change her mind.

             I  therefore  request that you  write  Ms.  Mazzetti  before
        February  at the below address,  and inform her of what I've done
        for mankind, the Byte readership, etc:

                              Ms. Claudia Mazzetti
                              Director, AAAI-86
                              445 Burgess Drive
                              Menlo Park, CA 94025-3496

                                Sincerely yours,


                                   Bob Morein
                              Author, A.D.A. PROLOG
















                     A.D.A PROLOG Documentation Version 1.80
                  for the Educational and Public Domain Versions

                                  December 14, 1985

              Copyright Robert Morein and Automata Design Associates

                                 1570 Arran Way
                               Dresher, Pa. 19025

                                 (215)-646-4894


















































                                      News

             Release 1.80 is further debugged. There are no new features.
        However,  there  are  some new sample programs by  Tom  Sullivan.

             There  is  also a very interesting natural language  parsing
        system by Lou Schumacher of Future Dimensions in directory "ATN".
        Lou's system, known as an augmented transition network parser, is
        very well documented,  since the paper he wrote on the subject is
        also included.  You'll need Volkswriter to print it out, but it's
        readable as is.  The system requires ED PROLOG to run,  since  it
        makes use of the grammar rule syntax.

             Simon   Blackwell's   "PIE"  Truth  Maintenance  System   is
        presented in revised, debugged, and enlarged form. This system is
        found  in  the  directory  "expert"  and  augments  the  strictly
        deductive  capabilities  of raw Prolog with additional  forms  of
        reasoning.  PIE  has a syntax that resembles colloquial  English.
        Wait till you see the backwards quote marks!

             The predicates "batch" and "nobatch" are introduced to allow
        execution  of batch files without confusing messages and  prompts
        appearing on the screen. I've put one in Simon's "KOPS" file.



                                Copyright Notice

             The  public domain PD PROLOG system has been contributed  to
        the  public domain for unrestricted use with one  exception:  the
        object  code  may not be  disassembled  or  modified.  Electronic
        bulletin  boards  and SIG groups are urged to aid in giving  this
        software the widest possible distribution.

             This documentation may be reproduced freely,  but it may not
        be  included in any other documentation without the permission of
        the author.





























                                  Introduction

        We  are pleased to present the third major version of PD  PROLOG,
        version 1.7.  Version 1.7 continues to refine "problems" and adds
        the  entertaining  feature of IBM PC video  screen  support.  The
        memory requirements are somewhat greater than the original, since
        it   is  uses  the  large  memory  model.   It   compensates   in
        thoroughness.  The memory requirement is about 210K bytes of TPA,
        and it will benefit from up to 253k bytes. The availalble
        workspace is 100K bytes.

        We  hope  that you'll get some fun out of this  PROLOG.  It  will
        afford  you exposure to THE fifth generation language at the cost
        only  of  some  intellectual  effort.  The  motive  is  perfectly
        explicable:  We  want you to think of Automata Design  Associates
        for  fifth  generation  software.  It also gives us a  nice  warm
        feeling.

        The  minimum  memory  requirement is 200 k of  transient  program
        area,  plus  whatever  space is needed to execute  programs  from
        within PROLOG.  DOS or MSDOS 2.0 are required.  The program  does
        not  require  IBM PC compatibility to run,  although  the  screen
        access routines do require compatibility.











































                     Products by Automata Design Associates

             Automata  Design  Associates  specializes  in  software  for
        artificial  intelligence  and  robotic  applications.   A  PROLOG
        language  system is available in various configurations.  A  LISP
        interpreter will be introduced in March of 1985.


             There  are five versions of PROLOG available  from  Automata
        Design  Associates.  All  of  them run under the MSDOS  or  PCDOS
        operating systems. Other environments will be supported soon.


             .Public Domain PROLOG

        This  serves to further the general awareness of the public about
        PROLOG.  It  also is an excellent adjunct to anyone learning  the
        language.  Most  of  the core PROLOG described  by  Clocksin  and
        Mellish  in  the book Programming In  PROLOG  is  implemented.  A
        complete  IBM PC video screen support library is included in this
        and  all other A.D.A.  prologs.  Trace predicates are  not.  This
        version is available from us for $10.00 postage paid.


             .Educational PROLOG

        At  extremely modest cost this affords an educational institution
        or  individual  a  PROLOG  system  which  provides  the   maximum
        available  programming  area  available  within  the  8086  small
        programming model.  Tracing,  a debugging aid,  allows monitoring
        a program as it runs.  User settable spy points selectively allow
        this.  Exhaustive  tracing  is also  available.  I/O  redirection
        gives some file ability.

             An  "exec"  function allows the execution of  a  program  or
        editor  from  within  PROLOG,  thus  encouraging  an  interactive
        environment.

             An  "interrupt"   menu is added,  permitting the control  of
        tracing, toggling the printer, and screen printing.

             Definite clause grammar support is now included.

             The cost of Educational PROLOG is $29.95.






















             .FS PROLOG

             A  small  increment  in price adds full random  access  file
        capability. Character and structure I/O are allowed.

             The  "asserta and "assertz" predicates are expanded and work
        with a clause indexing ability.  One can assert clauses  anywhere
        in the database under precise pattern matching control.

             A tree structured lexical scoping system and floating  point
        arithmetic are other enhancements.

             The cost of FSM PROLOG is $49.95



             .VMI PROLOG -- Virtual Memory (Replaces type VMS)


             At reasonable cost the addition of virtual memory gives  an
        expansion of capabilities of an order of magnitude.

             The  database on disk is treated transparently.  No  special
        provisions  need  be  made  by the  user.  Virtual  and  resident
        databases  may be mixed.  A unique updating algorithim  preserves
        the format of the database as typed by the user while making only
        those changes necessary to make it equivalent to the database  in
        central memory.

             The cost of VMI PROLOG is $99.95




































             .VML PROLOG Large model Virtual Memory System

             A.D.A.  PROLOG is a remarkable fifth generation developement
        tool  for  the  implementation  of  intelligent  strategies   and
        optimized  control.  It  is both the kernel for  applications  of
        virtually  unlimited scope and a sophisticated developement  tool
        that multiplies the productivity of the programmer many times.

             With  a  cost/performance ratio exceeding that of any  other
        product  and  a  compatibility  insured  by  compliance  to   the
        Edinburgh syntax, performance is enhanced by numerous extensions,
        many of them invisible to the user.

             A quick overview of some of the features discloses:

             1)  Invisible  compilation  to  a  semantic  network
             preserves the flexibility of the interpreted mode and
             the speed of a compiler.

             The  programmer can compile and recompile any portion
             of a module at any time.  The edit/compile/test cycle
             is short and free of strain. An interface is provided
             to an editor of choice.


             2) Floating point arithmetic with a full  complement
             of  input  and  output  methods,  transcendental  and
             conversion functions.


             3)  Virtual  memory.  Module  size  and  number  are
             unrestricted,   with  a  total  capacity  of  several
             hundred megabytes.  Resident and virtual modules  may
             be co-resident. Compilation is incremental. The cache
             algorithim  is  sophisticated.  Changes made  in  the
             database can be updated to disk by a single command.


             4) A powerful exec function and acceptance of  stream
             input make  integration into  applications practical.


             5)  Global polymorphic variables  retain  information
             that  would  otherwise  require  the  "assertion"  of
             facts.


             6)  A  quoted  variable class,  borrowed  from  LISP,
             permits  referencing variables as objects as well  as
             by value.

             7) Multidimensional arrays,  dynamically created  and
             destroyed,  efficiently  store numeric and nonnumeric
             structures. Arrays are ideal for representing spatial
             and ordinal relationships.
             8)  Debugging facilities let you see your program run
             without any additional generation steps.


             9)   Totally   invisible  and   incremental   garbage






             collection.   There   is  NEVER  any  wait  for  this
             function.


             10)  A  tree  structured,   dynamically  configurable
             lexical scoping system. The work of many  programmers
             can  be coupled together in the form of libraries and
             nested domains.

             Each lexically scoped domain is a hidden space  which
             communicates  with the parent domain via exports  and
             imports. Domains can be linked together under program
             control to achieve any desired configuration.


             11) The Grammar Rule Notation is an integral feature.


             12) Keyword redefinition makes porting code easy.


        The  cost  of this system is $200 for the MSDOS version.



        .VMA PROLOG Large model Virtual Memory System

        This  system  has  additional forms of  virtual  memory.  It  was
        intended  for  deep  reasoning  problems.  Contact  us  for  more
        information.




































                                 Upgrade Policy

             Half the cost of any A.D.A. PROLOG system may be credited to
        the purchase of a higher level version.      The full cost of VMS
        prolog  may  be  applied to the purchase of VMI  or  VML  PROLOG.
        Updates to a particular level product vary from $15.00 to $35.00.


                                Run-time Packages

             Software  developers wishing to integrate an A.D.A.  product
        into  their  system  should inquire  about  specialized  run-time
        packages available at reasonable cost.



                              Technical Information

             Technical information may be obtained at (215) - 646- 4894

             Perhaps we can answer the following questions in advance:

             There is no support for:  APPLE II, Atari, Commodore, or
        CPM 80 .  Other machines from these manufactures may be supported
        in the future.

             The MSDOS products are available on 5" and 8" diskettes.



                              To Place Your Order:

             You may place your order at the following number:

                        (215)-646-4894   - day and night.



                                     Returns

             The  software may be returned within 30 days of purchase for
        a full refund.  This applies whether or not the software has been
        used.  We do ask that manuals, disks and packaging be returned in
        excellent condition.






















                                  Installation

             You will need an IBM PC compatible machine with a minimum of
        256 kbytes of memory. ED PROLOG benefits from up to 245 kbytes of
        program  memory (TPA).  This means in practice that a machine with  320
        kbytes of memory is optimal for ED PROLOG.

             To  determine the amount of TPA your machine  has,  run  the
        "chkdsk" program which is supplied with DOS. The last line reads:

                                XXXXXX bytes free

        where XXXXXX is a six digit number.

        If  this  number  is greater than 200000,  ED  PROLOG  will  have
        reduced workspace.  If it's over 245000,  the amount of memory is
        optimal. If this is not the case, there are two possibilities:

        1) The machine doesn't have enough memory.

        2)  Something  else is removing memory from TPA,  such as  a  co-
        resident  program,  a  ramdisk,  a large dos driver,  or a  large
        number of file or disk buffers.

        If  you're  short of memory,  make sure that no  other  programs,
        ramdisks,  or drivers besides DOS are running in the machine. You
        may find it helps to eliminate (by renaming) the config.sys  file
        when you intend to run ED PROLOG.


                      How to run the Demonstration Programs
                        without Knowing What You're Doing

             We strongly advise that you purchase the book Programming in
        PROLOG by Clocksin and Mellish,  publisher Springer Verlag, 1981.
        For  the  impatient we give some advice.  Type the  demonstration
        program you wish to run.  There must be at least one entry  point
        within  the  program.

        Note:  Please  understand that these are demonstrations programs.
        Regarding  user  interface,  they are poorly  written.  You  will
        probably have to read Clocksin and Mellish to appreciate that the
        following examples of input are not equivalent: "yes." , "yes" .


        The animals program - "animal"

             Most  of the examples require C & M for  comprehension.  The
        program "animals", however, can be appreciated by anyone. It is a
        traditional   example of an expert system.

             We had hoped to include the animals program on disk,  but we
        have  found  to  our  dismay that the version which  we  used  is
        allegedly copyrighted by the implementors of PROLOG 86.  Don't be
        surprised - even "happy birthday" is copyrighted.  We will simply
        point out that the November '84 issue of Robotics Age included  a
        version  of  the  animals game,  which you can,  at the  risk  of
        copyright infringement,  type in.  There is only one change  that
        need  be  made.  The "concat" function used in that  program  has
        arguments of the form:







                      concat( [atom1, atom2,...], result ).

        In order to make the concat definition more closely resemble that
        of  "name",  which  is  described by Clocksin  and  Mellish,  the
        argments have been reversed:

                      concat( result, [atom1, atom2,...] )

        Assuming  that you have typed in the program and made the  change
        just noted, the following steps are required to run it:

             Run the prolog.exe file.  The prompt "?-" will appear.  Type
        "consult( 'animals' ).<CR>".  Here <CR> indicates you are to type
        a  carriage  return.  The PROLOG system will load  "animals"  and
        compile  it into an internal form.  When the "?-" prompt  appears
        PROLOG is ready to run the "animals" guessing game. The object of
        the program is to deduce the animal you are thinking of. To start
        it  off  type  "help.<CR>".  PROLOG  will  respond  by  asking  a
        question.
             Because of the way the animals program is written,  you must
        respond in a rigid format.  You may type "yes<CR>",  "no<CR>", or
        "why<CR>".
             Eventually the program will terminate with either a guess as
        to what animal you are thinking of,  or a remark that the  animal
        is  not within its domain of knowledge.  The program has learned,
        however.  You  may  run  the  program again to  see  what  effect
        additional knowledge has on the program's behavior.

             The program fragment "console" shows how you may improve the
        console input routines of any of these programs.


        The Hematology Diagnosis Program - "hemat"

             Although  the  logical structure is not as sophisticated  as
        that of "animals", it is interesting for several reasons:

             1)  The  program  evaluates numerical data to  arrive  at  a
        diagnosis.

             2) Although inaccurate, it demonstrates that useful question
        answering systems are not difficult to write in PROLOG.

             3)  There  are  some mistakes in  the  program,  which  only
        slightly impede its usefulness.

             This  program  uses  structure  input.  Terminate  all  your
        answers with a period, as in "y.<CR>", or "no.<CR>".
        The starting point is "signs.<CR>".  PROLOG will prompt  you
        for  signs  of  anemia.  The  program attempts  to  diagnose  two
        varieties of a hemolytic anemia.
             The program could use a good working over by a  hematologist
        and we would be delighted to collaborate.


        Prime Number Generator - "sieve"

             This  program demonstrates that anything can be programed in
        PROLOG if one tries hard enough.  Asking the  question






          "primes( 50, L ).<CR>" causes a list of prime numbers less than
        50  to be printed out.  "Sieve" is heavily recursive and  quickly
        exhausts the stack space of the small model interpreters.


        Grrules

             This  is  an  example  of the use  of  the  definite  clause
        grammer  notation.  PD  PROLOG  does not  have  this  translation
        facility,  but ED PROLOG and  all of our other versions do. It is
        possible  to  perform  the  translations  by  hand  if  you  have
        thoroughly  read  C  & M.  Then you would have  the  pleasure  of
        asking:

                 ?-sentence( X, [every,man,loves,a,woman], [] ).

        and  having the meaning elucidated as a statment in the predicate
        calculus.
















































                               Special Offer  # 1

             For  some  inexplicable reason,  demonstration programs  are
        hard to come by. We are too busy writing PROLOG fill this gap. We
        will  reward the contribution of "cute" sample programs with  the
        following:

             1) A free  copy of type VMI virtual memory PROLOG

             2) The sample program will be published as an intact file
             together with whatever comments or advertisments the author
             may see fit to include, on our distribution disks.

             3) Exceptional contributions may merit a copy of type VML
             large  model virtual memory PROLOG which now incorporates  a
             UNIX1 style tree structured domain system.


                                Special Offer # 2


             If  you are a hardware manufacturer and would like a  PROLOG
        language  for your system,  the solution is simple.  Just send us
        one  of  your machines!  Provided your system  implements  a  "C"
        compiler, it will be ported in no time flat.


        ______
             1. Trademark of AT & T.





































                         Writing Programs For ED PROLOG

             You do not type in programs at the "?-" prompt.  There is no
        built-in  editor.  The command "consult( user )" is accepted  but
        does not cause PROLOG to enter an editing mode.  We feel that the
        most universally acceptable editing method is for the user to use
        a text editor of choice,  which can be invoked from within PROLOG
        by the "exec" predicate.

             Use  Wordstar  or your customary editor to write a  program.
        Then  run  PD  PROLOG and use the consult function  to  load  the
        program.

             In  all  cases except PD PROLOG,  you can  run  your  editor
        without leaving PROLOG by use of the "exec" predicate.



















































                             Running the Interpreter

        COMMANDS: Give commands in lower case.

        TO RUN:
             Invoke PROLOG.EXE. After the "?-" prompt appears,
               type "consult( <filename><CR> )", where <filename> is the
               desired database.
             To exit, type "exitsys.<CR>"

        TO ENTER A FACT:
             Don't do it except with the "assert" predicates. This is the
             most  frequently misunderstood aspect of A.D.A.  Prolog.  If
             you want to enter a bunch of facts,  put them in a file  and
             "consult" them using the "consult" predicate.

        TO ASK A QUESTION:
             At the prompt, type "<expression>.<CR>", where
             <expression>  is  a  question as described by  Clocksin  and
             Mellish. Be sure to terminate the question with a period.
             The question may be up to 500 characters long.

        TO INPUT A STRUCTURE AT THE KEYBOARD:
             The structure may be up to 500 characters in length. Be sure
             to terminate with a period.

        TO ASK FOR ANOTHER SOLUTION:
             If a solution has been provided, the PROLOG interpreter will
             ask  "More?  (Y/N):".  Only  if  a "y"  is  typed  will  the
             interpreter perform a search.

        TO ABORT A SEARCH:
             Simply   type   the  escape  key.   The   interpreter   will
             respond  with  "Interrrupted.",  and return to  the  command
             prompt.

        TO LOAD ANOTHER DATABASE:
             Type  "consult(<filename>).<CR>" The file name must have the
             extension  ".PRO".  It  is  not  necessary  to  include  the
             extension in the argument of consult. The file name as given
             must not be the same as a predicate name in the file or  any
             file which will be loaded.

        TO TRACE:
             When the system displays the prompt "?-", type "trace.<CR>".
             The display will likely move too rapidly for you to read. To
             stop the display,  type Control S.  To restart the  display,
             type  Control S.  To turn the trace      display  off,  type
             "notrace<CR>"  at  the  prompt  "?-".   The  interrupt  menu
             contains  additional  options,  such  as sending  all  trace
             output to a file, as well as display at the console.















        TO INTERRUPT A PROGRAM:
             See  the  section  entitled  "The  Interrupt  Menu"  for   a
             description  of the flexible options.  Basically,  one types
             ESC  to terminate a program,  while Control V or  Control  I
             interrupt a program.

        TO RECONSULT A FILE:
             The   predicate  "recon"  is  identical  to  the   Edinburgh
             predicate "reconsult."

        TO REMOVE A DATABASE:
             Type "forget(<filename>).<CR>"

        TO EXIT TO THE OPERATING SYSTEM:
             Type "exitsys.<CR>"

             The system is totally interactive; any commands the operator
        gives  are and must be valid program statements.  Statements must
        terminate with a period.      All commands which take a file name
        also  accept a path name.  Any name which is not a  valid  PROLOG
        atom (refer to C & M) must be enclosed in single quotes. Thus one
        could say

             consult( expert )

        but one would need single quotes with

             consult( 'b:\samples\subtype\expert' ).


        To exit the system, type "exitsys.<CR>"

        Atoms  may contain MSDOS pathnames if they are enclosed by single
        quotes, ie.,  '\b:\samples\animal' .

        You may consult more than one file at a time.  However, all names
        are public and name conflicts must be avoided. The order in which
        modules are loaded may,  in cases of poor program design,  affect
        the behavior.



                             Command Line Arguments

             ED and PD PROLOG accept one command line argument,  which is
        the name of a "stream" which replaces the console for input.  The
        "stream"  in  MSDOS is a pipe or file which supplies input  until
        end-of-file is reached. Control then reverts back to the console.
        To avoid noisy parser error messages when end-of-file is reached,
        the  last command in the file should be "see( user )." See  Simon
        Blackwell's PIE program for an example of this.















                               A Reference of Note


             With  minor  exceptions,  the syntax is a superset  of  that
        described  by  Clocksin and Mellish in the  book  Programming  in
        Prolog by W.F.  Clocksin and C.S.  Mellish, published by Springer
        Verlag in Berlin, Heidelberg, New York, and Tokyo. We shall refer
        to this book as "C & M".


             There   are  very  few   syntactical   differences,   mostly
        unrecognized and/or minor.
             When  an operator is declared using the "op" statement,  the
        operator must be enclosed in single quotes in the "op"  statement
        itself,  if  it would not otherwise be a legal Edinburgh functor.
        Subsequently,  however,  the parser will recognize it for what it
        is,  except  in  the "unop" statement,  where it  must  again  be
        enclosed in single quotes.

             Variable numbers of functor paramaters are supported.

             A  goal  may be represented by a  variable,  which  is  less
        restrictive  than  the  C  &  M requirement  that  all  goals  be
        functors.  The  variable must be instantiated to a  functor  when
        that goal is pursued.

             Rules which appear inside other expressions must be enclosed
        in  parenthesis  if  the "," operator is to be  recognized  as  a
        logical connective.

             All  infix  operators described by C & M,  and user  defined
        infix,  prefix, and postfix operators with variable associativity
        and precedence are supported exactly as in C & M.

































                         The Built In Predicate Library

                        Available Operators in PD and ED PROLOG


        Column 1 gives the function symbol.

        Column 2 gives the precedence. The range of precedence is 1 to 255.
        A zero in the precedence column indicates the symbol is parsed as
        a functor, and precedence is meaningless in this case.

        Column 3 gives the associativity.
        A zero in the associativity column indicates the symbol is parsed
        as a functor, and associativity is meaningless in this case.

        Column 4 indicates which version the function is available in.
        Unless otherwise noted, the function is available in all versions.
        Nonstandard predicates are indicated by "NS".


        op/pred      precedence    associativity         availability

        "!"             0             0
        "|"             0             0
        "="             40,           XFX
        "=="            40,           XFX
        "\\="           40,           XFX
        "\\=="          40,           XFX
        "/"             21,           YFX
        "@="            40,           XFX
        ">="            40,           XFX
        "=<"            40,           XFX
        ">"             40,           XFX
        "<"             40,           XFX
        "-"             31,           YFX
        "*"             21,           YFX
        "+"             31,           YFX
        "=.."           40,           XFX
        "-->"           255,          YFY       (not  in  PD PROLOG)
        "?-"            255,          FY



        "arg"           0,            0,
        "asserta"       0,            0,
        "assertz"       0,            0,
        "atom"          0,            0,
        "atomic"        0,            0,
        "batch"         0,            0
        "clause"        0,            0,
        "clearops"      0,            0,
        "cls"           0,            0,       NS
        "concat"        0,            0,
        "consult"       8,            FX,
        "crtgmode"      0,            0,       NS
        "crtset"        0,            0,       NS
        "curset"        0,            0,       NS
        "curwh"         0,            0,       NS
        "debugging      0,            0,
        "dir"           0,            0,






        "display"       0,            0,
        "dotcolor"      0,            0,       NS
        "drawchar"      0,            0,       NS
        "drawdot"       0,            0,       NS
        "drawline"      0,            0,       NS
        "exec"          0,            0,
        "exitsys"       0,            0,       NS
        "forget"        0,            0,       NS
        "functor"       0,            0,
        "get0"          8,            FX,
        "integer"       0,            0,
        "is"            40,           XFX,
        "listing"       0,            0,
        "memleft"       0,            0,      NS
        "mod"           11,           XFX,
        "name"          0,            0,
        "nl"            0,            0,
        "nodebug"       0,            0,       (not in PD PROLOG)
        "nonvar"        0,            0,
        "nospy"         50,           FX,      (not in PD PROLOG)
        "not"           60            FX
        "notrace"       0,            0,       (not in PD PROLOG)
        "op"            0,            0,
        "popoff"        0,            0,       NS
        "popoffd"       0,            0,       NS
        "popon"         0,            0,       NS
        "popond"        0,            0,       NS
        "print"         0,            0,
        "prtscr"        0,            0,       NS
        "put"           0,            0,
        "ratom"         0,            0,
        "read"          0,            0,
        "recon"         0,            0, (Note: this is "reconsult")
        "repeat"        0,            0,
        "retract"       0,            0
        "rnum"          0,            0,
        "see"           0,            0,
        "seeing"        0,            0,
        "seen"          0,            0,
        "skip"          0,            0,       (not in PD PROLOG)
        "spy"           50,           FX,
        "tab"           0,            0,
        "tell"          0,            0,
        "telling"       0,            0,
        "told"          0,            0,
        "trace"         0,            0,       (not in PD PROLOG)
        "true"          0,            0,
        "unop"          0,            0,
        "var"           0,            0,
        "write"         0,            0,
                        Description of the Modifications.


        I/O Redirection

        I/O  redirection is a feature described by Clocksin and  Mellish.
        The predicates "see",  "seeing",  "seen",  "tell", "telling", and
        "told" are used to select the streams used for input and output.

             The  predicates  "seen" and "told" require as arguments  the






        name of the stream that is to be closed.  This enables the system
        to  remember the indices of several streams and switch  back  and
        forth between them.

             The  predicate "batch",  when inserted at the beginning of a
        stream file, has the following properties:

             1)  The normal prompt,  "?-",  and advisory messages do  not
             appear at the screen.

             2)  It is self cancelling if the input stream is  reassigned
             to the console.

             3) It may also be cancelled by the predicate "batch".



        call( <goal> )

             The  predicate as defined in C & M is obsolete.  The purpose
        was  to permit a goal search where the goal name was  a  variable
        instantiated  to  some functor name.  A.D.A.  permits writing  of
        goals with such names,  so the mediation of the "call" clause  is
        no longer necessary.

             The  "call"  predicate  may  be  trivially  implemented  for
        compatibility with the PROLOG definition

                                 call( X ) :- X.



        clause

             The  function  clause(  X,  Y ) has the  new  optional  form
        clause(  X,  Y,  I  ).  If the third variable is written,  it  is
        instantiated  to the current address of a clause in  memory.  The
        only  use of the result is with succeeding assertfa and  assertfz
        statements.



























        debugging

             "Debugging"  prints a list of the current  spypoints.  After
        each name a sequence of numbers may appear, indicating the number
        of  arguments that is a condition of the trace.  The  word  "all"
        appears  if  the  number of arguments is not a condition  of  the
        trace.

        op( <prec>, <assoc>, <functor> )

             Defines  the  user  definable  grammar  of  a  functor.  The
        definition conforms to that in C & M. We mention here a minor but
        important point.  If <functor> is not a valid PROLOG atom it must
        be   enclosed  in  single  quotes  when  declared  in  the   "op"
        declaration.  It  is  not necessary or legal to do this when  the
        functor is actually being used as an operator.  In version 1.6, a
        declared  or built-in operator can be used either as an  operator
        or as a functor. For example,

                                 +(2,3) = 2 + 3.

        is a true statement.

             Declared  operators  are annotated in the directory  display
        with their precedence and associativity.









































        Output predicates

           display
           write
           print
           put

             These  functions  have  been  modified  to  accept  multiple
        arguments in the form:

                       print( <arg1>, <arg2>, <arg3>,... )

        Thus, "put( a, b, c )" would result in the display of "abc".
             The  names  of  some  PROLOG atoms that may  occur  are  not
        accepted  by  the  PROLOG scanner  unless  surrounded  by  single
        quotes.  This only applies when such an atom is read in, not when
        it is internally generated. Nevertheless, this presents us with a
        problem:  We  would  like to be capable of writing  valid  PROLOG
        terms to a file. In some cases, it is necessary to add the single
        quotes.  In other cases,  such as human oriented output, they are
        an irritant. The modified definitions of the following predicates
        are an attempt at a solution:

             display
             Operator  precedence  is ignored,  all functors are  printed
             prefix and single quotes are printed if needed or they  were
             supplied if and when the atom was originally input.

             write
             Operator  precedence is taken into account and operators are
             printed according to precedence.  Single quotes are  printed
             under the same conditions as for "display."

             print
             Operator  precedence is taken into account and operators are
             printed  according to precedence.  Single quotes  are  never
             displayed.  This  is  a  human oriented form of  output  and
             should  never  be used for writing of terms for  the  PROLOG
             scanner.



























        get0
        read

             The  functions  "get0"  and "read"  have  been  extended  to
        support input from a stream other than the one currently selected
        by "see". To direct output to a file or other stream, an optional
        argument  is used.  For example,  "get0( char,  <file name> )" or
        "get0( char,  user )" would cause input to come from <file  name>
        or the console.  If the file has not already been opened,  "get0"
        will fail.



             Atoms enclosed by single quotest, eg. '\nthis is a new line'
        can contain the escape sequences

             '\n', '\r', '\t' and '\''.

             If these atoms are printed by "display" or "write" they  are
        printed  just  as they are.  If they are printed by  the  "print"
        clause they are translated as follows:

        '\n'  results  in  the printing of a carriage return and  a  line
        feed.
        '\r' results in the printing of a carriage return only.
        '\t' results in the printing of a tab character.
        '\'' allows the printing of a single quote within a quoted atom.

             The "portray" feature is not presently implemented.





































                        Description of the New Predicates


        clearops-

             Nullify  the  operator  status  of  every  operator  in  the
             database.

        concat( (<variable> | <functor>), <List> )

             A  list  of functors or operators is concatenated  into  one
        string,  which becomes the name of a new atom to which <variable>
        or <functor> must match or be instantiated.


        dir( option )

             Provide  an  alphabetized listing to the console  of  atoms,
        constants,   or   open  files.   Without  options,   simply  type
        "dir.<CR>". Options are:

             dir( p ) - list clause names only.
             dir( c ) - list consulted files only.

        Consulted files are prefixed by "S:".


        exitsys

             Exit to the operating system.



        forget( <file name> )
             Make  a database unavailable for use and reclaim the storage
        it occupied.



        ratom( <arg>, <stream> )-
             Read an atom from the input stream,  to which <arg>  matches
        or  is  instantiated.  <stream> is optional.  If <stream> is  not
        given, the input stream defaults to the standar input.
             Input is terminated by a CR or LF, which are not included in
        the stream.





















                             Arithmetic Capabilities

             Integer  arithmetic is supported.  Numbers are 32 bit signed
        quantities. The following arithmetic operators are supported:

                      "+", "-", "*", "/", <, <=, >, >=, mod.

        Arithmetic operators must never be used as goals,  although  they
        may be part of structures. It is legal to write:

                                    X = a + b

        which  results in the instantiation of X to the struture (a + b).
        But the following is not legal:

                       alpha( X, Y ) :- X + Y, beta( Y ).


        Evaluation  of  an arithemtic expression is mediated by the  "is"
        and inequality predicates.  For instance,  the following would be
        correct:

                         alpha( X, Y, Z ) :- Z is X + Y.

                         beta( X, Y ) :- X + 2 < Y + 3.









































                            Memory Metric Predicate

             The purpose of this predicate is to give the prolog system
        a  sense  of  how much memory remains so  that  expensive  search
        strategies  can  be  controlled.  It is not possible  to  exactly
        quantify how much memory remains.  At the lowest level, there are
        two  types of memory - the stack and the heap.  The stack expands
        down  from  high  memory,  while  the heap  tends  to  expand  at
        unpredictable intervals upwards.  If the stack and heap meet, the
        prolog  system  must abort the search and return to  the  prompt.
        Judicious  use  of  the  memory  metric  predicates  reduces  the
        probability of this happening.

             The  stack is easy to quantify because it expands  downwards
        in  a  predictable  way with recursion.  The symbol  space  is  a
        "heap".  For  those  interested,  the structure of  the  heap  is
        determined  by  the C compiler under which Prolog  was  compiled.
        There  is  a function internal to Prolog known as  the  allocator
        searches  the  heap for enough contiguous memory to create a  new
        symbol.  The  heap resembles a piece of Swiss cheese;  the  holes
        represent symbols and already allocated memory while the remained
        is  searched  by the allocator for a piece of  contiguous  memory
        large enough to satisfy a request.  If one cannot be  found,  the
        uppermost  bound of the heap is expanded upwards,  and that bound
        is  the  number  which we measure for an  estimate  of  remaining
        memory.

             The  sqace between the top of the heap,  and  the top of the
        stack,  which we call "gap",  serves as a rough guide to how much
        memory  remains.  The  demands  of the system  are  not  entirely
        predictable,  however.  For example, the creation of a new symbol
        larger  than "gap" would cause an abort.  The user must  use  the
        numbers  supplied  by  these  functions  as  a  heuristic  guide,
        tempered  by  experience,  to  minimize  the  possibility  of  an
        unexpected abort.

        "Gap" is measured in 256 byte pages.

        memleft( X )

        If  the argument is an integer,  this is satisfied if the size of
        "gap" is greater than "X".

        If the argument is a variable,  it is instantiated to the  amount
        of "gap" remaining.





















                         IBM PC Video Display Predicates


        A high level method is provided for drawing and displaying on the
        screen of IBM PC and compatible computers.



        cls

        Clear  the screen and position the cursor at the upper left  hand
        corner.



        crtgmode( X )

        Matches  the  argument to the mode byte of the display  which  is
        defined as follows:

                  mode           meaning

                   0             40 x  25  BW (default)
                   1             40 x  25  COLOR
                   2             80 x  25  BW
                   3             80 x  25  COLOR
                   4            320 x 200  COLOR
                   5            320 x 200  BW
                   6            640 x 200  BW
                   7             80 x  25  monochrome  display card



        crtset( X )

        This  sets the mode of the display.  The argument must be one  of
        the modes given above.



        curset( <row>, <column>, <page> )

        Sets the cursor to the given row, column, and page. The arguments
        must be integers.



        curwh(  <row>, <column> )

        Reports the current position of the cursor.  The argument must be
        an integer or variable. The format is:

             1) page zero is assumed.
             2) The row is in the range 0 to 79, left to right.
             3) The column is in the range 0 to 24, bottom to top.
        dotcolor( <row>, <column>, <color> )

        The  argument  <color> is matched to the color of  the  specified
        dot. The monitor must be in graphics mode.









        drawchar( <character>, <attribute> )

        Put a character at the current cursor position with the specified
        attribute.  The  arguments  <character> and <attribute>  must  be
        integers.  Consult  the IBM technical reference manual  regarding
        attributes.



        drawdot( <row>, <column>, <color> )

        Put  a dot at the specified position.  The monitor must be in the
        graphics  mode.  The  arguments  must be  integer.  The  argument
        <color> is mapped to integers by default in the following manner:



        drawline( <X1>, <Y1>, <X2>, <Y2>, <color> )

        Draw a line on the between the coordinate pairs. The monitor must
        be in the graphics mode and the arguments are integer.



        prtscr

        Print  the  screen  as it currently appears.  Be  sure  that  the
        printer  is  on  line and ready before invoking  this  predicate,
        since otherwise, the system may lock up or abort.



        The  integer argument <color> referred to in the above predicates
        is represented as follows:

             COLOR          PALETTE 0           PALETTE 1

               0            background          background
               1            green               cyan
               2            red                 magenta
               3            brown               white

        To change the palette and the background,  see the IBM  Technical
        Reference Bios listings for more information.




















                                   Trace Files

                                 (type ED only)

             You  can  now dump your trace to disk,  instead  of  (groan)
        wasting  reams of printer paper.  This option is described in the
        next section.


                               The Interrupt Menu

                                 (type ED only)

             This  menu  has been modified.  It was formerly  called  the
        ESCAPE   menu,  but  the  meaning  of the  ESCAPE  key  has  been
        redefined.  It  is  no  longer necessary to display the  menu  to
        perform  one of the menu functions.  This reduces the  amount  of
        display which is lost by scrolling off the screen.

             At any time while searching, printing, or accepting keyboard
        input,  you can break to this menu.  It is generally not possible
        to  do  this  during disk access,  since control  passes  to  the
        operating  system  at this time.  Two keys cause  this  break  to
        occur:

             ^V:  The menu is displayed and a command is accepted at the
                  prompt  "INTERRUPT>".  After  a command,  the  menu  is
                  redisplayed  until  the user selects  a  command  which
                  causes an exit.

             ^I:  The menu is not displayed.  Command is accepted at the
                  prompt  "INTERRUPT>" until the user selects  a  command
                  which causes an exit.

             ESC: Typing this key  causes a  termination of  the  PROLOG
                  search  and  control returns to the user command  level
                  with a prompt of "?-".  Notice that previously, the ESC
                  key invoked this menu.




























             As the resulting menu indicates, the following functions are
        possible:

             A: Abort the search and return to the prompt.

             O  Open  a trace file.  The user is prompted for  the  file
                name.  The file receives all trace output.  If a file is
                already opened it is closed with all output preserved.

             C  Close the trace file if one is open.  Otherwise there is
                no effect.

            ^C: Immediately  exit PROLOG without closing files.  This is
                not advised.

            ^P: Typing <Control>P toggles the printer. If the printer is
                on,  all  input  and output will also be  routed  to  the
                printer.

             S: If  the machine in use is an IBM PC compatible  machine,
                the  currently displayed screen will be printed.  If  the
                machine  is  not an IBM PC compatible,  do not  use  this
                function.

             T: If  trace  is in use,  most of the trace output  can  be
                temporarily turned off by use of this function,  which is
                a toggle.

             R:  Entering  another  ESC causes a return to the  current
                activity  (keyboard  input or search)  with  no  residual
                effect from the interruption.




































                             Conserving memory space


               Success popping is controlled by the predicates "popond",
        "popoffd",  "popon",  and  "popoff".  Success popping is means of
        reclaiming  storage which is used on backtracking to  reconstruct
        how a particular goal was satisfied.  If it is obvious that there
        is no alternative solution to a goal this PROLOG system is  smart
        enough to reclaim that storage.

             In  this system,  succees popping is an expensive operation.
        Therefore,  there  is a tradeoff of memory versus  time.  On  the
        other hand, discrete use of success popping can actually speed up
        a program by recreating structures in a more accessible form.

             The  definitions of the control predicates is given in  this
        manual  and  their use is totally  optional.  The  modulation  of
        success popping has no effect on program logic (read solution.)

             The  "cut"  can  save  substantial  time  and  computational
        overhead  as well as storage.  Although the execution of the  cut
        costs  time,  you can design your program to use cuts in critical
        places  to  avoid unnecessary backtracking.  Thus  the  execution
        speed of the program can actually increase.

             Anyone  who  has  read Clocksin and  Mellish  is  aware,  of
        course, that the "cut" has a powerful logical impact which is not
        always desirable.


        popoff

        See the below definition.



        popon

        The  inference  engine  does complete success popping  for  goals
        which appear after "popon".  Consider this example:

          goal :-  a, popon, b, c, popoff, d.

        If  no alternative solutions exist for b,  then  success  popping
        will  reclaim storage by removing unnecessary records  describing
        how  "b"  was  satisfied.  If the Prolog system cannot  rule  out
        possible additional solutions,  success popping will never occur,
        regardless of your use of "popon".
             Since goal "d" occurs after "popoff",  success popping  will
        never occur.















        popoffd

        If  no  "popon" or "popoff" declarations occur in a  clause,  the
        default  action  is  determined by  "popoffd"  and  "popond".  If
        "popoffd" has been invoked,  the default is that success  popping
        will not occur.



        popond

        The inverse of "popoffd". Turns on default success popping.
        printf( <stream>, <term1>,<term2>,... )





















































                                 Prolog Tutorial


                                  Introduction




             Probably  you  have heard of the language PROLOG within  the
        last year or so. You probably wondered the following things:

        1) What does the name stand for? Names of computer languages are
        almost always acronyms.

        2) What is it good for?

        3) Why now?

        4) Can I get a copy to play with?

             Congratulations! You obviously know the answer to the fourth
        question. We now respond to the other three.

        1)  The  name  stands for "programming in logic." This  we  shall
        elaborate on in depth later on.

        2) PROLOG is good for writing question answering systems.  It  is
        also   good   for  writing  programs  that  perform   complicated
        strategies  that  compute the best or worst way to  accomplish  a
        task, or avoid an undesirable result.

        3) PROLOG was virtually unknown in this country until researchers
        in  Japan announced that it was to be the core language  of  that
        country's fifth generation computer project.  This is the project
        with  which  Japan hopes to achieve a domainant position  in  the
        world information industry of the 1990's.

             PROLOG  is  one of the most unusual computer languages  ever
        invented.  It  cannot be compared to  FORTRAN,  PASCAL,  "C",  or
        BASIC.  The facilities complement,  rather than replace those  of
        conventional  languages.  Although  it  has great  potential  for
        database  work,  it  has  nothing in  common  with  the  database
        languages used on microcomputers.

             Perhaps  the  best point to make is that while  conventional
        languages are prescriptive, PROLOG is descriptive. A statement in
        a conventional language might read:

             if( car_wheels = TRUE ) then
               begin
                 (some sort of procedure)
                 X = X + 1;
               end













        A statment in PROLOG could just be a statment of fact about  cars
        and wheels. There are many relationships that hold. For instance,

             has( car, wheels ).

             has( car, quant(wheels, four) ).

             round( wheels ).

        Each  of  these statments is an independent fact  relating  cars,
        wheels,  and  the  characteristics of wheels.  Because  they  are
        independent, they can be put into a PROLOG program by programmers
        working separately. The man who is a specialist on car bodies can
        say  his thing,  the wheel specialist can have his say,  and  the
        participants can work with relative independence. And this brings
        to light a major advantage of PROLOG:


                             PARALLEL PROGRAMMING!!!


        With  conventional  programming languages projects can  still  be
        "chunked",  or  divided between programmers.  But efficiency on a
        team  project  drops  drastically below that  of  the  individual
        programmer  wrapped  up  in  his own trance.  As  the  number  of
        participants    grows   the   need   for   communication    grows
        geometrically. The time spent communicating can exceed that spent
        programming!
             Although   PROLOG   does   not  eliminate   the   need   for
        task  coordination,  the problem is considerably  simplified.  It
        also provides the ability to answer questions in a "ready to  eat
        form."  Consider your favorite BASIC interpreter.  Based upon the
        statements about cars and wheels previously given,  could you ask
        it the following question?


              has( car, X ), round( X ).

             Does  a  car  have anything which  is  round?  The  question
        instructs the PROLOG interpreter to consider all the objects that
        it  knows are possessed by a car and find those which are  round.
        Perhaps  you are beginning to guess that PROLOG has the abilities
        of a smart database searcher.  It can not only find the facts but
        selectively find them and interpret them.






















             Consider the problem of a fault tree, as exemplified by this
        abbreviated one:



        {Car won't start}
             |
             |
        [Engine  turns  over](No) --> [Battery voltage](no)-\
                (Yes)                                       v
                 |                                  {Check battery}
                 |
        [Smell gasoline](yes) --> {Try full throttle cranking}
                 |                       (failure)
        /--------/                           |

                            (details omitted)



             The fault tree is easily programmed in BASIC. Later we shall
        show  that  PROLOG supplies a superior replacement for the  fault
        tree.  Though the tree is capable of diagnosing only the  problem
        for  which  it was designed,  PROLOG dynamically  constructs  the
        appropriate  tree from facts and rules you have provided.  PROLOG
        is not limited to answering one specific question.  Given  enough
        information,  it  will attempt to find all deductive solutions to
        any problem.







































                                  PROLOG PRIMER

        I.                       Rules and Facts



             This  is  where you should start if you know  nothing  about
        PROLOG. Let us consider a simple statment in PROLOG, such as:

        1)   has( car, wheels ).

        This  statement  is a "fact.  The word "has" in this statment  is
        known  either  as a functor or predicate.  It is a name  for  the
        relationship  within the parenthesis.  It implies that a car  has
        wheels.  But  the  order  of  the words  inside  the  bracket  is
        arbitrary and established by you. You could just as easily say:

        2)   has( wheels, car ).

        and if you wrote this way consistently,  all would be  well.  The
        words  has,  wheels,  and car are all PROLOG atoms.  "Wheels" and
        "car" are constants.

        A   database   of  facts  can  illustrate  the   data   retrieval
        capabilities of PROLOG. For instance:

        3)   has( car, wheels ).
             has( car, frame ).
             has( car, windshield ).
             has( car, engine ).

        You could then ask PROLOG the question:

        4)   has( car, Part ).

        The  capital  "P" of Part means that Part is a  variable.  PROLOG
        will make Part equal to whatever constant is required to make the
        question match one of the facts in the database. Thus PROLOG will
        respond:

             Part = wheels.

             More?(Y/N):

        If you type "y" the next answer will appear:

             Part = frame.

             More?(Y/N):

        If you continue, PROLOG will produce the answers Part = windshield
        and Part = engine. Finally, you will see:

             More?(Y/N):y

             No.

        indicating that PROLOG has exhausted the database.  Incidentally,
        when  a  variable is set equal to a constant or  other  variable,






        it is said to be instantiated to that object.

             Notice  that  PROLOG searches the database forwards  and  in
        this case,  from the beginning.  The forward search path is built
        into PROLOG and cannot be changed. An author of a program written
        in  a  prescriptive language is quite conscious of the  order  of
        execution  of  his program,  while in PROLOG it is  not  directly
        under his control.

             The other major element is the rule which is a fact which is
        conditionally true. In logic this is called a Horn clause:


        5)   has( X, wheels ) :- iscar( X ).

        The  fact iscar( car ) and the above rule are equivalent to

        6)   has( car, wheels).

        The  symbol :- is the "rule sign." The expression on the left  of
        :-is the "head" and on the right is the body.  The variable X has
        scope  of the rule,  which means that it has meaning only  within
        the rule.  For instance,  we could have two rules in the database
        using identically named variables.


        7)   has( X,  transportation ) :-
                           has( X,  car ), has( license, X ).

        8)   has( X, elephant ) :- istrainer( X ), hasjob( X ).

        The  variables  X in the two expressions are completely  distinct
        and have nothing to do with each other.

        The comma between has( X, car ) and has( license, X ) means "and"
        or logical conjuction.  The rule will not be true unless both the
        clauses has(X, car) and has( license, X ) are true.


             On the other hand if there is a rule

        9)   has( license, X ) :- passedexam( X ).

        consider what PROLOG will do in response to the question:

        10)  has( harry, transportation ).

        (Notice  that  harry has not been capitalized because we  do  not
        want  it  taken as a variable.  We could,  however,  say  'Harry'
        enclosed in single quotes.)

             It  will scan the database and use (7),  in which X will  be
        instantiated to harry. The rule generates two new questions:

        11)  has( harry, car ).

        12)  has( license, harry ).

        Assuming  that  harry  has  a car,  the first clause  of  (7)  is
        satisfied and the database is scanned for a match to (12). PROLOG






        picks  up  rule (9) in which X is instantiated to harry  and  the
        question is now posed:

        13)  passedexam( harry ).

             If there is a fact:

             passedexam( harry ).

        in  the database then all is well and harry  has  transportation.
        If there is not, then PROLOG will succinctly tell you:

             No.

        But  suppose Harry has money and can hire a chauffer as any  good
        programmer  can.  That  could be made part of the program in  the
        following way.

             The rule which PROLOG tried to use was:

        14)  has( X,  transportation ) :-
                           has( X,  car ), has( license, X ).

        At any point following it there could be included another rule:

        15)  has( X, transportation ) :- has( X, money ).

        or simply the bald fact:

        16)  has( harry, transportation ).

             These  additional  rules  or  facts would  be  used  in  two
        circumstances.  If at any point a rule does not yield a solution,
        PROLOG   will  scan  forward  from  that  rule  to  find  another
        applicable  one.  This process is known as "backtracking  search"
        and can be quite time consuming.


        If  in response to the "More?" prompt you answer "y" PROLOG  will
        search  for an additional distinct solution.  It will attempt  to
        find an alternate rule or fact for the last rule or fact used. If
        that  fails,  it  will back up to the antecedent rule and try  to
        find  an alternate antecedent.  And it will continue to  back  up
        until  it  arrives at the question you asked,  at which point  it
        will say:

             No.

        "Antecedent"  to a rule means that it gave rise to its' use.  For
        example,  (7)  is  the antecedent of (9) in the  context  of  the
        question (16).




        II.                          Grammar

             It is a boring subject, but it must be discussed. All PROLOG
        statements are composed of valid terms, possibly a rule sign (":-
        "),  commas representing conjunction ("and"), and a period at the






        very end.
             A term is a structure, constant, variable, or number.

             What is a structure? It is a kind of grouping:

             1) Structures consist of a functor, and a set of objects or
                structures in parenthesis.

             2)  Objects are constants,  variables,  numbers,  or  lists,
                which we have not discussed yet.

             3)  A  constant or functor must be a string of  letters  and
                numbers, beginning with a lower case letter, unless
                you  choose  to  enclose  it in single  quotes  (  'howdy
                pardner'  ),  in  which  case you are  freed  from  these
                restrictions.
             4) A  variable  must be a string of  letters  and  numbers
                beginning with a capital letter.

             5) A  functor  may optionally have  arguments  enclosed  in
                parenthesis , as in: hascar( X ) or hascar.

        An example:  "has( X, transportation )." is a structure.











































        III.                     Input / Output

             You   now   know  enough  to  write  simple  databases   and
        interrogate   them  profitably.   But  before  we  examine   more
        sophisticated  examples,  it  will be necessary to add input  and
        output to the language. There are built in functions which appear
        as rules which are satisfied once. Thus the statment:

             write( 'Hello world.' ).

        can be included on the right side of a rule:


        greetings(  X ) :- ishuman( X ),  write( 'Hello world.' ).  You
        can  also write "write( X )" where X is some variable.  Note that
        'Hello  world.' is not enclosed in double quotes.  Single quotes,
        which denote a constant, are required. Double quotes would denote
        a list, which is another thing entirely.

        Provided  that  a match to "ishuman" can be  found,  the  builtin
        function  "write"  is  executed and the message  printed  to  the
        screen.
             The  builtin  read( X ) reads a "structure" that  you  input
        from the keyboard. More formally, we have

             read( <variable> or <constant> )
             write( <variable> or <constant> )

        If you write read( Input ),  then the variable "keyboard" will be
        assigned to whatever is typed at the keyboard,  provided that the
        input  is a valid PROLOG structure.  The builtin "read" will fail
        if instead of Keyboard we wrote read( baloney ),  where "baloney"
        is a constant,  and the user at the keyboard did not type exactly
        "baloney."

        When you input a structure in response to a "read" statement,  be
        sure to end it with a period and an <ENTER>.

             There  is  a convenient way of putting the cursor on  a  new
        line. This is the builtin "nl". For example:

             showme :- write( 'line 1' ), nl, write( 'line 2' ).

        would result in:

             line 1
             line 2

             There  is  also a primitive form of input/output for  single
        characters. It will be discussed later.
















        IV.                   A Fault Tree Example

             Consider the "won't start" fault tree for an automobile:

        {Car won't start}
             |
             |
        [Engine  turns  over](No) --> [Battery voltage](no)-\
                (Yes)                                       v
                 |                                  {Check battery}
                 |
        [Smell gasoline](yes) --> {Try full throttle cranking}
                 |                       (failure)
        /--------/                           |
        |           /------------------------/
        |           |
        |           |
        |  [Check for fuel line leaks](yes)-->{Replace fuel line}
        |          (no)
        |           |
        |           |
        |  [Check for defective carburator](yes)--\
        |          (no)                           v
        |                                {Repair carburator}
        \----\
             |
             |
        [Is spark present](no)-->[Do points open and close](no)-\
             |                             (yes)                v
        /----/                               |          {Adjust points}
        |           /------------------------/
        |           |
        |  [Pull distributor wire, observe spark](blue)--\
        |        (orange)                                v
        |           |                           {Check plug wires & cap}
        |           |
        |  [Measure voltage on coil primary](not 12V)--\
        |         (12V)                                v
        |           |              {Check wiring, ballast resistor}
        |           |
        |  [Check condenser with ohmmeter](conducts)--\
        |    (no conduction)                          v
        |           |                         {Replace condenser}
        |           |
        |  [Open and close points](voltage not 0 - 12)--\
        |   (voltage swings 0 - 12)                     v
        |           |                         {Fix primary circuit}
        |           |
        |  {Consider hidden fault, swap components]
        |
        |
        \-------{Call a tow truck!!}














             A PROLOG program to  implement this is simple. Each statment
        represents  a  decision point fragment of the  tree.  The  PROLOG
        interpreter  dynamically  assembles  the tree as  it  attempts  a
        solution.

        'car wont start' :- write( 'Is the battery voltage low?' ),
                            affirm, nl,
                            write( 'Check battery' ).

        'car wont start' :- write( 'Smell gasoline?' ),
                            affirm, nl,
                            'fuel system'.

        'fuel system'    :- write( 'Try full throttle cranking' ).

        'fuel system'    :- write( 'Are there fuel line leaks?' ),
                            affirm, nl,
                            write( 'Replace fuel line.' ).

        'fuel system'    :- write( 'Check carburator' ).

        'car wont start' :- write( 'Is spark present?' ),
                            not( affirm ), nl,
                            'no spark'.

        'no spark'       :- write( 'Do points open and close?' ),
                            not( affirm ), nl,
                            write( 'Adjust or replace points.' ).

        'no spark'       :- write( 'Is the spark off the coil good?' ),
                            affirm,
                            write( 'Check plug wires and cap.' ).

        'no spark'       :- write( 'What is the voltage on the primary
                             of the coil: ' ),
                            read( Volts ),
                            Volts < 10,
                            nl,
                            write('Check wiring and ballast resistor.').

        'no spark'       :- write( 'Does the capacitor leak?' ),
                            affirm,
                            write( 'Replace the capacitor.' ).

        'no spark'       :- not( 'primary circuit' ).

        'primary circuit'
                         :- write( 'Open the  points.  Voltage  across
                              coil?:'), nl,
                            read( Openvolts ), Openvolts < 1,
                            write(  'Close the points.  Voltage  across
                              coil?:'),
                            read( Closevolts ), Closevolts > 10, nl,
                            write( 'Primary circuit is OK.' ).

        'no spark'       :- write( 'Consider a hidden fault. Swap
                              cap, rotor,points,capacitor.' ).


        'Car wont start' :- write( 'Get a tow truck!!' ).








                                 --End program--


             The  above  is  a  simple example of  an  expert  system.  A
        sophisticated  system would tell you exactly the method by  which
        it  has reached a conclusion.  It would communicate by a  "shell"
        program  written  in PROLOG which would accept a wider  range  of
        input   than  the  "valid  structure"  required  by  the   PROLOG
        interpreter directly.























































        V.                            Lists

             Consider  a  shopping list given you by your wife.  It is  a
        piece of paper with items written on it in an order that probably
        symbolizes  their  importance.  At the top it  may  say  EGGS!!!,
        followed by carrots, hamburger, and finally a flea collar for the
        dog, if you can find one. In PROLOG such a list would be written:

        1)   [eggs, carrots, hamburger, fleacollar]

        The  order of a list is important so that eggs and carrots cannot
        be reversed and PROLOG be uncaring.

        Let us put the list in a structure:

             shopping( [eggs, carrots, hamburger, fleacollar] ).

        Then  if you wished to isolate the head of the list you could ask
        the question:

             shopping( [ Mostimportant | Rest ] ).

        and PROLOG would respond:

             Mostimportant   =  eggs,
             Rest   =   [carrots,   hamburger, fleacollar].

        The vertical bar "|" is crucial here. It is the string extraction
        operator,  which  performs  a  combination  of the  CDR  and  CAR
        functions  of LISP.  When it appears in the context [X|Y] it  can
        separate the head of the list from the rest, or tail.


             You  may have gained the impression that PROLOG is a  rather
        static language capable of answering simple questions,  but it is
        far  more powerful than that.  The string extraction operator  is
        the  key.  It permits PROLOG to whittle a complex expression down
        to the bare remainder.  If the rules you have given it permit  it
        to  whittle  the  remainder  down to  nothing,  then  success  is
        achieved. An example of this is the definition of "append."

             Let  us suppose you have not yet done yesterday's  shopping,
        let alone today's. You pull it out of your wallet and sootch tape
        it to the list your wife just gave you. Yesterday's list was:

             [tomatoes, onions, ketchup]

        Combined with [eggs, carrots, hamburger, fleacollar] we obtain

             [eggs,carrots,hamburger,fleacollar,tomatoes,onions,garlic].

        To  take one list and to attach it to the tail of another list is
        to  "append"  the first to the second.  The PROLOG definition  of
        append is:



        Rule1:     append( [], L, L ).

        Rule2:     append( [X|List1], List2, [X|List3] ) :-






                      append( List1, List2, List3 ].

        The  general  scheme is this:

        The definition consists of one rule and one fact.  The rule  will
        be used over and over again until what little is left matches the
        fact.  The [] stands for empty list,  which is like a bag without
        anything in it. This is an example of a recursive definition.
             Suppose we ask:

             append( [a,b,c], [d,e,f], Whatgives ).

        1. Rule 2 is invoked with arguments ( [a,b,c], [d,e,f], Whatgives ).
        2. Rule 2 is invoked again with arguments:
             ( [b,c], [d,e,f], List3 ).
        3. Rule 2 is invoked again with arguments:
             ( [b], [d,e,f], List3 ).
        4.  The  arguments  are now ([],  [d,e,f],  List3 ).  Rule 1  now
            matches. End.

        How does this cause a list to be constructed? The key is to watch
        the   third  argument.   Supplied  by  the  user,   it  is  named
        "Whatgives". The inference engine matches it to [X|List3] in rule
        2. Now lets trace this as rule two is successivly invoked:


                Whatgives
                   |
                   |
                   |
                   v
        Rule2:  [X|List3] (List1 = [b,c])
                 |  \
                 |   \
                 |    \
                 v     \
        Rule2:   a   [X'|List3'] (List1' = [c])
                      |    \
                      |     \
                      |      \
                      v       \
        Rule2:        b     [X''|List3''] (List1'' = [], ie., empty set.)
                              |    \
                              |     \
                              |      \
        Rule1:                c       L  ( in Rule1 = [d,e,f] )

        End.


        L in rule 1 is [d,e,f] for the following reason: Notice that rule
        2 never alters List2. It supplies it to whatever rule it invokes.
        So L in rule 1 is the original List2, or [a,b,c].

             This example would not have worked if the order of rules one
        and  two  were  reversed.  The  PROLOG  inference  engine  always
        attempts to use the the first rule encountered. You could imagine
        it as always reading your program from the top down in attempting
        to  find an appropriate rule.  Since rule 2 would always satisfy,
        an  unpleasant  thing  would  have happened  if  the  order  were






        reversed. The program would loop forever.




             I  hope  that  this tiny introduction to PROLOG  whets  your
        appetite. You should now purchase the book

             Programming In Prolog
             W.F. Clocksin and C.S. Mellish
             Springer - Verlag
             Berlin,Heidelberg,New York. 1981,1984





















































read_in([W|Ws]) :- get0(C), readword(C,W,C1), restsent(W,C1,Ws).

restsent( W,_,[]) :- lastword(W), !.
restsent(W,C,[W1|Ws]) :- readword(C,W1,C1), restsent(W1,C1,Ws).

readword(C,W,C1) :- single_character(C), !, name(W,[C]), get0(C1).
readword(C,W,C2) :-
    in_word(C,NewC), !,
    get0(C1),
    restword(C1,Cs,C2),
    name(W,[NewC|Cs]).
readword(C,W,C2) :- get0(C1), readword(C1,W,C2).

restword(C,[NewC|Cs],C2) :-
    in_word(C,NewC), !,
    get0(C1),
    restword(C1,Cs,C2).
restword(C,[],C).

single_character(44).  /* , */
single_character(59).  /* ; */
single_character(58).  /* : */
single_character(63).  /* ? */
single_character(33).  /* ! */
single_character(46).  /* . */

in_word(C,C) :- C>96, C<123.                /* a b..z */
in_word(C,L) :- C>64, C<91, L is C+32.      /* A,B..Z */
in_word(C,C) :- C>47, C<58.                 /* 1,2,..9 */
in_word(39,39).                             /*  ' */
in_word(45,45).                             /* - */

lastword( '.' ).
lastword( '!' ).
lastword( '?' ).

answer(A) :- ratom( X ), conv( X, A ), !.

conv(X,I) :- atoi( X, I ), 0 < I, I < 4, !.
conv(X,A) :- name( X, String ), valid_resp( String, A ), !.


valid_resp( [H|T], A ) :- type_ans( H, A ).

type_ans( X, A ) :- ([X] = "h"; [X] = "H"), A = help.
type_ans( X, A ) :- ([X] = "w"; [X] = "W"), A = why.

valid_resp( [], A ) :-
    print('\nPlease try to give me a H,W, or number for an answer.'),
    answer( A ), !.

valid_resp( [H|T], A ) :- valid_resp( T, A ).



/* Makes new atoms, one at a time. Do not expect a repeat solution.
You must ask each time you want an atom. It starts with some root,
and appends an incrementing number onto it.

Ask: ?-gensym( student, X ).      get: X = student1.
     ?-gensym( student, X ).      get: X = student2.
     ?-gensym( student, X ).      get: X = student3.

    and ad infinitum. */

gensym( Root, Atom ) :-
    get_num( Root, Num ),
    name( Root, Name1 ),
    integer_name( Num, Name2 ),
    append( Name1, Name2, Name ),
    name( Atom, Name ).

get_num( Root, Num ) :-
    retract( current_num( Root, Num1 )), !,
    Num is Num1 + 1,
    asserta( current_num( Root, Num)).

get_num( Root, 1 ) :- asserta( current_num( Root, 1 )).

integer_name( Int, List ) :- integer_name( Int, [], List ).
integer_name( I, Sofar, [C|Sofar] ) :-
    I < 10, !, C is I + 48.
integer_name( I, Sofar, List ) :-
    Tophalf is I/10,
    Bothalf is I mod 10,
    C is Bothalf + 48,
    integer_name( Tophalf, [C|Sofar], List ).


append( [], L, L ).
append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).

printstring( [] ).
printstring( [] ).
printstring( [H|T] ) :- put( H ), printstring( T ).

/*
.PN1
.PO0 */

signs :- nl,
  print( 'Does the patient exhibit any of the following signs:' ), nl,
  print( 'weakness, lightheadedness, syncope, cardiac awareness,
  pallor, tachycardia, jaundice.' ),
  affirm,
  syndrome( 1 ).

syndrome( 1 ) :- 'undist anemia'.

'undist anemia' :-
   anemia( RBC ),
   print( 'Patient has anemia. We now try to diagnose the specific type.' ),
  'anemia subtype'( RBC ).

'anemia subtype'( RBC ) :-  'congenital hemolytic anemia'( RBC ).
'anemia subtype'( RBC ) :-  'acquired hemolytic anemia'.

'acquired hemolytic anemia' :-
   ldh( high ),  nl,
   print('Based upon a diagnosis of anemia and ' ),
   print(' high LDH we obtain acquired hemolytic anemia.' ).

'congenital hemolytic anemia'( low )  :-
   'congenital hemolytic history',
   'congenital hemolytic determinant', nl,
   print('Based upon a diagnosis of anemia and '),
   print( 'the just named symptom we diagnose congenital hemolytic anemia.' ).

'deficiency anemia' :- nl,
  print( 'Diagnosis is a deficiency anemia.' ).


'congenital hemolytic history' :- jaundice.
'congenital hemolytic history' :- gallstones.
'congenital hemolytic history' :- sphenomegally.
'congenital hemolytic history' :- hepatomegally.
'congenital hemolytic history' :- 'bony malformations'.
'congenital hemolytic history' :- 'mental retardation'.

'congenital hemolytic determinant' :- microcytosis.
'congenital hemolytic determinant' :- eliptocytosis.
'congenital hemolytic determinant' :- spherocytosis.
'congenital hemolytic determinant' :- anisopoikilocytosis.
'congenital hemolytic determinant' :- 'anemia related to food'.

microcytosis :- labfindings( microcytosis ).
eliptocytosis :- labfindings( eliptocytosis ).
anisopoikilocytosis :- labfindings( anisopoikilocytosis ).
'anemia related to food' :- evidence( 'anemia related to food' ).
spherocytosis :- nl,
     print( 'Is the % of spherocytosis > 50%' ), affirm.

anemia( RBC ) :- symptom( anemic ), rbc( RBC ).

symptom( anemic ) :- hemoglobin( low ).
symptom( anemic ) :- hematocrit( low ).

evidence( X ) :- nl,
  print('Has the patient evidence of '),
  print( X ), affirm.

labfindings( X ) :- nl,
  print('Are there laboratory findings of ' ),
  print( X ), affirm.

jaundice :- evidence( jaundice ).
gallstones :- evidence( gallstones ).
sphenomegally :- evidence( sphenomegally ).
hepatomegally :- evidence( hepatomegally ).
'bony malformations' :- evidence( 'bony malformations' ).
'mental retardation' :- evidence(  'mental retardation' ).
'retarded growth and development' :-
     evidence( 'retarded growth and development' ).
'crisis of viscera, bones' :-
     evidence( 'crisis of viscera, bones' ).


/* Laboratory measurements: */

rbc( HLN ) :- rbcmeas( RBC ), rbccat( RBC, HLN ).
rbccat( RBC, low ) :- RBC < 4.
rbccat( RBC, high) :- RBC > 6.
rbccat( RBC, norm ) :- RBC = 5.
rbcmeas(RBC) :- nl,
     print( 'Input the RBC in millions/microliter:' ),
     read( RBC ).

hematocrit( HLN ) :- hematocrtmeas( HEMAT ), hematcat( HEMAT, HLN ).
hematcat( HEMAT, low ) :- HEMAT < 36.
hematocrtmeas( HEMAT ) :- nl,
     print( 'What is the hematocrit level % per deciliter?:' ),
     read( HEMAT ).

mcv( low  ) :- mcv1( low ).
mcv( high ) :- mcv1( high ), not( arct( high ) ).


mcv1( HLN ) :- mcvmeas( MCV ), mcvcat( MCV, HLN ).
mcvcat( MCV, high) :- MCV > 96.
mcvcat( MCV, low ) :- MCV < 85.
mcvmeas( MCV ) :- nl,
  print( 'What is the level of MCV in cubic microns:' ),
  read( MCV ).

ldh( LDH ) :- nl,
  print( 'What is the level of LDH (high,low, or norm)?: ' ),
  read( LDH ).

arct( HLN ) :- arctmeas( ARCT ), arctcat( ARCT, HLN ).
arctmeas( ARCT ) :- nl,
  print( 'What is the absolute reticulocyte count in units of thousands:'),
  nl,
  read( ARCT ).

affirm :- nl, print( '(y./n.) ?:- ' ),  read( ANS ), nl, yes( ANS ).

yes( y ).
/* This is a truely silly program, since it is based on my own
medical knowledge.
Ask: ?-itch.    or ?-lesion.    or ?-help. to get it started. */


help :- print( 'Diagnose the following topics:' ), nl,
print( 'Itch.' ), nl, print( 'lesion' ).


itch :- print( 'Is the atmosphere dry?: ' ), 'say yes',
  print( 'Do not take so many showers. Use vaseline.' ).

itch :- print( 'Does the patient have an allergic history?: '),
  'say yes', not(fever),  print( 'Consider atopic dermatitis.' ).

fever  :-
  print( 'Does the patient have a fever?' ), 'say yes'.

'non infective' :- acne, 'severe acne'.
'non infective' :- acne, 'cystic acne'.
'non infective' :- acne.
'non infective' :- 'severe acne rosacea'.
'non infective' :- 'rosacea'.

lesion :- not( fever ), 'non infective'.


acne :-
  print( 'Is the skin oily?' ), 'say yes',
  print( 'Are there lots of pimples?' ), 'say yes',
  print( 'Condition is probably acne.' ).

'cystic acne' :-
  print( 'Are there many yellowish cysts?' ), 'say yes',
  print( 'Condition is cystic acne.' ).

'severe acne' :-
  print(
    'Are there large elevated bluish abscesses with disfiguring scars?' ),
  'say yes'.

'rosacea' :- print( 'Is the patient  a woman?' ), 'say yes',
             'acne rosacea'.


'acne rosacea' :-  'severe'.
'acne rosacea' :-  'mild'.

'severe' :-
  print( 'Does the patient have an enlarged nose, with growths?' ), 'say yes',
  print( 'Diagnosis is severe acne rosacea.' ).

'mild' :-
  print( 'Is the skin oily, with a tendency towards seborrhea?' ), 'say yes',
  print( 'Are there pustules surrounded by a reddish area?' ), 'say yes',
  print( 'But are they larger than ordinary acne eruptions?' ), 'say yes',
  print( 'Diagnosis is acne rosacea.' ).


'say yes' :- read( Ans ), yes( Ans ), nl.


yes( yes ).
yes( y ).
yes( yea ).
yes( yup ).
/*
Text substitution game.
Ask: ?-alter( [you, are, a, computer], Z ).

*/

alter( [], [] ).
alter( [H|T], [X|Y] ) :- change( H, X ), alter( T, Y ).

change( you, i ).
change( are, [am, not ] ).
change( french, german ).
change( do, no ).
change( X, X ).

/* This is an unfinished expert system for rock blasting. It was orig-
inally written in another dialect and I have not had time to convert it.
 Go to work!. */



rock_blasting :-
  print( 'Pleas answer each of the following questions by entering
     \na number in the form "1" or "2" or "3". etc., whichever appropriate.
     \nFor further information enter "help." or "why".' ),
(decision(X) ; X = error), !,
print( 'Based on your answers to the questions,' ),
meseg( X ).


ask( NQ, NA ) :- question( NQ ),
      answer( NA ),!,
      (NA = help, help( NQ), retry( ask( NQ, NA) ) );
      (NA = why, why( NQ ),  retry( ask(NQ,NA)   ) ).


meseg(1) :- print( 'Presplitting is feasible and recommended' ).
meseg(2) :- print( 'Presplitting is feasible but not recommended.' ).
meseg(3) :- print( 'Smooth blasting is recommended.' ).
meseg(4) :- print( 'Conventional blasting is recommended' ).
meseg(5) :- print( 'Presplitting is feasible but some experimentation
    \nis necessary to obtain design parameters.' ).

meseg(error) :- print(
    '\nThere is an error in the answer to one of the questions.
    \nTo restart, type rock_blasting. Respond to each question with a
    \nnumber in the range mentioned.' ).

question(1) :- print(
    '\nIs it critical to have a smooth rock surface and/or maintain the
    \nintegrity of the boundary rock?
    \n 1) Yes     2) No.' ).
help(1) :- print( 'if you don\'t care, you can just blast away.').
why(1)  :- print( 'If yes, more elaborate information is required before a
    \ndecision can be made.' ).

question(2) :- print( 'Where is the blast?
    \n 1) On the surface    2) Underground' ).

help(2) :- print( 'Look up! Do you see sky?' ).

why(2) :- print( 'if on the surface, there are many options available.' ).

question(3) :-
    print( 'is the rock
      \n1) Hard( compressive strength > 100,000 MPa )?
      \n2) Soft( compressive strength < 100,000 MPa )?' ).

help(3) :- print( 'Measure the rock strength in MegaPascals.' ).
why(3) :- print( 'I don\'t know' ).


question(4) :- print( 'Is the bench height( or blasthole length ) < 50 feet?
    \n1) Yes   2) No.' ).

help(4) :- print( 'How deep did you make the hole?' ).
why(4) :- print( 'I don\'t know.' ).

question(5) :- print('Is the borehole drill capable of drilling a 2" to 4"
    \n blasthole?
    \n1) Yes      2) No.' ).

help(5) :- print( 'Go check the drill.' ).
why(5) :- print( 'I don\'t know' ).



question(6) :- print( 'Is the charge density of the explosive in the
    \nblasthole\n 1)High(>1.1 g/cc)?     2)Low(< 1.1g/cc)?' ).

help(6) :- print( 'go check while I hide behind a rock.' ).
why(6) :- print( 'I don\'t know.' ).

question(7) :- print( 'Is the rock mass
    \n1) Stratified with the proposed face parallel to the plane of
    \n the dominant fabric elements, or not
    \nstratified but heavily jointed?' ),
    print(
    '\n\n2) Stratified and/or heavily jointed with the proposed face not
    \nparallel to the plane of the dominant fabric element?

    \n\n3)Jointed or fractured such that the blasting will create loose,
    \nblocky conditions on theface?' ).

help(7) :- print( 'That is indeed a tough question!' ).
why(7) :- print( 'I don\'t know.' ).


question(8) :- print('Are the static field stresses
    \n1)Low( < 10 MPa ) with the principle stresses parallel,
    \nto the proposed face?
    \n\nLow( < 10MPa) but with the principle stresses parallel to
    \nthe proposed face?
    \n\n3)High( > 10 MPa )?' ).
help(8) :- print( 'That\'s a tough question' ).
why( 8) :- print( 'I don\'t know.' ).

decision(4) :- ask( 1,2 ).
decision(3) :- ask(1,1),ask(3,2).
decision(5) :- ask(1,1),ask(2,1),ask(3,2).
decision(4) :- ask(1,1),ask(2,1),ask(3,2).
decision(5) :- ask(1,1),ask(2,1),ask(3,1),ask(4,1),ask(5,2).
at1 :- ask(1,1),ask(2,1),ask(3,1),ask(4,1),ask(5,1).
decision(5) :- at1, ask(6,1).
decision(1) :- at1,ask(6,2),ask(7,1),ask(8,1).
decision(2) :- at1,ask(6,2),ask(7,1),ask(8,2).
decision(3) :- at1,ask(6,2),ask(7,1),ask(8,3).
decision(4)  :- at1,ask(6,2),ask(7,2).
decision(3) :- at1,ask(6,2),ask(7,3).


answer( A ) :- rnum( A ).
/*
answer(A) :- ratom( X ), conv( X, A ), !.

conv(X,I) :- atoi( X, I ), 0 < I, I < 4, !.
conv(X,A) :- name( X, String ), valid_resp( String, A ), !.


valid_resp( [H|T], A ) :- type_ans( H, A ).

type_ans( X, A ) :- ([X] = "h"; [X] = "H"), A = help.
type_ans( X, A ) :- ([X] = "w"; [X] = "W"), A = why.

valid_resp( [], A ) :-
    print('\nPlease try to give me a H,W, or number for an answer.'),
    answer( A ), !.

valid_resp( [H|T], A ) :- valid_resp( T, A ).
*/





/*
Note: Paula did not claim the prize of a free type VMI PROLOG
for a demonstration program. However, she is working on making
Pooh smarter, and I anticipate that she shortly will. (R.M).
*/


/* --------------- POOH : A PRO FOR THE AMATEUR --------------- */
/* -------------- Copyright 1985 Paula McKerall --------------- */

/* To wake pooh up, type: hello.<CR> when prompted "?-"         */
/* (Of course, type: consult(pooh).<CR> to get to his house!)   */

hello :- print( '\nHello! -- pooh is a program of very little brain,' ),
     print( '\nso please answer with: yes.<CR> if you mean "yes" -' ),
     print( '\nor with: no.<CR> if you mean "no" -' ),
     print( '\nor pooh will get confused!' ), nl,
     print( '\n(If you learn Prolog, you can make him smarter!)' ), nl,
     ask_want.
ask_want :- print( '\nDo you want advice about Prolog?' ), ((yes,
     ask_fun); (sorry; confused)).
ask_fun :- print( '\nDo you like to have fun?' ), ((learn; too_bad);
     confused).
learn :- yes, print( '\nThen please learn Prolog; you will like it.' ),
     print( '\nAnd then you can have a good time with pooh!' ), nl, naptime.
sorry :- no, print( '\nSorry, pooh can only give advice about Prolog.' ),
     print( '\nIf you learned Prolog, you could teach him other things!' ),
     nl, print( '\n(Besides, it is lonely in here; pooh needs a friend!)' ),
     nl, naptime.
too_bad :- no, print( '\nToo bad, because Prolog is fun.' ),
     print( '\nYou might change your mind if you try it!' ), nl,
     print( '\n(Besides, pooh is hungry, and if you learned Prolog,' ),
     print( '\nyou could teach him how to ask for honey!)' ), nl, naptime.
confused :- print( '\nPooh is most definitely confused.'  ), nl, naptime.
yes :- print( '\nPlease tell pooh: yes. or no. ?- ' ), read( yes );
     print( '\nThat is a strange answer. Do you mean yes?- '), read( yes ).
no :- print( '\nCuriouser and curiouser. Do you mean no?- ' ), read( yes );
     print( '\nPooh is getting confused. Do you mean yes?- '), read( no ).
naptime :- print( '\nPooh has to take a nap now.' ),
     print( '\nTo wake him up say: hello.<CR>' ),
     print( '\nOr to quit say: exitsys.<CR>' ).

/* This is really a silly little game; pooh behaves himself if you
   give him a chance, but I think it's fun to confuse him. Just don't
   make any errors in the "rules" or you'll get the Prolog error
   messenger, who is smarter than pooh but not as cuddly; unlike the
   error messenger, pooh can't say "No." *//*
Concatentate strings, using append. If the below is asked,

?-append( "ABC", "DEF", X ), append( "123", X, Y ), append( Y, "XYZ", Z ),
  printstring( Z ).

  you will get: Z = "123ABCDEFXYX", printed out as a list of ASCII codes. */

append( [], L, L ).
append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).
printstring( [] ).
printstring( [H|T] ) :- put( H ), printstring( T ).


lips(L) :- rev( [1,2,3,4,5,6,7,8,9,0,11,12,13,14,15,16,17,18,19,20,
              21,22,23,24,25,26,27,28,29,30], L ).

rev( [], [] ).
rev( [H|T], L ) :- rev( T,Z), append( Z, [H], L ).
/* Improved bicycle program. Ask: ?-partlist( bike ). */


basicpart( rim ).
basicpart( rearframe ).
basicpart( gears ).
basicpart( nut ).
basicpart( spoke ).
basicpart( handles ).
basicpart( bolt ).
basicpart( fork ).

assembly( bike, [quant( wheel, 2 ), quant( frame, 1 )] ).
assembly( wheel, [quant( spoke, 20 ), quant( rim, 1 ), quant( hub, 1)] ).
assembly( frame, [quant( rearframe, 1), quant( frontframe, 1 ) ] ).
assembly( frontframe, [quant( fork, 1 ), quant( handles, 1 )] ).
assembly( hub, [quant( gears, 1 ), quant( bolt, 7 ), quant( axle, 1 ) ] ).
assembly( axle, [quant( bolt, 1 ), quant( nut, 2) ] ).

partlist( T ) :- partsof( 1, T, P ), collect( P, Q ),
  printpartlist( Q ).

partsof( N, X, P ) :- assembly( X, S ), partsoflist( N, S, P ).
partsof( N,X,[quant(X,N)]) :- basicpart( X ).

partsoflist( _, [], [] ).
partsoflist( N, [quant( X, Num) | L ], T ) :-
  M is N * Num,
  partsof( M, X, Xparts ),
  partsoflist( N, L, Restparts ),
  append( Xparts, Restparts, T ).

collect( [], [] ).
collect( [quant(X, N )|R], [quant( X, Ntotal)|R2] ) :-
  collectrest( X, N, R, O, Ntotal ),
  collect( O, R2 ).

collectrest( _, N, [], [], N ).
collectrest( X, N, [quant( X, Num)|Rest ], Others, Ntotal ) :-
  !,
  M is N + Num,
  collectrest( X, M, Rest, Others, Ntotal ).
collectrest( X,N,[Other|Rest],[Other|Others],Ntotal ) :-
  collectrest( X, N, Rest, Others, Ntotal ).

printpartlist( [] ).
printpartlist( [quant( X, N )|R] ) :- nl,
  print( '    ' ), print( N ), print( '     ' ),
  print( X ), printpartlist( R ).

append( [], L, L ).
append( [X|L1], L2, [X|L3] ) :- append( L1, L2, L3 ).

/* Ask ?-aless( 2, 3 ). Get: Yes.
   Ask ?-aless( 3, 2 ). Get: No. */


aless( X, Y ) :- name( X, L ), name( Y, M ), alessx( L, M ).
alessx( [], [_|_] ).
alessx( [X|_], [Y|_] ) :- X < Y.
alessx( [P|Q], [R|S] ) :- P = R, alessx( Q, S )./* Describe the parts required to make a bicycle. Firt the elementary parts
are given (basicpart). Then a description of various subassemblies.
Ask: ?-partsof( hub, P ). to get all the basic parts required to make a hub.
Ask: ?-partsof( bike, P ). for the whole bike. */


basicpart( rim ).
basicpart( rearframe ).
basicpart( gears ).
basicpart( nut ).
basicpart( spoke ).
basicpart( handles ).
basicpart( bolt ).
basicpart( fork ).

assembly( bike, [quant( wheel, 2 ), quant( frame, 1 )] ).
assembly( wheel, [quant( spoke, 20 ), quant( rim, 1 ), quant( hub, 1)] ).
assembly( frame, [quant( rearframe, 1), quant( frontframe, 1 ) ] ).
assembly( frontframe, [quant( fork, 1 ), quant( handles, 1 )] ).
assembly( hub, [quant( gears, 1 ), quant( axle, 1 ) ] ).
assembly( axle, [quant( bolt, 1 ), quant( nut, 2) ] ).

partsof( X, [X] ) :- basicpart( X ).
partsof( X, P ) :- assembly( X, Subparts ),
                   partsoflist( Subparts, P ).

partsoflist( [], [] ).
partsoflist( [quant( X,N ) | Tail ], Total ) :-
             partsof( X, Headparts ),
             partsoflist( Tail, Tailparts ),
             append( Headparts, Tailparts, Total ).

append( [], L, L ).
append( [X|L1], L2, [X|L3] ) :- append( L1, L2, L3 ).
/* To analyze the family structure of the family of Queen Victoria.
English friend of mine notes there wasn't a Harry. I put him in.

Answers the compelling question: Who is X the sister of?

Ask: ?-sisterof( alice, X ). or ?-sisterof( alice, harry ).

  or ?-sisterof( alice, X ), loves( X, wine ). as an example of a
  complex question.

or even:

sisterof( alice, X ), loves( X, wine ), loves( alice, wine ).

*/

sisterof( X, Y ) :- parents( X, M, F ),
                    female( X ),
                    parents( Y, M, F ).

parents( edward, victoria, albert ).
parents( harry, victoria, albert ).
parents( alice, victoria, albert ).
female( alice ).

loves( harry, wine ).
loves( alice, wine ).
/* Recursive member of list definition.

Ask: Member( X, [a,b,c,d,e,f] ) to get successively all
the members of the given list. */


member( Y, [Y|_] ).

member( B, [_|C] ) :-  member( B, C ).



/*
For a similar program, see Clocksin & Mellish page 165.

Plan a trip from place to place.

An appropriate question would be:

?-go( darlington, workington, X ).
*/

  append( [], L, L ).
  append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).
  printstring( [] ).
  printstring( [H|T] ) :- put( H ), printstring( T ).


  rev( [], [] ).
  rev( [H|T], L ) :- rev( T,Z), append( Z, [H], L ).

/* Recursive member of list definition.

Ask: Member( X, [a,b,c,d,e,f] ) to get successively all
the members of the given list. */


member( Y, [Y|_] ).

member( B, [_|C] ) :-  member( B, C ).


pp([H|T],I)  :-  !, J is I+3, pp(H,J), ppx(T,J), nl.
pp(X,I)  :- tab(I), print(X), nl.
ppx([],_).
ppx([H|T],I)  :-  pp(H,I),ppx(T,I).

/* see page 163 of CM  */

findall(X,G,_) :-
      asserta(found(mark)),
      G,
      asserta(found(X)),
      fail.
findall(_,_,L)  :-  collect_found([],M),!, L  =  M.
collect_found(S,L)  :-  getnext(X), !, collect_found([X|S],L).
collect_found(L,L).
getnext(X)  :-  retract(found(X)), !, X \== mark.

a(newcastle,carlisle,58).
a(carlisle,penrith,23).
a(darlington,newcastle,40).
a(penrith,darlington,52).
a(workington, carlisle,33).
a(workington, penrith,39).

/*  does ; work properly ? */

legalnode(X,Trail,Y) :- a(Y,X,_), (not(member(Y,Trail))).
legalnode(X,Trail,Y) :- a(X,Y,_), (not(member(Y,Trail))).


go(Start,Dest,Route) :-  go1([[Start]],Dest,R), rev(R, Route).
go1([First|Rest],Dest,First) :- First = [Dest|_].
go1([[Last|Trail]|Others],Dest,Route)  :-
      findall([Z,Last|Trail],legalnode(Last,Trail,Z),List),
      append(List,Others,NewRoutes),
      go1(NewRoutes,Dest,Route).
/*                    SIEVE OF ERASTHATONES


Ask ?-primes( 100, L ).   to get all the primes from 1 to 100
printed out as the list "L".  */

primes( Limit, Ps ) :- integers( 2, Limit, Is ), sift( Is, Ps ).

integers( Low, High, [Low|Rest] ) :-
   Low =< High, !, M is Low+1, integers(M, High, Rest ).
integers( _,_,[] ).

sift( [], [] ).
sift( [I|Is], [I|Ps]) :- remove(I,Is,New), sift( New, Ps ).

remove(P,[],[]).
remove(P,[I|Is],[I|Nis]) :-
   not( 0 is I mod P ),
   !,
   remove(P, Is, Nis).

remove(P,[I|Is],Nis) :- 0 is I mod P, remove(P, Is, Nis).


con_num_list( [H|T] ) :- rnum( H ), con_num_list( T ).
con_num_list( [] ).


/* To multiply a row by a column: */

mat_mult( [H1|T1], [H2|T2], res ) :-
    mat_mult1( [H1|T1], [H2|T2, 0, res ).

mat_mult1( [H1|T1], [H2|T2], sum, res ) :-
    sum is sum + H1 * H2,
    mat_mult1( T1, T2, sum, res ).

mat_mult1( [], [], sum, res ) :- res = sum.


/* To get the nth element of a list:
   Let us assume a matrix in the form of a list of columns:

[ L1, L2.....]

listel( N, [H|T], X ) :-
    N > 0,
    N is N - 1,
    listel( N, T, X ).

listel( N, [H|_], X ) :- X = H.

/* Below, X, Y are the "coordinates".
   L is the complex list representing the array.
   element is the returned value. */

matrix_el( X, Y, L, element ) :-

/* First get the row, represented as an element "rowel" in list L */

    listel( X, L, rowel ),

/* And now the value contained within the row. */
    listel( Y, rowel, element ).
get_answer( A ) :-
    ratom( X ), name( X, String ),
        valid_resp( String, A ), !.

valid_resp( [H|T], A ) :- type_ans( H, A ).

type_ans( X, A ) :- ([X] = "y"; [X] = "Y"), A = yes.
type_ans( X, A ) :- ([X] = "n"; [X] = "N"), A = no.
type_ans( X, A ) :- ([X] = "w"; [X] = "W"), A = why.

?-print('\nYou can start animal by typing "help.<CR>"\n' ).

valid_resp( [], A ) :-
    print('\nPlease try to give me a yes or no answer.'),
    get_answer( A ), !.

valid_resp( [H|T], A ) :- valid_resp( T, A ).

/*
Note: Carl is an A.D.A. PROLOG user who has contributed this program for
the enjoyment of others.

          Residential Air Conditioning Diagnosis System
                         by Carl Bredlau
                        909 Rahway Avenue
                   Westfield, New Jersey 07090
*/


nothing(X)  :-
     print('Is there a/c (y/n)? '),
     ratom(n), !, X = running,
     asserta( (nothing(running) :- !) ).

nothing(X)   :-
      print('I can not diagnose this.  Will quit'), nl,
      asserta( (nothing(running) :- (!, fail)) ), fail.

check(thermostat_system_switch) :-
      nothing(running).


check(thermostat_fan_switch) :-
      check(thermostat_system_switch),
      switch(thermostat_system_switch,'in the cool position',yes).
      thermostat(calling).

check(for_air)   :-
     check(thermostat_fan_switch),
     switch(thermostat_fan_switch,on,yes),
     fan(furnace,on).

check(furnace_24_volts) :-
       check(thermostat_fan_switch),
       switch(thermostat_fan_switch,on,yes),
       fan(furnace,off).

check(furnace_110_volts) :-
    check(furnace_24_volts),
    voltage(furnace,24,no).

check(service_switch) :-
     check(furnace_110_volts),
     voltage(furnace,110,no).

check(circuit_breaker) :-
      check(service_switch),
      voltage('service switch',line,110,no).

check(coil_of_fan_relay) :-
      check(furnace_24_volts),
      voltage(furnace,24,yes).

check(fan,closed_coil_relays) :-
      check(coil_of_fan_relay),
      voltage( fan_relay_coil,24,yes).

check(Which,continuity_at_relay_coil) :-
      check(Which,closed_coil_relays),
      coil_contacts(Which,open).

check(Which,voltage_at_motor) :-
      check(Which,closed_coil_relays),
      coil_contacts(Which,closed).

check(Which,over_amp) :-
     check(Which,voltage_at_motor),
     motor_voltage(Which,line,yes),
     motor(Which,running,no),
     motor(Which,hot,yes),
     print( Which, 'motor has internal overload -- thermal relay kicked off'), nl,
     print( 'Cool and check for overamperage'), nl.

check(Which,motor_continuity) :-
     (check(Which,voltage_at_motor);
      (Which = compressor, check(continuity_at_compressor) )),
     motor_voltage(Which,line,yes),
     motor(Which,running,no),
     motor(Which,hot,no).

check(condensing_unit) :-
    check(for_air),
    air(yes),
    switch(system_cooling_switch,on,yes).

check(condenser_24_volts) :-
    check(condensing_unit),
    fan(condenser,off),
    voltage(condenser,220,yes).

check(condensing_unit_breaker) :-
     check(condensing_unit),
     fan(condenser,off),
     voltage(condenser,220,no),
     switch(disconnect,on,yes).

check(compressor_contactor_coil) :-
     check(condenser_24_volts),
     voltage(condenser,24,yes).

check(condenser,closed_coil_relays) :-
     check(compressor_contactor_coil),
     voltage(compressor_contactor_coil,24,yes),
     safeties(yes).

check(compressor_voltage) :-
     check(condensing_unit),
     fan(condenser,on),
     voltage(condenser,220,yes),
     voltage(condenser,24,yes),
     coil_contacts(compressor,closed),
     motor(compressor,running,no).

check(compressor_internals_overload) :-
     check(compressor_voltage),
     motor_voltage(compressor,line,yes).


check(continuity_at_compressor) :-
     check(compressor_internals_overload),
     coil_contacts(compressor_internals,closed).

check(gauges) :-
     check(condensing_unit),
     fan(condenser,on),
     voltage(condenser,220,yes),
     voltage(condenser,24,yes),
     coil_contacts(compressor,closed),
     motor(compressor,running,yes),
     gauge(X).




diagnosed(burned_out_transformer) :-
        check(furnace_110_volts),
        voltage(furnace,110,yes),
        print('Transformer burned out. Replace transformer'),nl.


diagnosed(repair_line_voltage_wire) :-
       check(service_switch),
       voltage('service switch',lOad,110,yes),
       print( 'Repair line voltage wire'), nl.


diagnosed(replace_service_switch) :-
        check(service_switch),
        voltage('service switch',lOad,110,no),
        voltage('service switch',line,110,yes),
        print( 'Replace service switch if switch is on'), nl,
        print( 'Otherwise, turn on switch'), nl.

diagnosed(replace_circuit_breaker) :-
        check(circuit_breaker),
        voltage('circuit breaker',lOad,110,no),
        voltage('circuit breaker',line,110,yes),
        breaker(circuit,on),
        print( 'Replace circuit breaker' ), nl.

diagnosed(repair_circuit_wire) :-
        check(circuit_breaker),
        voltage( 'service switch',line,110,no),
        voltage( 'circuit breaker',lOad,110,yes),
        print( 'Repair wire between circuit breaker and switch'),
        nl.

diagnosed(breaker_switch) :-
         check(circuit_breaker),
         breaker(circuit,off),
         print( 'Please turn on the breaker'), nl.

diagnosed(check_for_grounds) :-
        check(circuit_breaker),
        breaker(circuit,tripped),
        print('Check for grounded load'), nl,
        print('i.e., motor, relay, transformer, burnt ground wire'),nl.

diagnosed(replace_subbase) :-
       check(coil_of_fan_relay),
       voltage( fan_relay_coil,24,no),
       print('Jump R to G at thermostat'),nl,
       fan_turns(furnace,yes),
       print('Replace subbase of thermostat'), nl.


diagnosed(replace_therm_wire) :-
       check(coil_of_fan_relay),
       voltage( fan_relay_coil,24,no),
       fan_turns(furnace,no),
       print('Look for open wire between thermostat and subbase'), nl.

diagnosed([Which,replace_relay]) :-
      check(Which,continuity_at_relay_coil),
      continuity(Which,no),
      print( 'Replace ',Which, ' relay'), nl.

diagnosed([Which,replace_relay]) :-
      check(Which,continuity_at_relay_coil),
      continuity(Which,yes),
      print( 'Check for mechanical failure and replace ',Which, ' relay'), nl.

diagnosed([Which,repair_wire]) :-
     check(Which,voltage_at_motor),
     motor_voltage(Which,line,no),
     print( 'Repair wire between relay and ',Which,'?'), nl.

diagnosed([Which,replace_motor_or_adjust_pulley]) :-
     check(Which,over_amp),
     motor(Which,over_amperage,yes),
     print( 'With direct drive replace motor.'),nl,
     print( 'With pulley drive adjust pulley to proper amperage'),nl.

diagnosed([Which,replace_motor]) :-
     check(Which,motor_continuity),
     continuity(Which,no),
     print('Replace ',Which,' motor'),nl.

diagnosed([Which,look_at_capacitor]) :-
     check(Which,motor_continuity),
     continuity(Which,yes),
     motor(Which,hum,yes),
     print('Look at the ',Which,' motor capacitor'),nl.

diagnosed(dirty_stuff) :-
     check(for_air),
     air(no),
     maintenance(List),
     perform_maintenance(List).

diagnosed(replace_thermostat) :-
    check(condenser_24_volts),
    voltage(condenser,24,no),
    print('Jump out R to Y at thermostat'),
    fan_turns(condenser,yes),
    print('Replace thermostat'), nl.

diagnosed(repair_condenser_wire) :-
    check(condenser_24_volts),
    voltage(condenser,24,no),
    fan_turns(condenser,no),
    print('Repair wire between thermostat and condenser'),nl,
    print('Check 24 volt source'),nl.



diagnosed(replace_condensing_unit_breaker) :-
        check(condensing_unit_breaker),
        voltage('condensing unit breaker',lOad,110,no),
        voltage('condensing unit breaker',line,110,yes),
        breaker(condensing_unit,on),
        print( 'Replace condensing unit breaker' ), nl.

diagnosed(repair_condensing_unit_wire) :-
        check(condensing_unit_breaker),
        voltage( 'condensing unit breaker',lOad,110,yes),
        print( 'Repair wire between condensing unit breaker and switch'),
        nl.

diagnosed(condensing_unit_switch) :-
         check(condensing_unit_breaker),
         breaker(condensing_unit,off),
         print( 'Please turn on the condensing unit breaker'), nl.


diagnosed(check_for_condensing_unit_grounds) :-
        check(condensing_unit_breaker),
        breaker(condensing_unit,tripped),
        print('Check for grounded load'), nl,
        print('i.e., motor, relay, transformer, burnt ground wire'),nl.


diagnosed(safeties_open) :-
     check(compressor_contactor_coil),
     voltage(compressor_contactor_coil,24,no),
     safeties(no),
     print('Check safeties'),nl.

diagnosed(compressor_contactor) :-
     check(compressor_voltage),
     motor_voltage(compressor,line,no),
     print('Check for contactor problem or wire open'), nl.

diagnosed(refrigerant_charge) :-
     check(compressor_internals_overload),
     coil_contacts(compressor_internals,open),
     motor(compressor,hot,yes),
     print( 'Cool and check refrigerant charge'), nl.

diagnosed(replace_compressor) :-
     check(compressor_internals_overload),
     coil_contacts(compressor_internals,open),
     motor(compressor,hot,no),
     print( 'Replace compressor'), nl.

diagnosed(defective_condenser_fan) :-
     check(condensing_unit),
     fan(condenser,off),
     voltage(condenser,220,yes),
     voltage(condenser,24,yes),
     coil_contacts(compressor,closed),
     motor(compressor,running,yes),
     print('Defective condenser fan'),nl.

diagnosed(leak) :-
    check(gauges),
    pressure(high,High),
    pressure(low,Low),
    Low = 0, High = 0,
    print('Find leak, repair, and recharge'),nl.

diagnosed(replace_compressor) :-
    check(gauges),
    pressure(high,High),
    pressure(low,Low),
    60 =< Low, Low =< 90,
    60 =< High, High =< 90,
    Diff is High - Low,
    Diff =< 10,
    motor(compressor,drawing_amperage,yes),
    print('Pressures are almost equal.  Replace compressed'),nl.

diagnosed(low_pressure) :-
    check(gauges),
    pressure(low,Low),
    Low =< 40,
    print('(1) Check for lack of maintenance on inside'), nl,
    maintenance(X),
    print_maintenance_start(X),
    print('(2) short of coolant'), nl,
    print('(3) restriction in refrigerant line'), nl,
    print('(4) expansion valve problem'), nl.

diagnosed(high_pressure) :-
    check(gauges),
    pressure(high,High),
    High >= 300,
    print('(1) Lack of maintenance on outside : compressor plugged'),nl,
    print('(2) Overcharged unit'),nl.


diagnosed(compressor_valve) :-
    check(gauges),
    pressure(low,Low),
    pressure(high,High),
    65 =< Low, Low =< 70,
    220 =< High, High =< 280,
    maintenance(X),
    print_maintenance_start(X),
    motor(compressor,low_amperage,yes),
    print('Possible broken compressor valve. Replace'),nl.


diagnosed(replace_compressor) :-
    check(gauges),
    pressure(low,Low),
    pressure(high,High),
    65 =< Low, Low =< 70,
    220 =< High, High =< 280,
    maintenance(X),
    print_maintenance_start(X),
    motor(compressor,high_amperage,yes),
    print('Compressor worn out. Replace'), nl.




possibilities( [
     burned_out_transformer,
     replace_service_switch,
     repair_line_voltage_wire,
     replace_circuit_breaker,
     repair_circuit_wire,
     breaker_switch,
     check_for_grounds,
     replace_subbase,
     repair_therm_wire,
     [fan,replace_relay],
     [fan,repair_wire],
     [fan,replace_motor_or_adjust_pulley],
     [fan,replace_motor],
     [fan,look_at_capacitor],
     dirty_stuff,
     replace_thermostat,
     repair_condenser_wire,
     replace_condensing_unit_breaker,
     repair_condensing_unit_wire,
     condensing_unit_switch,
     check_for_condensing_unit_grounds,
     safeties_open,
     [condenser,replace_relay],
     [condenser,repair_wire],
     [condenser,replace_motor_or_adjust_pulley],
     [condenser,replace_motor],
     [condenser,look_at_capacitor],
     compressor_contactor,
     refrigerant_charge,
     replace_compressor,
     [compressor,replace_motor],
     [compressor,look_at_capacitor],
     defective_condenser_fan,
     leak,
     low_pressure,
     high_pressure,
     compressor_valve
  ]).

begin :-
    print('Expert a/c system'), nl,
    possibilities(X),
    begin1(X).

begin1([]) :-
    print('Seems I could not find the problem'), nl,
    print('Better luck next time'), !.

begin1([H|T]) :-
       diagnosed(H), ! ,
       print('We diagnosed ',H), nl,
       print('I hope that this is it'), nl.

begin1([H|T]) :-
       !, begin1(T).





switch(Switch,How,YesNo) :-
        print('Is the ',Switch,' ',How,' (y/n)? '),
        ratom(y),
        !,
        asserta( (switch(Switch,How,Y) :- (!, Y = yes)) ),
        YesNo = yes.

switch(Switch,How,YesNo) :-
        print('Please turn on the ',Switch, ' now'), nl,
        asserta( (switch(Switch,How,Y) :- (!, Y = yes)) ),
        YesNo = yes.

thermostat(X) :-
        print('Is the thermostat calling (y/n)? '),
        ratom(y),
        !,
        asserta( (thermostat(Y) :- (!, Y = calling)) ),
        X = calling.

thermostat(X) :-
        print('Please make call for cooling'),
        asserta( (thermostat(Y) :- (!, Y = calling)) ),
        X = calling.

fan(Which,OnOff) :-
        print('Do you hear the ',Which,' fan (y/n)? '),
        ratom(y),
        !,
        asserta( (fan(Which,Y) :- (!, Y = on)) ),
        OnOff = on.

fan(Which,OnOff) :-
        asserta( (fan(Which,Y) :- (!, Y = off)) ),
        OnOff= off.

voltage(X,Y,Volts,Z)   :-
       print( 'Is there ', Volts, ' volts on the ',
       Y, ' side of the ',
       X, ' (y/n)?  '),
       ratom(y),
       !,
       asserta( (voltage(X,Y,Volts,W) :- (!, W = yes)) ),
       Z = yes.

voltage(X,Y,Volts,Z)   :-
       asserta( (voltage(X,Y,Volts,W) :- (!, W = no)) ),
       Z = no.

voltage(X,Volts,Z)   :-
       print( 'Is there ', Volts, ' volts at the ',
       X, '? (y/n) '),
       ratom(y),
       !,
       asserta( (voltage(X,Volts,W) :- (!, W = yes)) ),
       Z = yes.

voltage(X,Volts,Z)   :-
       asserta( (voltage(X,Volts,W) :- (!, W = no)) ),
       Z = no.

motor_voltage(X,Volts,Z)   :-
       print( 'Is there ', Volts, ' volts at the ',
       X, ' motor? (y/n) '),
       ratom(y),
       !,
       asserta( (motor_voltage(X,Volts,W) :- (!, W = yes)) ),
       Z = yes.

motor_voltage(X,Volts,Z)   :-
       asserta( (motor_voltage(X,Volts,W) :- (!, W = no)) ),
       Z = no.




breaker(Which,X)  :-
        print('Is the ',X,' breaker tripped (y/n)? '),
        ratom(y),
        !,
        asserta( (breaker(Which,Y) :- (!, Y = tripped)) ),
        X = tripped.

breaker(Which,X)  :-
     print('Is the breaker on (y/n)'),
     ratom(y),
     !,
     asserta( (breaker(Which,Y) :- (!, Y = on)) ),
     X = on.


breaker(Which,X)  :-
     asserta( (breaker(Which,Y) :- (!, Y = off)) ),
     X = off.

fan_turns(Which,X) :-
        print('Does the ',Which, ' fan turn now (y/n)? '),
        ratom(y),
        !,
        asserta( (fan_turns(Which,Y) :- (!, Y = yes)) ),
        X = yes.

fan_turns(Which,X) :-
        asserta( (fan_turns(Which,Y) :- (!, Y = no)) ),
        X = no.


coil_contacts(Which,X)  :-
     print('Are the ',Which, ' contacts open (y/n)? '),
     ratom(y),
     !,
     asserta( (coil_contacts(Which,Y) :- (!, Y = open)) ),
     X = open.

coil_contacts(Which,X)  :-
     asserta( (coil_contacts(Which,Y) :- (!, Y = closed)) ),
     X = closed.


continuity(Device,YesNo) :-
        print('Is there continuity at the ',Device,' (y/n)? '),
        ratom(y),
        !,
        asserta( (continuity(Device,Y) :- (!, Y = yes)) ),
        YesNo = yes.

continuity(Device,YesNo) :-
        asserta( (continuity(Device,Y) :- (!, Y = no)) ),
        YesNo = no.

motor(Which,How,YesNo) :-
        print('Is the ',Which, ' motor ',How,' (y/n)? '),
        ratom(y),
        !,
        asserta( (motor(Which,How,Y) :- (!, Y = yes)) ),
        YesNo = yes.

motor(Which,How,YesNo) :-
        asserta( (motor(Which,How,Y) :- (!, Y = no)) ),
        YesNo = no.

air(X)  :-
        print('Do you hear any air (y/n)? '),
        ratom(y),
        !,
        asserta( (air(Y) :- (!, Y = yes)) ),
        X = yes.

air(X) :-
        asserta( (air(Y) :- (!, Y = no)) ),
        X = no.

perform_maintenance([]) :- !.
perform_maintenance([[Symptom,Action] | Tail]) :-
     do_maintenance(Symptom,Action),
     perform_maintenance(Tail).

do_maintenance(Symptom,Action) :-
     print('Is there a ',Symptom,'? (y/n)'),
     ratom(y), !,
     print(Action),nl.
do_maintenance(Symptom,Action).

maintenance( [
     [plugged_filter, replace],
     [broken_or_loose_belt, replace],
     [plugged_coil, clean],
     [dirty_blower_wheel, clean],
     [plugged_return_grill, clean],
     [closed_grill,open],
     [plugged_grill,clean] ]).



check_safeties([],Num) :- !, Num is 0.
check_safeties([[Safety,Action] | Tail], Num) :-
     ! ,
     check_safety(Safety,Action,Num1),
     check_safeties(Tail, Num2),
     Num is Num1 + Num2.

check_safety(Safety,Action, Num) :-
     print('Is the ',Safety,' safety open (y/n)?'),
     ratom(y), !,
     print(Action) ,nl,
     Num is 1.

check_safety(Symptom,Action,Num ) :- Num is 0.

safety_list( [
     [high_pressure,
       'Check for clogged condenser coils, condenser fan motor problem, overcharged unit'],
     [low_pressure,'Check for loss of refrigerant'],
     [compressor_internal,
       'Low refrigerant charge, expansion valve problems, filters, belts coils, compressor amperage']
           ]).

safeties(X)  :-
        safety_list(List),
        check_safeties(List,Num),
        Num = 0,
        !,
        asserta( (safeties(Y) :- (!, Y = yes)) ),
        X = yes.

safeties(X) :-
        asserta( (safeties(Y) :- (!, Y = no)) ),
        X = no.


gauge(X) :-
        print('Install gauges'), nl,
        asserta(( gauge(X) :- !)).


pressure(HighLowSide,Pounds) :-
        print('What is the pressure on the ',HighLowSide,' (end # with .)? '),
        read(Pounds),
        asserta((pressure(HighLowSide,Pounds) :- !)).



print_maintenance_start(X) :-
    print('Be sure that the maintenance has been done first'), nl,
    print_maintenance(X),
    asserta( (print_maintenance_start(Y) :- !) ).


print_maintenance([]) :- !.
print_maintenance([Head | Tail] ) :-
    print('     '),
    Head = [Symptom, Stuff], print(Symptom),nl,
    print_maintenance(Tail).







/*
Note: Carl is an A.D.A. PROLOG user who has contributed this program for
the enjoyment of others.

                 Towers of Hanoi by Carl Bredlau
                        909 Rahway Avenue
                   Westfield, New Jersey 07090
*/


%   stuff for prolog 86
%   print is changed to prin

put(X) :- ascii(C,X), putc(C).

makelist(1,[1]).
makelist(N, [N|Y]) :- N1 is N - 1, makelist(N1,Y).

biggie(1,X,[X]).
biggie(N,X,[X|Z]) :- N1 is N - 1, X1 is X + 1, biggie(N1,X1,Z).

alist(N,Y) :- biggie(N,1,Y).

%/* get the size of a list  */

size([],0) :-  !.
size([_|X],Num) :- size(X,N1), Num is N1 + 1.

%/* Might as well keep track of the disks on the poles.  This is
%   not really necessary; all we need to know is how many
%   disks are on a pole  */



readtop(N,Y)  :- retract(pole(N,[Y|X])), asserta(pole(N,X)).

writetop(N,Y) :- retract(pole(N,X)),  asserta(pole(N,[Y|X])).

makepoles(N) :- alist(N,Y), asserta( pole(1,Y)),
                asserta(pole(2,[])), asserta(pole(3,[])).

%/* stuff for pretty printing   */
%/* Note: the CONFIG.SYS file must contain the line ANSI.SYS.  Also,
%   the ANSI.SYS file must be on the disk when the system is booted     */

out(X) :- put(27), prin(X).
clear  :- out('[2J'). % /* clear screen */

goto(X,Y)  :- put(27),prin('[',X),put(59),prin(Y,'H').  % /* 59 is ; */


stuff(1,X) :- prin(X), !.
stuff(N,X) :- prin(X), N1 is N - 1, stuff(N1,X).



newhanoi(1,A,B,C) :- move(1,A,B).
newhanoi(N,A,B,C) :- !,  N1 is N - 1,
                       newhanoi(N1,A,C,B),
                       move(N,A,B),
                       newhanoi(N1,C,B,A).



%/*  As mentioned earlier size and readtop are not really needed,
%    but I threw them in so that you can see what's there.             */

move(N,A,B)  :- !,   pole(A,Adisk), size(Adisk,ANum),readtop(A,N),
                   X1 is 20 - ANum, Y1 is 5 + (A - 1)* 15,
                   goto(X1,Y1), stuff(N,' '),
                   writetop(B,N), pole(B,Bdisk), size(Bdisk,BNum),
                   X2 is 20 - BNum, Y2 is 5 + (B - 1)* 15,
                   goto(X2,Y2), stuff(N,'*'),
                   goto(24,1),
                   prin('Move disk ',N,' from ',A,' to ',B,'         ').


firstpole(N,1)  :- X1 is 20 - N, goto(X1,5),
                   stuff(1,'*'), !.

firstpole(N,L) :-  X1 is (20 - N) + (L - 1), goto(X1,5),
                   stuff(L,'*'),
                   L1 is L - 1, firstpole(N,L1).



start :- prin('How many disks? '), read(N), clear, firstpole(N,N),
            makepoles(N), newhanoi(N,1,2,3), !.




factor(0,Y) :- Y is 1, !.
factor(X,Y) :- Z is X - 1, factor(Z,W), Y is X*W.

%/* recursive version a n! and towers of hanoi  */
hanoi(1,A,B,C) :- prin('Move disk ',1,' from ',A,' to ',B),nl, !.
hanoi(N,A,B,C) :-   N1 is N - 1,
                    hanoi(N1,A,C,B), !,
                    prin('Move disk ',N,' from ',A,' to ',B), nl,
                    hanoi(N1,C,B,A), !.














s(X,Y) :- X1 is X + 1, (Y is X1 ; s(X1,Y) ).

s1(X,Y) :- X1 is X + 1, Y is X + 1.
s1(X,Y) :- X1 is X + 1, s1(X1, Y).
list1(X) :- clause(X,Y),output_clause(X,Y),
        write( '.' ), nl, fail.

list1(X).

output_clause(X,true) :- !, write(X).
output_clause(X,Y)    :- write( (X :- Y) ).

a( b ).
a( c ).
outputclause(X,true) :- !, write(X).
outputclause(X,Y)    :- write( (X :- Y) ).go  :-
    repeat,
    print( 'Enter a number: ' ),
    get0( Num ), nl,
        (
          ( (Num > 58), print( 'You did not enter a number'),
                nl, fail)
          ;
          (print( 'Do it over, please. ' ), nl, fail )
        ).
                       /* Sorting Lists */

/*
The order predicate determines how you would like the list to be ordered:
*/

order( A, B ) :- A > B.

/* The bubble sort. Invoke as ?-busort( [1,2,3], Sortlist ).
The answer is instantiated as the sorted list. */

busort( L, S ) :-
    append( X, [A, B|Y], L ),
    order( A, B ),
    append( X, [B,A|Y], M ),
    busort( M, S ).
busort( L, L ).

/* Used by most sorting algorithms. */
append( [], L, L ).
append( [H|T], L, [H|V] ) :- append( T, L, V ).


/* The quick sort. */


quisort( [H|T], S ) :-
    split( H, T, A, B ),
    quisort( A, A1 ),
    quisort( B, B1 ),
    append( A1, [H|B1], S ).

/* This important clause was left out by Clocksin and Mellish: */
quisort( [], [] ).

/* List splitting predicates used by both quick sort algorithms: */

split( H, [A|X], [A|Y], Z ) :- order( A, H ), split( H, X, Y, Z ).
split( H, [A|X], Y, [A|Z] ) :- order( H, A ), split( H, X, Y, Z ).
split( _, [], [], [] ).


/*
A compact form of the quick sort.
Invoke as: ?-quisort( List, Sortlist, [] ).
*/

quisortx( [H|T], S, X ) :-
    split( H, T, A, B ),
    quisortx( A, S, [H|Y] ),
    quisortx( B, Y, X ).
quisortx( [], X, X ).


/*
The insertion sort:
Invoke as ?-insort( List, Sortlist ).
*/
insort( [], [] ).
insort( [X|L], M ) :- insort( L, N ), insortx( X, N, M ).

insortx( X, [A|L], [A|M] ) :- order( A, X ), !, insortx( X, L, M ).
insortx( X, L, [X|L] ).


insort( [], [], _ ).
insort( [X|L], M, O ) :- insort( L, N, O ), insortx( X, N, M, O ).


/*
This form of the insertion sort needs no sort parameter.
O is instantiated to a predicate or operator which orders the elements.
Invoke as: insort( List, Sortlist, <order> ).
For instance, ?-insort( List, Sortlist, < ).
*/

insortb( [], [], _).
insortb( [X|L], M, O ) :- insortb( L, N, O ), insortxb( X, N, M, O ).


insortxb( X, [A|L], [A|M], O ) :-
    P =.. [ O, A, X ],
    P,
    !,
    insortxb( X, L, M, O ).
insortxb( X, L, [X|L], O ).
/*
This program performs symbolic differentiation.

Sample forms to differentiate:

  ?-d(x+1,x,X).
  ?-d(x*x-2,x,X).

See C & M for more on this.
*/


?-op( 9, fx, '%' ).

d(X,X,1) :- !.
d(C,X,0) :- atomic(C).
d(%U, X, %A) :- d( U, X, A ).
d( U+V, X, A+B) :- d(U,X,A), d(V,X,B).
d( U-V, X, A-B ) :- d(U,X,A), d(V,X,B).
d(C*U,X,C*A) :- atomic(C), C \= X, d(U,X,A), !.
d(U*V,X,B*U+A*V) :- d(U,X,A), d(V,X,B).
d(U/V,X,A) :- d(U*V**(%1),X,A).
d(U**V,X,V*W*U**(V-1)) :- atomic(V), c \= X, d(U,X,W).
d(log(U),X,A*U**(%1)) :- d(U,X,A).

/*   This is a sample network path finding algorithm.  To make use of this
see CM (second edition) pages 168-169.  You can make use of "look" */

  append( [], L, L ).
  append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).
  printstring( [] ).
  printstring( [H|T] ) :- put( H ), printstring( T ).


  rev( [], [] ).
  rev( [H1|TT], L1 ) :- rev( TT,ZZ), append( ZZ, [H1], L1 ).

/* Recursive member of list definition.

Ask: Member( X, [a,b,c,d,e,f] ) to get successively all
the members of the given list. */


mem( YY, [YY|_] ).
mem( B, [_|C] ) :-  mem(B, C ).

pp([H|T],I)  :-  !, J is I+3, pp(H,J), ppx(T,J), nl.
pp(X,I)  :- tab(I), print(X), nl.
ppx([],_).
ppx([H|T],I)  :-  pp(H,I),ppx(T,I).


a(newcastle,carlisle,58).
a(carlisle,penrith,23).
a(townB,townA,15).
a(penrith,darlington,52).
a(townB,townC,10).
a(workington, carlisle,33).
a(workington,townC,5).
a(workington, penrith,39).
a(darlington,townA,25).

legalnode(X,Trail,Y,Dist,NewDist) :-
    (a(X,Y,Z1) ; a(Y,X,Z1)),
    not(mem(Y,Trail)),
    NewDist is Dist + Z1.

go(Start,End,Travel) :-
      go3([r(0,[Start])],End,R55),
      rev(R55,Travel).

findall(X5,G,_) :-
      asserta(found(mark)),
      G,
      asserta(found(X5)),
      fail.
findall(_,_,L5)  :-  collect_found([],M5),!, L5  =  M5.

collect_found(S,L5)  :-  getnext(X5), !, collect_found([X5|S],L5).
collect_found(L5,L5).

getnext(X5)  :-  retract(found(X5)), !, X5 \== mark.

go3(Rts,Dest,Route) :-
shortest(Rts,Shortest,RestRts),
proceed(Shortest,Dest,RestRts,Route).


proceed(r(Dist,Route),Dest,_ ,Route) :- Route = [Dest|_].


proceed(r(Dist,[Last|Trail]),Dest,Rts,Route)  :-
findall(r(D1,[Z1,Last|Trail]),
legalnode(Last,Trail,Z1,Dist,D1),List),
append(List,Rts,NewRts),go3(NewRts,Dest,Route).


shortest([Route|Rts],Shortest,[Route|Rest])  :-
shortest(Rts,Shortest,Rest),shorter(Shortest,Route),!.
shortest([Route|Rest],Route,Rest).
shorter(r(M1,_),r(M2,_)) :- M1 < M2.

look :- print('enter the starting location: '),nl,
         ratom(Beg),nl,
    print('enter the destination: '),
    nl,ratom(Dest),
    go(Beg,Dest,RRT),
    pp( RRT, 1 ).

11-22-85


Dear Bob,

     I received your letter and the disk with EDPROLOG today and
must admit I was very gratified to find you were interested in my
Tree puzzle program - and thank you for the new ProLog!

     I have been happily busy with logic problems and syllogisms since
doing the Tree puzzle and I include two other of my efforts on this disk.
All three programs work just fine on my AT&T 6300 and all three have
simple start-up commands (like "go." or "hello.").  My machine does have
quite a lot of RAM (640k) but, as I understand things, this should not
pose problems for users with smaller systems since the language only
makes use of about 256k.  I hope this is the case.

     You will be interested to know that I have started planning a
"free university" style course for next semester at the community college
where I teach.  The course, Introduction to ProLog, will be using your
public domain version of the language and Clocksin & Mellish's book.
This first offering will probably be limited to other staff members,
but if all goes well I'll offer it next year to faculty & students.  My
real motive is to enable my own learning as much as to teach the language.

     Hope you enjoy the programs.  They really were a lot of fun to write.




Sincerely,




Tom Sullivan
5415 Grand Ave.
Western Springs, IL 60558
/* A Prolog solution to Family Trees by Virginia McCarthy.
            Tom Sullivan
            5415 Grand Ave.
            Western Springs, IL 60558  -  October 30,1985.
*/

northside (larch).
northside (catalpa)    :- northside ('Grandes').
northside ('Grandes')  :- have ('Grandes', larch).
have ('Grandes',larch) :- not_own ('Crewes',larch),
                          not_own ('Dews',larch),
                          not_own ('Lands',larch).

southside ('Crewes').
southside ('Dews').
southside (dogwood) :- northside (larch), northside (catalpa).
southside (ginko)   :- northside (larch), northside (catalpa).

here ('Grandes').
there (catalpa).

/* belongs_to provides a recursive definition of membership in a list
   see Clocksin & Mellish p. 53.  */

belongs_to (X,[X|_]).
belongs_to (X,[Y|Z]) :- belongs_to (X,Z).

same_first_letter (['Dews', dogwood]).
same_first_letter (['Grandes',ginko]).
same_first_letter (['Lands',larch]).
same_first_letter (['Crewes',catalpa]).

human (['Grandes','Crewes','Dews','Lands']).
plant ([catalpa,ginko,dogwood,larch]).

person (X) :- human (Y), belongs_to (X,Y).
tree (X)   :- plant (Y), belongs_to (X,Y).

not_own (X,Y) :- same_first_letter (Z),
                 belongs_to (X,Z), belongs_to (Y,Z).
not_own (X,Y) :- here (X), there (Y).
not_own (X,Y) :- (person (X), person (Y));
                 (tree (X), tree (Y)).
not_own (X,Y) :- (northside (X),southside (Y));
                 (southside (X),northside (Y)).
not_own ('Crewes', X) :- owns ('Dews', X).
not_own ('Lands', X)  :- owns ('Crewes', X).
not_own ('Lands', X)  :- owns ('Dews',X).


owns (X,Y) :- person (X), tree (Y), not (not_own (X,Y)).
hello :- owns(Person,Tree),print (Person,' owns the ',Tree).

/* query with "owns (Person,Tree), write (Person,Tree)."
   or just say "hello."  */


/* The puzzle - "Family Trees" by Virginia McCarthy as found in
   Dell Champion Variety Puzzles, November, 1985

   The Crewes, Dews, Grandes, and Lands of Bower Street each have
   a front-yard tree -- a catalpa, dogwood, gingko, and larch.  The
   Grandes' tree and the catalpa are on the same side of the street.
   The Crewes live across the street from the larch, which is across
   the street from the Dews' house.  If no tree starts with the same
   letter as its owner's name, who owns which tree?
*/
/* A deduction problem from Dell Official Puzzles December, 1985.
   ProLog program by Tom Sullivan  -  November, 1985

   Abby, Barb, & Cora have clothes in  blue, green, purple, red & yellow.
   None wears yellow with red.  Each has a two-piece outfit in two colors.
   Abby is wearing blue.  Barb is wearing yellow but not green.  Cora wears
   green but not blue or purple.  One has on red.  One color is worn by both
   Barb and Cora, while Abby & Barb, between them, have on four different
   colors.  Name the colors each woman is wearing.
*/

human ([abby,barb,cora]).
hue ([blue,green,purple,red,yellow]).

member (X,[X|_]).
member (X,[_|Y]) :- member (X,Y).

person (X) :- human (Y), member (X,Y).
color (X) :- hue (Y), member (X,Y).

hason (abby,blue).
hason (barb,yellow).
hason (cora,green).

notwear (barb,green).
notwear (cora,blue).
notwear (cora,purple).
notwear (X,Y) :- not (X = cora),hason (Z,Y).
notwear (abby,X) :- wears (barb,Z),member (X,Z).
notwear (cora,X) :- wears (abby,Z),member (X,Z).

wears (X,([Color1,Color2])) :- person (X), color (Color1), color (Color2),
                               hason (X,Color1),
                               not (notwear (X,Color2)),
                               not (Color1 = Color2),
                               not ((Color1 = red),(Color2 =yellow);
                                (Color1 = yellow), (Color2 = red)).

go :- wears (X,Y),print (X,' wears ',Y).

/* to query type >> go.<CR>  */




/* A ProLog program to handle syllogisms of the type
                       All X are Y
                       Z is X
          Therefore -  Z is Y

   Tom Sullivan - 5415 Grand Ave. Western Springs, IL 60558
                     November, 1985
   Type go.<CR> to run the program.  Enjoy.
*/

go :- nl,nl,nl,nl,nl,nl,nl,nl,nl,
      nl,nl,nl,nl,nl,nl,nl,nl,nl,
      print ('                     <<<<<   Theorem Prover   >>>>>'),
      nl,nl,
      print ('         Enter the name of a Greek,animal,plant,fish,insect,or bird.'),
      go1.

go1 :- nl,nl,nl,nl,nl,print ('Name  >> '),
       read (N),
       onlist (N),!.  /* see Clocksin & Mellish pp. 88-90  for use of cut */

listof (men,    ([socrates,plato,aristotle,homer])).
listof (animals,([dog,cat,horse,cow,pig,bear,lion])).
listof (plants, ([rose,petunia,daisy,oak,elm,corn])).
listof (fish,   ([waleye,pike,muski,bass,trout])).
listof (insects,([ant,beetle,spider,fly,mantis])).
listof (birds,  ([wren,robin,heron,eagle,hawk,crow])).

mortals ([men,animals,plants,fish,insects,birds]).

member (X,[X|_]).
member (X,[_|Y]) :- member (X,Y).      /* see C&M p.53  */

onlist (N) :- listof (Y,(Z)), member (N,Z),
              nl,nl,print ('Searching ... ',Y),
              nl,nl,print ('        1. ',N,' is in ',Y,'  ... and '),
              mortal (Y,N);stop.

mortal (Y,N) :- mortals (Z), member (Y,Z),
                nl,nl,print ('Searching .... mortals'),
                nl,nl,print ('        2. ',Y,' are mortal.'),
                nl,nl,print ('        Therefore ',N,' is mortal.'), go1.

stop :- nl,print ('   That\'s not in the data!'),
        nl,nl,print ('                           Type <go.> for more.').
/*
Except for the PD version, A.D.A. supports the grammar rule syntax.
If the syntax is supported, one could ask the question:
sentence( X, [every, man, loves, a, woman], [] ).
and see the result translated into a formula of the predicate calculus.
If you want to compile this under the PD version, add the declaration:
  op( 150, xfy, '-->' ). However, the program won't run under type PD
unless you write a grammar rule expander (definitely feasible).
*/


?-op( 100, xfx, '$' ).
?-op( 150, xfy, '->' ).

sentence( P ) --> noun_phrase(X,P1,P), verb_phrase(X,P1).

noun_phrase(X, P1, P ) -->
   determiner(X,P2,P1,P), noun( X, P3 ),
   rel_clause( X, P3, P2 ).
noun_phrase( X, P, P ) --> proper_noun( X ).

verb_phrase( X, P ) --> trans_verb(X,Y, P1), noun_phrase(Y, P1, P ).
verb_phrase( X, P ) --> intrans_verb(X, P ).

rel_clause(X,P1,(P1$P2)) --> [that], verb_phrase(X, P2).
rel_clause(_, P, P) --> [].

determiner(X, P1, P2, all(X, (P1->P2))) --> [every].
determiner(X, P1, P2, exists(X,(P1$P2))) --> [a].

noun(X, man(X) ) --> [man].
noun(X, woman(X)) --> [woman].

proper_noun(john) --> [john].

trans_verb(X, Y, loves(X,Y)) --> [loves].

intrans_verb(X, lives(X) ) --> [lives].
/*   PIE.TM : A PROLOG INFERENCE ENGINE AND TRUTH MAINTENANCE      */
/*            SYSTEM                                               */



/* This file contains most of the fundamental predicates necessary */
/* for doing truth maintenance. PIE uses the prolog interpreter as */
/* an input parser by declaring most of the PIE syntax as goals.   */
/* Prior to execution the operators must be declared.This is       */
/* simplified by using the redirect feature of ADA Prolog with the */
/* command line:       'prolog kops'                               */
/* The system is not yet complete and several extentions are       */
/* planned, many of which have already been implemented but        */
/* remain to be integrated with this particular piece of code.     */
/* Examples of planned extentions follow: one-directional rules,   */
/* a non-rule based inference based on mathematical set covering,  */
/* confidence factors, and more refined techniques for displaying  */
/* and editing a knowledge base. At the moment it is useful to know*/
/* or have a copy of the underlying representation. There is not   */
/* a lot of code here and it has not been thoroughly tested, but it*/
/* is quite powerful and flexible.                                 */


/* Sets 'X implies Y' up as a goal. NOTE: In order for the input to*/
/* be parsed properly antecedents and consequents must be given as */
/* lists, e.g. '[X is a male,X is a human] implies [X is a man]'.  */
/* Consequents may themselves be rule declarations. The rules      */
/* are bi-directional and may contain Prolog goals as elements     */
/* of the antecedent or consequent lists. To force forward         */
/* chaining 'fc' may be made a member of the antecedent or         */
/* consequent lists.                                               */

X implies Y :-
        assert_r(X implies Y).



/* Cycles through all the forward chaining rules to find out if  */
/* the most recent assertion will cause any to fire. The         */
/* efficiency of this function can be increased dramatically by  */
/* copying the original rule to a 'non-conflict' stack and       */
/* effacing those conditions that have already been met. This    */
/* will result in ever shorter antecednt lists for the rules.    */


fc:-
        clause(rule(N,D,Y implies Z,C),true),
        given_mem(Y),
        check_mult_con(N,Z),
        fail.
fc.

/* Checks to see if an antecedent that is part of a list exists  */
/* as a given in the kb.                                         */

given_mem([]).
given_mem([Y|Z]):-
        (Y;fact(N,D,Y,C)),
        given_mem(Z),!.

/* Reads through a list of consequents and passes them on to     */
/* the infer function only if they do not already exist in the   */
/* kb. This should be enhanced so that confidence factors can    */
/* be incremented.                                               */

check_mult_con(N,[]).
check_mult_con(N,[X|Y]):-
        infer(N,X),
        check_mult_con(N,Y),!.



/*The PIE assert adds facts to the knowledge base. While doing  */
/*so it checks to make sure that no conflicting facts exist. If */
/*conflicting facts do exist their identity is displayed.       */
/*Planned extentions include backward truth maintenance, wherein */
/*the inferences that led to both of the conflicting facts will */
/*be evaluated for confidence and 'distance' from input.        */
/* A typical assertion made by the user might look like:        */
/*                assert([bill is a man]).                      */
/* If the assert(X) is followed by an 'fc', forward chaining    */
/* will occur for the entire system.                            */

/* This is a special instance of the PIE assert. It allows new  */
/* relations to be declared in the form of operators. Asserting */
/* 'loves is a relation' will allow subsequent use of 'loves' as*/
/* an infix operator in antecedents or consequents of rules,    */
/* e.g. [X loves Y] implies [Y loves X].                        */

assert([]).
assert([X is a Rel|Y]) :-
        nonvar(R),
        R=relation,
        gensym(rel,N),
        asserta(relation(N,_)),
        op(10,xfx,X),
        assert(Y).
assert([X|Y]):-
        fact(Number,Dependence,X,Confidence),
        assert(Y).
assert([X|Y]):-
        fact(Number,Dependence,not(X),Confidence),!,
        print('Sorry, in conflict with existing information.'),nl,
        print('Dependency for ',Number),nl,
        prt_dependency(Number),
        assert(Y).
assert([not(X)|Y]):-
        fact(Number,Dependence,X,Confidence),!,
        print('Sorry, in conflict with existing information.'),nl,
        print('Dependency for ',Number),nl,
        prt_dependency(Number),
        assert(Y).

assert([not(X)|Y]):-
        check_word(X,_),
        functor(X,F,N),
        (atom(X);N>0),
        gensym(f,Number),
        assertz(fact(Number,input,not(X),Conf)),
        print('Inserted: ',Number,' not',X),nl,!,
        assert(Y).
assert([X|Y]):-
        check_word(X,_),
        functor(X,F,N),!,
        N>0,
        gensym(f,Number),
        assertz(fact(Number,input,X,C)),
        print('Inserted: ',Number,' ',X),nl,!,
        assert(Y).


/* Specifically designed for adding rules to the knowledge base */

assert_r(not(X)):-
        check_word(X,Y),
        functor(X,F,N),
        F=implies,
        gensym(r,Number),
        assertz(rule(Number,input,not(X),Conf)),!,
        print('Inserted: ',Number,' not',X),nl.
assert_r(X):-
        check_word(X,Y),
        functor(X,implies,N),
        gensym(r,Number),
        assertz(rule(Number,input,X,Conf)),!,
        print('Inserted: ',Number,' ',X),nl.

/* The 'infer' clause allows assertions to be made as a result of */
/* inference. It is similar to 'assert', but allows the passing   */
/* of a dependency bound to 'N'.                                  */

infer(N,not(X)):-
        fact(Num,Dependence,X,Confidence),!,
        print('Sorry, in conflict with existing information.'),nl,
        print('Dependency of existing info ',Num,' ',X),nl,
        prt_dependency(Num),
        print('Dependence of new conflicting info not',X),nl,
        prt_dependency(N).
infer(N,X):-
        fact(Num,Dependence,not(X),Confidence),!,
        print('Sorry, in conflict with existing information.'),nl,
        print('Dependency of existing info ',Num,'not',X),nl,
        prt_dependency(Num),
        print('Dependence of new conflicting info ',X),nl,
        prt_dependency(N).
infer(N,X):-
        (X;fact(_,_,X,_);rule(_,_,X,_)).
infer(N,X):-
        X='implies'(_,_),
        gensym(r,Number),
        assertz(rule(Number,N,X,Conf)),
        print('Inserted: ',Number,' ',X),nl,!.
infer(N,X):-
        (atom(X);true),
        gensym(f,Number),
        assertz(fact(Number,N,X,Conf)),
        print('Inserted: ',Number,' ',X),nl,!.

/* Builds a vocabulary for the system and ensures that typographical errors */
/* are not introduced. A typographical error might result in what would     */
/* to be two different values for an attribute or two different attributes  */
/* for an object.                                                           */

check_word(X,_):-
        var(X).
check_word(X,_):-
        word(X).
check_word(X,Y):-
        X= '`s'(A,B),
        check_word(A,A1),
        check_word(B,B1).
check_word(X,Y):-
        X= 'is a'(A,B),
        check_word(A,A1),
        check_word(B,B1),
        setval(B1,A1).
check_word(X,Y):-
        X=F(A,B),
        check_word(A,A1),
        check_word(B,B1),
        setval(A1,B1).
check_word([X|Tail],_):-    /* Allows the use of ';'and lists within a list */
        check_word(X,_),
        (Tail =[];check_word(Tail,_)).
check_word(X,Y):-
        print('Is ',X,' a correct value? y/n: '),
        ((ratom(y),X=Y);(replace_value(Y))).
replace_value(Y):-
        print('Please, type in correct value: '),
        ratom(Y).
setval(A,B):-
        nonvar(A),
        nonvar(B),
        asserta(legval(A,B)).
setval(A,B):-
        nonvar(A),
        asserta(word(A)),
        fail.
setval(A,B):-
        nonvar(B),
        asserta(word(B)),
        fail.
setval(_,_).

/* A simple recursive function that will print out the rule    */
/* numbers on which a fact or rule depends. Extensions to this */
/* will allow for viewing in various modes and editing.        */

prt_dependency(input).
prt_dependency(N):-
        (fact(N,input,_,_);rule(N,input,_,_)),
        print('input').
prt_dependency(N):-
        (fact(N,D,_,_);rule(N,D,_,_)),
        (fact(D,D1,X,Conf);rule(D,D1,X,Conf)),
        write(D),tab(2),write(X),tab(2),write(Conf),nl,
        prt_dependency(D1).

rule(X):-
    rule(X,Dep,Body,Conf),
    print(X,'  ',Dep,'  ',Body,'  ',Conf),nl.
rules:-
    clause(rule(A,B,C,D),true),
    print(A,' ',B,' ',C,' ',D),nl,
    fail.
rules.

fact(X):-
    fact(X,Dep,Body,Conf),
    print(X,'  ',Dep,'  ',Body,'  ',Conf),nl.
facts:-
    clause(fact(Num,Dep,Body,Conf),true),
    print(Num,'  ',Dep,'  ',Body,'  ',Conf),nl,
    fail.
facts.



/* Allows removal of rules or facts by reference to their gensym  */
/* index. This could easily be enhanced by allowing instantiation */
/* through explicitly typing out the item to be removed.          */
/* Automatically removes assertions that depend on the retracted  */
/* item.                                                          */

remove(N):-
        retract(rule(N,D,X implies Y,C)),
        print('Removed: ',N,' ',X,'implies',Y),nl,
        remove_con(N,Y).
remove(N):-
        retract(fact(N,D,X,C)),
        clause(rule(N1,_,Y implies Z,_),true),
        print('Removed: ',N,' ',X),nl,
        mem(X,Y),
        remove_con(N1,Z),
        fail.

/* 'Remove' will automatically forward chain in order re-infer  */
/* things that may be obtained through a different route than   */
/* that affected by the retraction process. This is necessary   */
/* because not all facts are taken advantage of in inferencing. */
/* That is to say, if a fact already exists 'infer' and 'assert'*/
/* will not add them redundantly to the kb. This will change    */
/* with the addition of confidence factors.                     */

remove(N):-
        fc.


/* Exhaustively checks facts in the kb and removes them if they */
/* depend on another item removed. NOTE: 'N=D' is part of a     */
/* disjunction, if it fails the fact will be reinserted in the  */
/* kb. At the moment this does not take advantage of the ADA    */
/* Prolog indexing capability, but it should in a dedicated     */
/* ADA application.                                             */

remove_con(N,[]).
remove_con(N,[X|Y]):-
        retract(fact(N1,N,X,C)),
        print('Removed: ',N1,' ',X),nl,
        remove_con(Y).
remove_con([X|Y]):-
        remove_con(Y).




/* Activates backward chaining. A complex function, the first */
/* two clauses REQUIRE a list to function properly, but valid- */
/* ation is not done. This is required by the inference       */
/* mechanism. Its effect is to ensure that inheritance is not */
/* carried over to uninstantiated objects.                    */

obtain([]).
obtain(X):-
        X =[Y|Z],!,
        obtain_1(Y),
        obtain(Z).
obtain_1(X):-
        X.
obtain_1(X):-
        clause(fact(N,D,X,C),true).

obtain_1(X):-
        clause(rule(N,D,Y implies Z,C),true),
        nl,
        not(chk(N)),     /* Prevents double pattern match. */
        mem(X,Z),
        asserta(chk(N)),
        obtain(Y).      /* Recursive check for ant as a con.*/
obtain_1(F(A,B)):-
        X=F(A,F1(C,D)),
        nonvar(F1),!,
        print(A,' ',F,' ',C,' ',F1,' ',D),nl,
        obtain_1a(F(A,F1(C,D))),
        assert([F(A,F1(C,D))]),
        refresh.          /* Removes 'chk' tag. */
obtain_1(F(A,B)):-
        print(A,' ',F,' ',B),nl,
        obtain_1b(F(A,B)),
        assert([F(A,B)]),
        refresh.
obtain_1a(F(A,F1(B,C))):-
        print('Please,fill in the blanks:'),nl,
        get_val(A,_),
        print(A,' ',F,' '),
        get_val(B,A),
        print(B,' ',F1,' '),
        get_val(C,B).
obtain_1b(F(A,B)):-
        print('Please,fill in the blanks:'),nl,
        get_val(A,_),
        print(A,' ',F,' '),
        get_val(B,A).
get_val(X,_):-
        nonvar(X).
get_val(X,Y):-
        listvals(Y),
        r_val(X,Y).
r_val(X,Y):-
        ratom(Z),
      /*  legval(Y,Z), */
        Z=X.


/* Refreshes rules */
refresh:-
    retract(chk(_)),
    fail.
refresh.


listvals(_).  /* Temporarily axiomatic */
listvals(X):-
        clause(legval(X,Y),true),
        print(Y),nl,
        fail.
listvals(_).


/* Standard Prolog append.                                      */

append([],X,X).
append([A|B],C,[A|D]):-
        append(B,C,D).


/* Standard Prolog member.                                      */

mem(X,[X|_]).
mem(X,[Y|Z]):-
        mem(X,Z).

/* Standard Prolog gensym.                                       */

gensym( Root, Atom ) :-
        get_num( Root, Num ),
        name( Root, Name1 ),
        integer_name( Num, Name2 ),
        append( Name1, Name2, Name ),
        name( Atom, Name ).

get_num( Root, Num ) :-
        retract( current_num( Root, Num1 )), !,
        Num is Num1 + 1,
        asserta( current_num( Root, Num)).

get_num( Root, 1 ) :- asserta( current_num( Root, 1 )).

integer_name( Int, List ) :- integer_name( Int, [], List ).
integer_name( I, Sofar, [C|Sofar] ) :-
        I < 10, !, C is I + 48.
integer_name( I, Sofar, List ) :-
        Tophalf is I/10,
        Bothalf is I mod 10,
        C is Bothalf + 48,
        integer_name( Tophalf, [C|Sofar], List ).


append( [], L, L ).
append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).


prolog kops

batch.
op(240,xfx,'implies').
op(240,xfx,'only if').
op(220,xfx,'is a').
op(220,yfy,'`s').
op(219,xfx,'eq').
nl,
print('\n                                   PIE.TM\n',
'           A Forward and Backward Chaining Prolog Inference Engine\n',
'                          With Truth Maintenance\n',
'                Public Domain Version 1.1   19 November 1985\n',
'                            By Simon Blackwell\n',
'          Dept. of Philosophy, Bowling Green State University, Ohio').
consult('know.pro').
see(user).
..head01rCS680
..foot59ci

                  A Prolog Augmented Transition Network Parser

                               Table of Contents


1.  General                                                         1

2.  ATN Form                                                        1

        Figure 1.  ATN Network                                      1
        Figure 2.  Phrase Network                                   2

3.  Approach                                                        2
                                                                       
        Phase I                                                     2
        Phase II                                                    2
        Phase III                                                   2

4.  Phase I                                                         2

5.  Phase II                                                        3

6.  Phase III                                                       5
                                                                    
        ATNBLD                                                      6
        ATNNEW                                                      8

7.  Conclusions                                                     9

Attachements:                                                       

1.  ATN.PRO                                                         

        Program Listing                                             1-1
        Phase I - Example I                                         1-5
        Phase I - Example II                                        1-6

2.  ATNREV.PRO                                                      

        Program Listing                                             2-1
        Phase II - Example I                                        2-4
        Phase II - Example II                                       2-4

3.  ATNBLD.PRO                                                      

        Program Listing                                             3-1
        Example ATN Definition                                      3-3

4.  ATNNEW1.PRO                                                     

        Program Listing                                             4-1
        Phase III - Example I                                       4-4
        Phase III - Example II (Subject Predicate Agreement)        4-5
..head01rCS680
..foot59c##
                  A PROLOG AUGMENTED TRANSITION NETWORK PARSER

                                  submitted by

                              Ludwig J. Schumacher

                               November 26, 1985


1.  General.  This report documents the development of an Augmented Transition
Network (ATN) sentence parser in the PROLOG language and is submitted in partial
fulfillment of the requirements for CS 680, Natural Language Processing, George
Mason University, Fall 1985.  It is assumed that the reader is familiar with
natural language processing and PROLOG so associated terms will be used without
explanation.  The author had no prior experience with logic programming and does
not presume to evaluate the PROLOG language, only that small subset of commands
he was able to master in attempting to apply the language to this specific
project.  The examples contained herein are executed under A.D.A. PROLOG,
ver 1.6c, (c) Automata Design Associates 1985.


2.  ATN Form.  The form of the ATN which is used in this paper is shown in
Figure 1.  This form has been chosen not as comprehensive coverage of English
sentence structure but to provide a simple form which does incorporate the major
features of ATNs.  Figure 2 is the noun and prepositional phrase network.

              -  Transition from node to node based upon specified conditions.

              -  Optional conditions, such as the determiner and adjective in
                 the noun phrase.
                 
              -  Augmentation with sub-networks such as the noun and
                 prepositional phrases.

              -  Recursiveness such as the adjective in the noun phrase and the
                 noun phrase at node 2.




                                        np              pp
                                      *   *           *   *
                            verb     \/  *      pp   \/ * 
      np  **** >  q1 ************** > q2/ ********** > q3/
      *              *                /\
q0 *                    *    aux      * verb
      *                     *         *
      aux **** >  q4 ************* >  q5
                          np




                             Figure 1.  ATN Network
                   adj
       det      *   *
      ******    \/  *     noun                         prep
qnp *       * >  qnp1 ********** > qnp2/        qpp ****** > qnp
      ******
       jump

                           Figure 2.  Phrase Network


3.  Approach.  The project was conducted in three phases.

    a.  Phase I.  Phase I was experimentation with PROLOG to develop some
working application. An ATN parser was programmed but only by forcing PROLOG
into a procedural mold.  This phase culminated in a briefing presented in class
on 24 October.

    b.  Phase II.  Phase II was the translation of the procedures developed in
Phase I into facts and rules appropriate for a logic program, which would more
fully exploit the capabilities of PROLOG.

    c.  Phase III.  Phase III was additional experimentation to make the programs
more dynamic and to exploit the power of an ATN to pass differing information
depending upon the particular transition.  These experiments included procedures
to automatically update the vocabulary, allow for user defined networks,
refinement of the database search procedures, and incorporation of subject and
predicate agreement verification.


4.  Phase I

    a.  The program developed during Phase I (Attachment 1) is not a logic
program, but a set of procedures executed with the PROLOG language.  Procedures
are defined as a set of 'q' rules which are passed the current node number and
the unparsed and parsed parts of the sentence.  Each set of procedures defined
the actions to be taken at that node. For example, q(0,_) are the procedures for
node 0, q(1,_,_) are the procedures for node 1, etc.

    b.  There are a number of limitations to this approach.

              -  The addition of a node requires a new set of procedures and
modification of the code for each node from which a transition can be made.

              -  It would be difficult to modify the code dynamically, since
procedures must be executed in sequence, and changes would have to be inserted at
specific points.

              -  Elimination of a node requires not only the elimination of the
procedure for that node, but the removal of all calls to that node from other
procedures.

..page
5.  Phase II.  Phase II was the development of a logic program to accomplish the
same functions as that developed during Phase I.  The approach was to translate
the statement, "There is a transition from node X to node Y on condition Z", to
the PROLOG equivalent "arc(X,Y,Z)".  The complete program is at Attachment 2 and
appropriate sections are reproduced below.

    a.  The first step was to redefine the facts.  The transitions are in the
form of arc(from node,to node,condition).

            arc(q0,q1,np).
            arc(q1,q2,verb).
            arc(q2,q2,np).
            arc(q2,q3,pp).
            arc(q0,q4,aux).
            arc(q4,q5,np).
            arc(q1,q5,aux).
            arc(q5,q2,verb).


    b. The terminal nodes are identified by term(at node,empty list), where the
remainder of the sentence is the second variable.

            term(q2,[]).
            term(q3,[]).

    c.  Since phrase transitions are based upon a series of words rather than a
single condition, they are treated as separate networks.  The empty list as the
transition condition is used to effect a jump.

            arc(qnp,qnp1,det).
            arc(qnp,qnp1,[]).
            arc(qnp1,qnp1,adj).
            arc(qnp1,qnp2,noun).
            arc(qpp,qnp,prep).


    d.  With these 'facts' established, one can now use the recursive and
backtracking nature of PROLOG to find a path from the initial point to a
terminal node.

              1)  A sentence is input as a PROLOG list enclosed in brackets and
with each word separated by a comma.  There is no punctuation at the end of the
sentence.  All words must be in lower case.

              2)  Once the sentence, S, has been input, control is passed to the
rule trans (transition).  The variables are: current node, next node, parsed
sentence, sentence remaining to be parsed, and sentence remaining to be parsed
after transition.

         trans(q0,Nq,Parse,S,S1)

..page
              3)  If the current node (Lq) is a terminal node and the remainder
of the sentence (S1) is null, then the sentence has been parsed.

trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl,
                          print('Completed ',Lq),
                          nl,print(Parse).


              4)  If the next word (S0) is the type (Type) to effect a
transition, then trans is called recursively.  (Note: Nbr is a variable designed
to provide information on the singularity or plurality of the word.  It is not
used in this example.)

trans(Lq,Nq,Parse,[S0|S1],S1) :- word(S0,Type,Nbr),
                                 arc(Lq,Nq,Type),
                                 nl,
                            print('Transition ',Lq,' ',Nq,' ',S0, ' ',Type),
                                 append(Parse,[[Type],S0],P1),
                                 !,
                                 trans(Nq,Z,P1,S1,S2).


              5)  If the next word in the sentence does not establish the
criteria for a transition, check to determine if a phrase does. If so, the rest
of the sentence is checked for the proper phrase, either np or pp. This requires
the separate network check, ptrans, which allows parsing as the network is
transitioned, but will return unchanged if it fails.



trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,np),
                             ptrans(qnp,Nq,Lq,S0,[np],Parse).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,pp),
                             ptrans(qpp,Nq,Lq,S0,[pp],Parse).


              6)  If no word or phrase has been found to effect a
transition, the sentence will not parse.


trans(Lq,Nq,Parse,S0,S1) :- !,nl,
                            print('The sentence failed at ',Lq),
                            nl,print('Parsed ',Parse),
                            nl,print('Left ',S0).


              7)  The phrase transition network code is almost identical to the
primary code, except that it continues to call itself until such time as it
reaches qnp2, which is the terminal node, or fails at a node other than qnp2.
In the first case it will effect a transition to the next node (Nq) and call
trans with the new data.  In the second case, ptrans will fail and conditions
remain unchanged.
ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :- word(S0,Type,Nbr),
                                     arc(Bq,Zq,Type),
                                     append(Pr,[[Type],S0],P1),
                                     !,
                                     ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :- nl,
                                  print('Transition ',Lq,' ',Nq),
                                  nl,
                                  print(Pr),
                                  append(Parse,Pr,P1),
                                  !,
                                  trans(Nq,Rq,P1,S0,S1).


6.  Phase III

    a.  These programs demonstrate that PROLOG can be used to develop an ATN
parser but still do not exploit the power of PROLOG to operate in a dynamic
environment.  Specific capabilities which should be included are:

              1)  The ATN should be able to provide additional information
beyond whether or not the sentence parsed.

              2)  The program should assist the user in construction of the ATN
definition.

              3)  The program should verify the words are in the vocabulary set
before attempting to parse, and if not, allow them to be added.

              4)  The database search should be efficient. Especially in the
case of a large vocabulary set, the initial form of word(Name,[type]) is
unacceptable in that PROLOG must conduct a linear search of the entire set of
words to identify success or failure.

                        (a)  Dr. Berghel, University of Nebraska, suggested in
his presentation at George Mason that the vocabulary be stored as individual
letters and the search space would be reduced to words of a particular length.
For example, the word 'the' would be in the database as "word(t,h,e)".  In order
to identify if "the" is in the vocabulary set, it is partitioned into the
individual letters and only those words with arity 3 would need to be searched.

                        (b)  An alternative to the use of arity would be to
construct each word as a separate fact.  Thus "the" would be represented as
"the(word)".  It is assumed that PROLOG is more efficient searching a database
of unique facts rather than one of fewer facts differentiated by arity.  There
may, however, be some impact on memory requirements.  It must also be noted that
this would not serve the spelling correction procedure outlined by Dr. Berghel.

                        (c)  A concept which could be integrated with either of
the two approaches outlined above would be to allow the facts which are used
more often to migrate to the front of the list. Specifically, exploit PROLOG's
capability to alter the program by deleting facts when used and adding them to
the front of the list.
    b.  The two programs at Attachments 3 and 4 incorporate some of these
concepts.  Attachment 3 is a listing and example use of the program 'ATNBLD'
which can be used to build the primary transition network.  Attachment 4,
'ATNNEW', uses the network developed by ATNBLD, stores each word as a separate,
unique fact, and identifies sentences in which the subject and predicate are not
in number agreement.

              1) ATNBLD  ATNBLD requests the names of the nodes and the
conditions for transition and establishes a separate database for the network
defined by the user.  The initial node must be entered and all terminal nodes
identified.  Then the user defines paths to each terminal node.

                        (a)  BUILD.  Build is the entry point into the program.
It requests the start node (Q0), the terminal nodes, termnode, then transfers to
flow.  The predicate 'ret', defined in a standard routine, is used to retract
predicates.  It is used here to retract any predicates which would interfere
with the construction of the network.  The predicates generated within the
program are:
 
                        - term: defines that a node is a
                                terminal node

                        - qend: identifies nodes that have a
                                path to a terminal node

                        - arc:  identifies the transitions from
                                node to node


build :- batch,ret(qend),nl,ret(arc),nl,ret(term),asserta(term([],[])),
         consult(node),nl,print('Enter the start node: '),read(Q0),
         asserta(qend(Q0)),termnode,flow(Q0).


termnode :- print('Enter the next terminal node or the word done: '),
            read(QT),
            not(QT=done),
            termck(QT),
            assertfa(node,term(QT,[])),
            asserta(qend(QT)),
            termnode.

termnode  :-  !,true.


termck(Qt)  :-  not(term(Qt,[]));
                nl,print('Terminal node ',Qt,' already entered'),nl.

..page
                        (b)  FLOW.  Flow is the primary control structure.  It
requests the next node and the condition for transition.  It verifies that the
condition is valid, that the arc has not been previously defined, and adds it to
the database. The predicate 'qendck' verifies a path has been completed.

flow(Q0)  :- nl,print('Transition from ',Q0,' to ? '),read(Qnext),
             print(' on condition ? '),read(Con),
             con(Q0,Con),arcck(Q0,Qnext,Con),
             assertfz(node,arc(Q0,Qnext,Con)),
             qendck(Q0,Qnext).

con(Q0,Con) :- condition(Con).

con(Q0,Con) :- nl,print(Con,' is an invalid condition. '),
               flow(Q0).

condition(verb).
condition(noun).
condition(aux).
condition(prep).
condition(aux).
condition(pp).
condition(np).


arcck(Q0,Qn,Z)  :-  not(arc(Q0,Qn,Z));
                    nl,print('Arc from ',Q0,' to ',Qn,' on ',Z,'
                              exits.').


                        (c) The predicate 'qendck' verifies that there is a path
from the end node of the arc just entered to a terminal node.  If not, control
is passed to 'flow', otherwise 'nextnode' allows a new path to be initiated or
the program terminated. Pthck is used to verify that there is a path to each of
the terminal nodes before the program is terminated. Checkstart prevents
isolated nodes from being inserted into the network.


qendck(Q0,Qnext)  :- qend(Qnext),(qend(Q0);asserta(qend(Q0))),nextnode.

qendck(Q0,Qnext)  :-  (qend(Q0);asserta(qend(Q0))),flow(Qnext).


nextnode :- nl,print('Enter next start node or the word done ? '),
            read(Ns),
            not(Ns=done),
            ((checkstart(Ns),
            flow(Ns));nextnode).

..page
nextnode :-  pthck,
             !,retract(term([],[])),
             nl,print('Network completed'),
             listing(arc),listing(term),
             nl,print('Enter name of new ATN file '),read(S),
             update(node,S),forget(node).


nextnode :-  nextnode.


pthck   :-    term(Q,[]),not(Q=[]),not(arc(_,Q,_)),
              nl,print('No path to terminal node ',Q),
              !,fail.

pthck    :-  term([],[]).


checkstart(Ns) :-  qend(Ns);
                   nl,print(Ns,' is an invalid node '),fail.


              2) ATNNEW  One of the features of an ATN vis-a-vis other parsers
is that the path of transversal can be used to provide information. ATNNEW is an
example which demonstrates that this can be accomplished in PROLOG. This
program, which is limited to the ATN in Figure 1, identifies the subject of the
sentence as the noun (or nouns) in the noun phrase used to transition between
nodes q0 and q1, or q4 and q5.  It also uses the 'p' or 's' associated with each
noun or verb and checks the subject and predicate for agreement in number.  The
code for the predicate ptrans, below, is annotated along the right-hand column
with numbers to correspond to the notes below.

 ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :-  S0(Type,Nbr),                       -1
                                       arc(Bq,Zq,Type),
        ( ( not(Type=noun); subj(_) ); asserta(subj(Nbr)) ),               -2
                                       append(Pr,[[Type],S0],P1),
                                       ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(Bq,Nq,Lq,S,Pr,Parse)   :-  arc(Bq,Zq,[]),
                                  ptrans(Zq,Nq,Lq,S,Pr,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,(Lq=q4;Lq=q0),              -3
                       ( ( subj(_),retract(subj(_)) ); not(subj(_)) ),     -4
                                        asserta(subj(p)),                  -5
                                        append(Pr,[and],P1),
                                        ptrans(qnp,Nq,Lq,S1,P1,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,                            -6
                                        append(Pr,[and],P1),
                                        ptrans(qnp,Nq,Lq,S1,P1,Parse).




ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :-  nl,
                                   print('Transition ',Lq,' ',Nq),
                                   nl,
                                   print(Pr),
                                   append(Parse,Pr,P1),
                                   trans(Nq,Rq,P1,S0,S1).



              -1.  S0 is the next word in the sentence.  Each word is defined as
a unique fact with a type and number (p or s or x).

              -2.  This line establishes the number of the subject as that of
the noun unless one has already been established.  The subject for all sentences
covered by the ATN in Figure 1 will be located in noun phrases parsed before
reaching node q2, hence nouns in noun phrases at node q2 or q3 will be ignored.

              -3.  This predicate is a special provision for the use of 'and' if
the next word is 'and', and we are attempting to transition from node q4 or q0.

              -4.  Retract the predicate subj which contains the number for the
subject.  The not(subj(_)) is actually not required, since the subj has had to
been asserted if the program gets to this point but is included for balance.

              -5.  This part of the clause establishes the number associated with
the subject as plural based on the use of and.

              -6.  This clause accounts for the case of an and in a noun phrase
not at node q0 or q4.

6.  Conclusions.  The programs developed for this project demonstrate that
PROLOG is a powerful language that offers unique capabilities and interesting
potential but little user interface. It is surprising that the power of the
language has not been exploited to enhance the utility.

    a.  Any useful application will require some form of procedure.
Construction of these procedures, such as in the Phase III example, is awkward
in the current language.

    b.  Although all variables are local to a predicate, the dynamic nature of
PROLOG enables the programmer to establish global variables through program
modification.  It is this feature which appears to offer great potential.

    c.  There are some alternative search techniques, beyond the scope of this
paper, which should be evaluated.

    d.  Given that these examples only employ the most rudimentary PROLOG
commands, the language appears to offer a rich environment, limited primarily by
the lack of user interface.



..pgno1
..foot59c1-##
/*                 Augmented Transition Network Program

                                  ATN.PRO

                                 10/22/85
*/


/*  Standard routines for append & membership checking       */


append([],L,L).
append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3).

printstring([]).
printstring([H|T]) :- put(H), printstring(T).

member(X,[X|_]).
member(X,[_|Y]) :- member(X,Y).


/*  The start module accepts a set of words, enclosed in brackets and
separated by commas.  It calls wordck to verify that each of the words is
in the vocabulary set.   */



start :- batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),!,
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,q(0,S).



/*  Wordck checks for the end of the set, [], then if the word is in the
vocabulary.  If not, it asks for the category, and adds it to the file
WORD.TEM which is joined with the program after it has run.*/



wordck([])   :-   !,true.

wordck([H|T]) :- word(H,Y),wordck(T).


wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  wordnew(H,Z),wordck(T).

wordnew(W,Z) :- assertz(word(W,Z)),open('word.tem',ar),
                nlf('word.tem'),
                printf('word.tem', 'word(', W, ',', Z, ').'),
                close('word.tem').


/*  Trans checks the category of the current word (H) versus the category
required to make a transition (Z).  */


trans(H,Z)   :-  word(H,X), member(X,[Z]).


qfail(Nq,S,E)  :-  !, nl,nl,print('The sentence failed at ',Nq),nl,
                 print('The sentence form to this node is ',E),nl,
                 print('The rest of the sentence is ',S),qend1.


qend(Z,E)  :-  nl,nl,print('OUTPUT'),nl,print('------'),nl,nl,
               print('The sentence is:'),nl,nl,print(E),nl,nl,
               print('The sentence is completed at node ',Z),qend1.


qend1 :- open('word.tem',ar),nlf('word.tem'),
         close('word.tem'),exec('ren atn.pro atn.sav'),
         exec('copy atn.sav+word.tem atn.pro'),
         exec('erase atn.sav'),exec('erase word.tem').


/*    Print transfer from node to node */


qout(A,B,C,D,E,F) :- append(E,[C,'(',A,')'],F),
                     nl, print('Transfer from node ',B,' to node ',D,
                     ' by word ',A,' evaluated as a ',C).


/*   Main program to check the conditions for transfer from node to node.
     The first number is the number of the node, i.e. q(0.. is node 0.
     The module either checks for a word type and transfers control
     directly, or passes to np / pp the next node.                    */


/*  Node 0 - aux to 4 / np to 1 / or fail          */


q(0,[H|T])  :-  trans(H,[aux]),!,qout(H,0,[aux],4,E,F), q(4,T,F).

q(0,[H|T])  :-  np(H,T,1,[],0,[np]).

q(0,S)      :-  qfail(0,S,[]).


/*  Node 1 - verb to 2 / aux to 5 / or fail    */


q(1,[H|T],E)  :-  trans(H,[verb]),!,qout(H,1,[verb],2,E,F), q(2,T,F).

q(1,[H|T],E)  :-  trans(H,[aux]),!, qout(H,1,[aux],5,E,F), q(5,T,F).

q(1,S,E)      :-  qfail(1,S,E).

/*  Node 2 -  null to end / np to 2 / pp to 3 / or fail     */


q(2,H,E)      :- member(H,[[]]), !,
                   qend(2,E).

q(2,[H|T],E)  :-  np(H,T,2,E,2,[np]).


q(2,[H|T],E)  :-  pp(H,T,3,E,2,[pp]).

q(2,S,E)      :-  qfail(2,S,E).


/*  Node 3 - null to end / or fail         */


q(3,H,E)  :- trans(H,[]), !,
             qend(3,E).

q(3,S,E)      :-  qfail(3,S,E).



/*  Node 4 - np to 5 / or fail           */


q(4,[H|T],E)  :-  np(H,T,5,E,4,[np]).

q(4,S,E)      :-  qfail(4,S,E).



/*  Node 5 - verb to 2 / or fail         */


q(5,[H|T],E)  :-  trans(H,[verb]),!, qout(H,5,[verb],2,E,F), q(2,T,F).

q(5,S,E)      :-  qfail(5,S,E).



/*  Noun phrase -  (det) (adj) (adj) .. noun        */

/*  The np1 clause is required to allow recursive calls for adj   */


np(H,[S|T],Nq,E,Lq,G)  :-  trans(H,[det]), !,
                           append(G,['det(',H,')'],G1),
                           np1([S|T],Nq,E,Lq,G1).


np(H,Z,Nq,E,Lq,G)      :-  np1([H|Z],Nq,E,Lq,G).



np1([H|T],Nq,E,Lq,G)  :-  trans(H,[adj]),
                          append(G,['adj(',H,')'],G1),
                          np1(T,Nq,E,Lq,G1).


np1([H|T],Nq,E,Lq,G)  :- trans(H,[noun]),!,nl,
                         append(G,['noun(',H,')'],G1),
                         append(E,G1,F),
                         print('Transfer from node ',Lq,' to ',Nq),
                         print(' by ',G1),q(Nq,T,F).


/*  Prep phrase requires a prep followed by a np   */


pp(H,[S|T],Nq,E,Lq,G)  :-  trans(H,[prep]),
                           append(['prep(',H,')'],G,G1),
                           np(S,T,Nq,E,Lq,G1).


/*   Word defines the vocabulary set                  */


word(the,[det]).
word(boy,[noun]).
word(runs,[verb]).
word(happy,[adj]).
word(john,[noun]).
word(can,[aux]).
word(run,[verb]).
word(a,[det]).
word(big,[adj]).
word(small,[adj]).
word(girl,[noun]).
word(dog,[noun]).
word(on,[prep]).
word(pretty,[adj]).
word(fast,[adj]).
word(barks,[verb]).
word(to,[prep]).
word([],[]).
word(giant, [noun]).
word(is, [verb]).
word(giant, [noun]).
word(is, [verb]).
word(sleeps, [verb]).
word(mary, [noun]).
word(likes, [verb]).

..pgno1
..foot59c2-##
/*                 Augmented Transition Network Program

                                ATNREV.PRO

                                 11/24/85
*/


/*  Standard routines for append & membership checking       */


append([],L,L).
append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3).

printstring([]).
printstring([H|T]) :- put(H), printstring(T).

member(X,[X|_]).
member(X,[_|Y]) :- member(X,Y).


/*  The start module accepts a set of words, enclosed in brackets and
separated by commas.  It calls wordck to verify that each of the words is
in the vocabulary set.   */


start :- batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),!,
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,
         Parse=[],
         trans(q0,Nq,Parse,S,S1).


/*  Wordck checks for the end of the set, [], then if the word is in the
vocabulary.  If not, it asks for the category, and adds it to the file
WORD.TEM which is joined with the program after it has run.*/


wordck([])   :-   !,true.

wordck([H|T]) :- word(H,_,_),wordck(T).


wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  wordnew(H,Z),wordck(T).

wordnew(W,Z) :- assertz(word(W,Z,s)),open('word.tem',ar),
                nlf('word.tem'),
                printf('word.tem', 'word(', W, ',', Z, ').'),




/*  The arcs are defined in terms of from node, to node, condition.
Terminal nodes are identified with the empty list.  Words are defined by
type word name, type, and a character to be used in later examples with the
number (plural or singular).  */


arc(q0,q1,np).
arc(q1,q2,verb).
arc(q2,q2,np).
arc(q2,q3,pp).
arc(q0,q4,aux).
arc(q4,q5,np).
arc(q1,q5,aux).
arc(q5,q2,verb).

term(q2,[]).
term(q3,[]).


word(boy,noun,s).
word(boys,noun,pl).
word(run,verb,pl).
word(runs,verb,s).
word(the,det,s).

arc(qnp,qnp1,det).
arc(qnp,qnp1,_).
arc(qnp1,qnp1,adj).
arc(qnp1,qnp2,noun).
arc(qpp,qnp,prep).


/*  Trans recursively checks the conditions for transition from the last
node (Lq) to the next node (Nq).  Phrases are specifically treated as pp or
np in order to allow the type of phrase to be identified in the parsed
sentence.  */


trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl,
                          print('Completed ',Lq),
                          nl,print(Parse).


trans(Lq,Nq,Parse,[S0|S1],S1) :-  word(S0,Type,Nbr),
                                  arc(Lq,Nq,Type),
                                  nl,
                                  print('Transition ',Lq,' ',Nq,' ',S0,
                                            ' ',Type),
                                  append(Parse,[[Type],S0],P1),
                                  !,
                                  trans(Nq,Z,P1,S1,S2).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,np),
                             ptrans(qnp,Nq,Lq,S0,[np],Parse).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,pp),
                             ptrans(qpp,Nq,Lq,S0,[pp],Parse).



trans(Lq,Nq,Parse,S0,S1) :- !,nl,
                            print('The sentence failed at ',Lq),
                            nl,print('Parsed ',Parse),
                            nl,print('Left ',S0).

/*  Ptrans checks the transition of the phrase network.  The first clause
calls itself recursively until node qnp2 has been reached, which concludes
the transition.  Success results in trans being called  with the new node.
Failure returns the trans with conditions unchanged.  */


ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :-  word(S0,Type,Nbr),
                                arc(Bq,Zq,Type),
                                append(Pr,[[Type],S0],P1),
                                !,
                                ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :-  nl,
                                   print('Transition ',Lq,' ',Nq),
                                   nl,
                                   print(Pr),
                                   append(Parse,Pr,P1),
                                   !,
                                   trans(Nq,Rq,P1,S0,S1).

..page
..pgno1
..foot59c3-##
/*        PROGRAM TO BUILD PRIMARY AUGMENTED TRANSITION NETWORK

                                ATNBLD.PRO

                                 11/24/85

*/


/*  Build is the entry point into the program.  It requires that the
program with standard routines and the program node, which is empty, have
already been consulted.  */

/*  The program requests the start and terminal nodes, the paths and
transition conditions, then establishes a node program with a name
specified by the user.  */

/*  Ret removes any data from memory which might interfere with network
construction.  Term([],[]) is required to prevent failure when checkint
terminal conditions.  Qend identifies all nodes for which there is a path
to a terminal node.  The start node is identified initially since the
program will require this path be completed before any other can be
constructed.  Termnode accepts the terminal nodes.  Flow accepts the
transition arcs and conditions.  */


build :- batch,ret(qend),nl,ret(arc),nl,ret(term),asserta(term([],[])),
         nl,print('Enter the start node: '),read(Q0),
         asserta(qend(Q0)),termnode,flow(Q0).


termnode :-  print('Enter the next terminal node or the word done: '),
             read(QT),
             not(QT=done),
             termck(QT),
             assertfa(node,term(QT,[])),
             asserta(qend(QT)),
             termnode.

termnode  :-  !,true.


/*  Flow requests transitions from node to node and adds each arc and new
node to the database.  Qendck will continue to call flow until such time as
a terminal node has been reached then allow a new path to be initiated.  */



flow(Q0)  :- nl,print('Transition from ',Q0,' to ? '),read(Qnext),
             print(' on condition ? '),read(Con),
             con(Q0,Con),arcck(Q0,Qnext,Con),
             assertfz(node,arc(Q0,Qnext,Con)),
             qendck(Q0,Qnext).

con(Q0,Con) :- condition(Con).

con(Q0,Con) :- nl,print(Con,' is an invalid condition. '),
               flow(Q0).

termck(Qt)  :-  not(term(Qt,[]));
                nl,print('Terminal node ',Qt,' already entered'),nl.

arcck(Q0,Qn,Z)  :-  not(arc(Q0,Qn,Z));
                    nl,print('Arc from ',Q0,' to ',Qn,' on ',Z,' exits.').

qendck(Q0,Qnext)  :-  qend(Qnext),(qend(Q0);asserta(qend(Q0))),nextnode.

qendck(Q0,Qnext)  :-  (qend(Q0);asserta(qend(Q0))),flow(Qnext).


/*  Nextnode allows a new path to be initiated or the program to be
terminated.  Before termination it calls pthck to insure there is a path to
each terminal node.  Checkstart prevents an isolated node from being
entered.  */

nextnode :-  nl,print('Enter next start node or the word done ? '),
             read(Ns),
             not(Ns=done),
             ((checkstart(Ns),
             flow(Ns));nextnode).

nextnode :-  pthck,
             !,retract(term([],[])),
             nl,print('Network completed'),
             listing(arc),listing(term),
             nl,print('Enter name of new ATN file '),read(S),
             update(node,S).

nextnode :-  nextnode.

pthck   :-    term(Q,[]),not(Q=[]),not(arc(_,Q,_)),
              nl,print('No path to terminal node ',Q),
              !,fail.

pthck    :-  term([],[]).

checkstart(Ns) :-  qend(Ns);
                   nl,print(Ns,' is an invalid node '),fail.

/*  Condition lists the acceptable conditions for a transition.   */

condition(verb).
condition(noun).
condition(aux).
condition(prep).
condition(aux).
condition(pp).
condition(np).
..pgno1
..foot59c4-##
/*              FINAL AUGMENTED TRANSITION NETWORK PROGRAM

                                ATNNEW1.PRO

                                 11/24/85
*/


/*  Start is the entry into the program.  It requires that a set of
standard routines has already been consulted (append in particular).  It
allows the user to specify the network program, which can be build using
ATNBLD.  Words is a file with the vocabulary set.  The sentences is a list
of words separated by commas and enclosed in brackets.  Wordck verifies
that the words are in the vocabulary set, and if not requests required
data. Parse is the sentence as it is parsed.  Trans controls the flow from
node to node.  */

start :- nl,print('ATN network file? '),read(Fn),
         consult(Fn),nl,
         asserta(file(Fn)),
         consult(words),nl,
         batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,
         Parse=[],
         trans(q0,Nq,Parse,S,S1).


wordck([])   :-   true.

wordck([H|T]) :- H(_,_),wordck(T).

wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  nl,print(' enter p or s or x  '),read(Z1),
                  wordnew(H,Z,Z1),wordck(T).

wordnew(W,Z,Z1) :- assertfz(words,W(Z,Z1)).


/*  Since the phrase transition network includes more specific procedures
than the primary network, it is included in this program rather than in the
network file consulted by start.  It could be more dynamic, but that was
considered beyond the scope of this project.  */


arc(qnp,qnp1,det).
arc(qnp,qnp1,[]).
arc(qnp1,qnp1,adj).
arc(qnp1,qnp2,noun).
arc(qpp,qnp,prep).


/*  Trans controls the flow along the network.  If a terminal node has been
reached and the entire sentence has been parsed, the agreement in number
(plural or singular) between the subject and predicate is checked.  If they
do not agree, this fact is displayed.  Update words creates a file
WORDS.$$$ which contains the new vocabulary.

If a conditions for termination has not been met, trans checks for a
transition word or a transition phrase.  If none of these conditions are
met, the sentence will not parse.

When a verb is encountered the number (singular or plural) is 'filed'.
This procedure is unique for a specific network in which only one verb can
be encountered.  */

trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl,
                          print('Completed ',Lq),
                          nl,print(Parse),
                       (  ( subj(Nbr),pred(Nbr) );
                      (nl,print('The subject and predicate do not agree.')
                          ) ),
                          update(words),
                          exec('erase words.pro'),
                          exec('ren words.$$$ words.pro'),
                          forget(words),
                          file(Fn),
                          forget(Fn),
                          endclr.

endclr :-  (not(file(_));ret(file)),(not(subj(_));ret(subj)),
           (not(pred(_));ret(pred)).


trans(Lq,Nq,Parse,[S0|S1],S1) :-  S0(Type,Nbr),
                                  arc(Lq,Nq,Type),
                                 ((Type=verb,asserta(pred(Nbr)));
                                     not(type=verb)),
                                  nl,
                                  print('Transition ',Lq,' ',Nq,' ',S0,
                                            ' ',Type),
                                  append(Parse,[[Type],S0],P1),
                                  trans(Nq,Z,P1,S1,S2).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,np),
                             ptrans(qnp,Nq,Lq,S0,[' '+np],Parse).

trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,pp),
                             ptrans(qpp,Nq,Lq,S0,[' '+pp],Parse).

trans(Lq,Nq,Parse,S0,S1) :- nl,
                            print('The sentence failed at ',Lq),
                            nl,print('Parsed ',Parse),
                            nl,print('Left ',S0),
                            endclr.
/*  Ptrans checks the transition of the phrase network.  It calls itself
recursively until node qnp2 is reached.  Provisions are included to
establish the number (plural or singular) of the subject, which is designed
for a specific network in which the noun phrase in which the subject is
located will be encountered before any other noun phrase.

The upon reaching qnp2 a check is made for the word 'and'.  If encountered,
the number of the subject is changed to plural and a check for another noun
phrase is initiated.

The spacing of the parenthesis is to facilitate reading of the code.  */


ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :-  S0(Type,Nbr),
                                arc(Bq,Zq,Type),
                          (
                             (
                                 not(Type=noun);

                                 subj(_)
                                          );
                                 asserta(subj(Nbr))
                                                  ),
                                append(Pr,[[Type],S0],P1),
                                ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(Bq,Nq,Lq,S,Pr,Parse)   :-  arc(Bq,Zq,[]),
                                  ptrans(Zq,Nq,Lq,S,Pr,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,(Lq=q4;Lq=q0),
                                       ( ( subj(_),retract(subj(_)) );
                                         not(subj(_)) ),
                                         asserta(subj(p)),
                                          append(Pr,[and],P1),
                                          ptrans(qnp,Nq,Lq,S1,P1,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,
                                          append(Pr,[and],P1),
                                          ptrans(qnp,Nq,Lq,S1,P1,Parse).




ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :-  nl,
                                   print('Transition ',Lq,' ',Nq),
                                   nl,
                                   print(Pr),
                                   append(Parse,Pr,P1),
                                   trans(Nq,Rq,P1,S0,S1).
append([],L,L).
append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3).

printstring([]).
printstring([H|T]) :- put(H), printstring(T).

ret(X) :- X(_),retract(X(_)),ret(X).
ret(X) :- X(_,_),retract(X(_,_)),ret(X).
ret(X) :- X(_,_,_),retract(X(_,_,_)),ret(X).
ret(X) :- nl,print(X,' has been retracted').
/*         final atn program    */
/*                empty node program          */
/*        PROGRAM TO BUILD PRIMARY AUGMENTED TRANSISTION NETWORK

                                ATNBLD.PRO

                                 11/24/85

*/


/*  Build is the entry point into the program.  It requires that the
program with standard routines and the program node, which is empty, have
already been consulted.  */

/*  The program requests the start and terminal nodes, the paths and
transistion conditions, then establishes a node program with a name
specified by the user.  */

/*  Ret removes any data from memory which might iterfere with network
construction.  Term([],[]) is required to prevent failure when checkint
terminal conditions.  Qend identifies all nodes for which there is a path
to a terminal node.  The start node is identified initially since the
program will require this path be completed before any other can be
constructed.  Termnode accepts the terminal nodes.  Flow accepts the
transition arcs and conditions.  */


build :- batch,ret(qend),nl,ret(arc),nl,ret(term),asserta(term([],[])),
         nl,print('Enter the start node: '),read(Q0),
         asserta(qend(Q0)),termnode,flow(Q0).


termnode :-  print('Enter the next terminal node or the word done: '),
             read(QT),
             not(QT=done),
             termck(QT),
             assertfa(node,term(QT,[])),
             asserta(qend(QT)),
             termnode.

termnode  :-  !,true.


/*  Flow requests transistions from node to node and adds each arc and new
node to the database.  Qendck will continue to call flow until such time as
a terminal node has been reached then allow a new path to be initiated.  */



flow(Q0)  :- nl,print('Transisition from ',Q0,' to ? '),read(Qnext),
             print(' on condition ? '),read(Con),
             con(Q0,Con),arcck(Q0,Qnext,Con),
             assertfz(node,arc(Q0,Qnext,Con)),
             qendck(Q0,Qnext).

con(Q0,Con) :- condition(Con).

con(Q0,Con) :- nl,print(Con,' is an invalid condition. '),
               flow(Q0).

termck(Qt)  :-  not(term(Qt,[]));
                nl,print('Terminal node ',Qt,' already entered'),nl.

arcck(Q0,Qn,Z)  :-  not(arc(Q0,Qn,Z));
                    nl,print('Arc from ',Q0,' to ',Qn,' on ',Z,' exits.').

qendck(Q0,Qnext)  :-  qend(Qnext),(qend(Q0);asserta(qend(Q0))),nextnode.

qendck(Q0,Qnext)  :-  (qend(Q0);asserta(qend(Q0))),flow(Qnext).


/*  Nextnode allows a new path to be initiated or the program to be
terminated.  Before termination it calls pthck to insure there is a path to
each terminal node.  Checkstart prevents an isolated node from being
entered.  */



nextnode :-  nl,print('Enter next start node or the word done ? '),
             read(Ns),
             not(Ns=done),
             ((checkstart(Ns),
             flow(Ns));nextnode).


nextnode :-  pthck,
             !,retract(term([],[])),
             nl,print('Network completed'),
             listing(arc),listing(term),
             nl,print('Enter name of new ATN file '),read(S),
             update(node,S).


nextnode :-  nextnode.


pthck   :-    term(Q,[]),not(Q=[]),not(arc(_,Q,_)),
              nl,print('No path to terminal node ',Q),
              !,fail.

pthck    :-  term([],[]).


checkstart(Ns) :-  qend(Ns);
                   nl,print(Ns,' is an invalid node '),fail.


/*  Condition lists the acceptable conditions for a transistion.   */


condition(verb).
condition(noun).
condition(aux).
condition(prep).
condition(aux).
condition(pp).
condition(np).

plane(noun,s).


green(adj,x).


gocart(noun,s).


black(adj,x).


bikes(noun,p).


farm(noun,s).


girls(noun,p).


car(noun,s).


rides(verb,s).


and(conj,x).


girl(noun,s).


ran(verb,p).


big(adj,x).


bike(noun,s).


ride(verb,p).


store(noun,s).


to(prep,x).


home(noun,s).

/*           words file          */
/*          11/19/85           */


boy(noun,s).
boys(noun,p).
run(verb,p).
runs(verb,s).
can(aux,x).
the(det,s).
/*                 Augmented Transition Network Program

                                ATNREV.PRO

                                 11/24/85
*/


/*  Standard routines for append & membership checking       */


append([],L,L).
append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3).

printstring([]).
printstring([H|T]) :- put(H), printstring(T).

member(X,[X|_]).
member(X,[_|Y]) :- member(X,Y).


/*  The start module accepts a set of words, enclosed in brackets and
separated by commas.  It calls wordck to verify that each of the words is
in the vocuabulary set.   */



start :- batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),!,
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,
         Parse=[],
         trans(q0,Nq,Parse,S,S1).


/*  Wordck checks for the end of the set, [], then if the word is in the
vocabulary.  If not, it asks for the catagory, and adds it to the file
WORD.TEM which is joined with the program after it has run.*/





wordck([])   :-   !,true.

wordck([H|T]) :- word(H,_,_),wordck(T).


wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  wordnew(H,Z),wordck(T).

wordnew(W,Z) :- assertz(word(W,Z,s)),open('word.tem',ar),
                nlf('word.tem'),
                printf('word.tem', 'word(', W, ',', Z, ').'),
                close('word.tem').




/*  The arcs are defined in terms of from node, to node, condition.
Terminal nodes are identified with the empty list.  Words are defined by
type word name, type, and a character to be used in later examples with the
number (plural or singular).  */


arc(q0,q1,np).
arc(q1,q2,verb).
arc(q2,q2,np).
arc(q2,q3,pp).
arc(q0,q4,aux).
arc(q4,q5,np).
arc(q1,q5,aux).
arc(q5,q2,verb).

term(q2,[]).
term(q3,[]).


word(boy,noun,s).
word(boys,noun,pl).
word(run,verb,pl).
word(runs,verb,s).
word(the,det,s).

arc(qnp,qnp1,det).
arc(qnp,qnp1,_).
arc(qnp1,qnp1,adj).
arc(qnp1,qnp2,noun).
arc(qpp,qnp,prep).


/*  Trans recursively checks the conditions for transistion from the last
node (Lq) to the next node (Nq).  Phrases are specifically treated as pp or
np in order to allow the type of phrase to be identified in the parsed
sentence.  */




trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl,
                          print('Completed ',Lq),
                          nl,print(Parse).


trans(Lq,Nq,Parse,[S0|S1],S1) :-  word(S0,Type,Nbr),
                                  arc(Lq,Nq,Type),
                                  nl,
                                  print('Transition ',Lq,' ',Nq,' ',S0,
                                            ' ',Type),
                                  append(Parse,[[Type],S0],P1),
                                  !,
                                  trans(Nq,Z,P1,S1,S2).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,np),
                             ptrans(qnp,Nq,Lq,S0,[np],Parse).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,pp),
                             ptrans(qpp,Nq,Lq,S0,[pp],Parse).



trans(Lq,Nq,Parse,S0,S1) :- !,nl,
                            print('The sentence failed at ',Lq),
                            nl,print('Parsed ',Parse),
                            nl,print('Left ',S0).

/*  Ptrans checks the transistion of the phrase network.  The first clause
calls itself recursively until node qnp2 has been reached, which concludes
the transistion.  Success results in trans being called  with the new node.
Failure returns the trans with conditions unchanged.  */



ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :-  word(S0,Type,Nbr),
                                arc(Bq,Zq,Type),
                                append(Pr,[[Type],S0],P1),
                                !,
                                ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :-  nl,
                                   print('Transisiton ',Lq,' ',Nq),
                                   nl,
                                   print(Pr),
                                   append(Parse,Pr,P1),
                                   !,
                                   trans(Nq,Rq,P1,S0,S1).
/*              FINAL AUGMENTED TRANSISTION NETWORK PROGRAM

                                ATNNEW1.PRO

                                 11/24/85
*/


/*  Start is the entry into the program.  It requires that a set of
standard routines has already been consulted (append in particular).  It
allows the user to specify the network program, which can be build using
ATNBLD.  Words is a file with the vocabulary set.  The sentences is a list
of words separated by commas and enclosed in brackets.  Wordck verifies
that the words are in the vocabulary set, and if not requests required
data. Parse is the sentence as it is parsed.  Trans controls the flow from
node to node.  */


start :- nl,print('ATN network file? '),read(Fn),
         consult(Fn),nl,
         asserta(file(Fn)),
         consult(words),nl,
         batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,
         Parse=[],
         trans(q0,Nq,Parse,S,S1).



wordck([])   :-   true.

wordck([H|T]) :- H(_,_),wordck(T).


wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  nl,print(' enter p or s or x  '),read(Z1),
                  wordnew(H,Z,Z1),wordck(T).

wordnew(W,Z,Z1) :- assertfz(words,W(Z,Z1)).


/*  Since the phrase transition network includes more specific procedures
than the primary network, it is included in this program rather than in the
network file consulted by start.  It could be more dynamic, but that was
considered beyond the scope of this project.  */


arc(qnp,qnp1,det).
arc(qnp,qnp1,[]).
arc(qnp1,qnp1,adj).
arc(qnp1,qnp2,noun).
arc(qpp,qnp,prep).


/*  Trans controls the flow along the network.  If a terminal node has been
reached and the entire sentence has been parsed, the agreement in number
(plural or singular) between the subject and predicate is checked.  If they
do not agree, this fact is displayed.  Update words creates a file
WORDS.$$$ which contains the new vocabulary.

If a conditions for termination has not been met, trans checks for a
transition word or a transistion phrase.  If none of these conditions are
met, the sentence will not parse.

When a verb is encountered the number (singular or plural) is 'filed'.
This procedure is unique for a specific network in which only one verb can
be encountered.  */


trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl,
                          print('Completed ',Lq),
                          nl,print(Parse),
                       (  ( subj(Nbr),pred(Nbr) );
                      (nl,print('The subject and predicate do not agree.')
                          ) ),
                          update(words),
                          exec('erase words.pro'),
                          exec('ren words.$$$ words.pro'),
                          forget(words),
                          file(Fn),
                          forget(Fn),
                          endclr.


endclr :-  (not(file(_));ret(file)),(not(subj(_));ret(subj)),
           (not(pred(_));ret(pred)).


trans(Lq,Nq,Parse,[S0|S1],S1) :-  S0(Type,Nbr),
                                  arc(Lq,Nq,Type),
                                 ((Type=verb,asserta(pred(Nbr)));
                                     not(type=verb)),
                                  nl,
                                  print('Transition ',Lq,' ',Nq,' ',S0,
                                            ' ',Type),
                                  append(Parse,[[Type],S0],P1),
                                  trans(Nq,Z,P1,S1,S2).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,np),
                             ptrans(qnp,Nq,Lq,S0,[' '+np],Parse).


trans(Lq,Nq,Parse,S0,S1) :-  arc(Lq,Nq,pp),
                             ptrans(qpp,Nq,Lq,S0,[' '+pp],Parse).



trans(Lq,Nq,Parse,S0,S1) :- nl,
                            print('The sentence failed at ',Lq),
                            nl,print('Parsed ',Parse),
                            nl,print('Left ',S0),
                            endclr.



/*  Ptrans checks the transition of the phrase network.  It calls itself
recursively until node qnp2 is reached.  Provisions are included to
establish the number (plural or singular) of the subject, which is designed
for a specific network in which the noun phrase in which the subject is
located will be encountered before any other noun phrase.

The upon reaching qnp2 a check is made for the word 'and'.  If encountered,
the number of the subject is changed to plural and a check for another noun
phrase is initiated.

The spacing of the parathesis is to faciltiate reading of the code.  */


ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :-  S0(Type,Nbr),
                                arc(Bq,Zq,Type),
                          (
                             (
                                 not(Type=noun);

                                 subj(_)
                                          );
                                 asserta(subj(Nbr))
                                                  ),
                                append(Pr,[[Type],S0],P1),
                                ptrans(Zq,Nq,Lq,S1,P1,Parse).

ptrans(Bq,Nq,Lq,S,Pr,Parse)   :-  arc(Bq,Zq,[]),
                                  ptrans(Zq,Nq,Lq,S,Pr,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,(Lq=q4;Lq=q0),
                                       ( ( subj(_),retract(subj(_)) );
                                         not(subj(_)) ),
                                         asserta(subj(p)),
                                          append(Pr,[and],P1),
                                          ptrans(qnp,Nq,Lq,S1,P1,Parse).


ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :-  S0=and,
                                          append(Pr,[and],P1),
                                          ptrans(qnp,Nq,Lq,S1,P1,Parse).




ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :-  nl,
                                   print('Transisiton ',Lq,' ',Nq),
                                   nl,
                                   print(Pr),
                                   append(Parse,Pr,P1),
                                   trans(Nq,Rq,P1,S0,S1).
/*                 Augmented Transition Network Program

                                  ATN.PRO

                                 10/22/85
*/


/*  Standard routines for append & membership checking       */


append([],L,L).
append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3).

printstring([]).
printstring([H|T]) :- put(H), printstring(T).

member(X,[X|_]).
member(X,[_|Y]) :- member(X,Y).


/*  The start module accepts a set of words, enclosed in brackets and
separated by commas.  It calls wordck to verify that each of the words is
in the vocuabulary set.   */



start :- batch,nl,print('INPUT'),nl,print('-----'),nl,
         nl,print('Input sentence: '),read(S),nl,
         print('The working set is ',S),wordck(S),!,
         nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,q(0,S).



/*  Wordck checks for the end of the set, [], then if the word is in the
vocabulary.  If not, it asks for the catagory, and adds it to the file
WORD.TEM which is joined with the program after it has run.*/





wordck([])   :-   !,true.

wordck([H|T]) :- word(H,Y),wordck(T).


wordck([H|T]) :-  nl,print(H,' is not a recognized word '),
                  nl,print(' enter verb,aux, .. '),read(Z),
                  wordnew(H,Z),wordck(T).

wordnew(W,Z) :- assertz(word(W,Z)),open('word.tem',ar),
                nlf('word.tem'),
                printf('word.tem', 'word(', W, ',', Z, ').'),
                close('word.tem').




/*  Trans checks the catagory of the current word (H) versus the catagory
required to make a transistion (Z).  */




trans(H,Z)   :-  word(H,X), member(X,[Z]).


qfail(Nq,S,E)  :-  !, nl,nl,print('The sentence failed at ',Nq),nl,
                 print('The sentence form to this node is ',E),nl,
                 print('The rest of the sentence is ',S),qend1.


qend(Z,E)  :-  nl,nl,print('OUTPUT'),nl,print('------'),nl,nl,
               print('The sentence is:'),nl,nl,print(E),nl,nl,
               print('The sentence is completed at node ',Z),qend1.


qend1 :- open('word.tem',ar),nlf('word.tem'),
         close('word.tem'),exec('ren atn.pro atn.sav'),
         exec('copy atn.sav+word.tem atn.pro'),
         exec('erase atn.sav'),exec('erase word.tem').


/*    Print transfer from node to node */



qout(A,B,C,D,E,F) :- append(E,[C,'(',A,')'],F),
                     nl, print('Transfer from node ',B,' to node ',D,
                     ' by word ',A,' evaluated as a ',C).




/*   Main program to check the conditions for transfer from node to node.
     The first number is the number of the node, i.e. q(0.. is node 0.
     The module either checks for a word type and transfers control
     directly, or passes to np / pp the next node.                    */


/*  Node 0 - aux to 4 / np to 1 / or fail          */


q(0,[H|T])  :-  trans(H,[aux]),!,qout(H,0,[aux],4,E,F), q(4,T,F).

q(0,[H|T])  :-  np(H,T,1,[],0,[np]).

q(0,S)      :-  qfail(0,S,[]).




/*  Node 1 - verb to 2 / aux to 5 / or fail    */



q(1,[H|T],E)  :-  trans(H,[verb]),!,qout(H,1,[verb],2,E,F), q(2,T,F).

q(1,[H|T],E)  :-  trans(H,[aux]),!, qout(H,1,[aux],5,E,F), q(5,T,F).

q(1,S,E)      :-  qfail(1,S,E).




/*  Node 2 -  null to end / np to 2 / pp to 3 / or fail     */



q(2,H,E)      :- member(H,[[]]), !,
                   qend(2,E).

q(2,[H|T],E)  :-  np(H,T,2,E,2,[np]).


q(2,[H|T],E)  :-  pp(H,T,3,E,2,[pp]).

q(2,S,E)      :-  qfail(2,S,E).




/*  Node 3 - null to end / or fail         */


q(3,H,E)  :-
               trans(H,[]), !,
               qend(3,E).

q(3,S,E)      :-  qfail(3,S,E).





/*  Node 4 - np to 5 / or fail           */




q(4,[H|T],E)  :-  np(H,T,5,E,4,[np]).

q(4,S,E)      :-  qfail(4,S,E).



/*  Node 5 - verb to 2 / or fail         */


q(5,[H|T],E)  :-  trans(H,[verb]),!, qout(H,5,[verb],2,E,F), q(2,T,F).

q(5,S,E)      :-  qfail(5,S,E).




/*  Noun phrase -  (det) (adj) (adj) .. noun        */

/*  The np1 clause is required to allow recursive calls for adj   */



np(H,[S|T],Nq,E,Lq,G)  :-  trans(H,[det]), !,
                           append(G,['det(',H,')'],G1),
                           np1([S|T],Nq,E,Lq,G1).


np(H,Z,Nq,E,Lq,G)      :-  np1([H|Z],Nq,E,Lq,G).



np1([H|T],Nq,E,Lq,G)  :-  trans(H,[adj]),
                          append(G,['adj(',H,')'],G1),
                          np1(T,Nq,E,Lq,G1).


np1([H|T],Nq,E,Lq,G)  :-
                          trans(H,[noun]),!,nl,
                          append(G,['noun(',H,')'],G1),
                          append(E,G1,F),
                          print('Transfer from node ',Lq,' to ',Nq),
                          print(' by ',G1),q(Nq,T,F).




/*  Prep phrase requires a prep followed by a np   */




pp(H,[S|T],Nq,E,Lq,G)  :-  trans(H,[prep]),
                           append(['prep(',H,')'],G,G1),
                           np(S,T,Nq,E,Lq,G1).





/*   Word defines the vocabulary set                  */


word(the,[det]).
word(boy,[noun]).
word(runs,[verb]).
word(happy,[adj]).
word(john,[noun]).
word(can,[aux]).
word(run,[verb]).
word(a,[det]).
word(big,[adj]).
word(small,[adj]).
word(girl,[noun]).
word(dog,[noun]).
word(on,[prep]).
word(pretty,[adj]).
word(fast,[adj]).
word(barks,[verb]).
word(to,[prep]).
word([],[]).

word(giant, [noun]).
word(is, [verb]).

word(giant, [noun]).
word(is, [verb]).
word(sleeps, [verb]).

word(mary, [noun]).
word(likes, [verb]).




word(fly, [verb]).


word(rides, [verb]).
word(large, [adj]).
word(bike, [noun]).
word(store, [noun]).



word(gull, [noun]).
word(green, [adj]).

word(plane, [noun]).
word(silver, [adj]).