home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / polydemo.icn < prev    next >
Text File  |  2000-07-29  |  8KB  |  273 lines
  1. ############################################################################
  2. #
  3. #       File:     polydemo.icn
  4. #
  5. #       Subject:  Program to demonstrate polynomial library
  6. #
  7. #       Author:   Erik Eid
  8. #                         
  9. #       Date:     May 23, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #     This program is an example for the use of the polystuf library.  The
  18. # user is given a number of options that allow the creation, output,
  19. # deletion, or operations on up to 26 polynomials, indexed by letter.
  20. #
  21. # Available commands:
  22. #     (R)ead      - allows input of a polynomial by giving pairs of
  23. #                   coefficients and exponents.  For example, entering
  24. #                   5, 6, 2, and 3 will create 5x^6 + 2x^3.  This polynomial
  25. #                   will be stored by an index which is a lower-case letter.
  26. #     (W)rite     - outputs to the screen a chosen polynomial.
  27. #     (A)dd       - adds two polynomials and defines the sum as a third
  28. #     (S)ubtract  - subtracts two polynomials and defines the difference as
  29. #                   a third.
  30. #     (M)ultiply  - multiplies two polynomials and defines the product as a
  31. #                   third.
  32. #     (E)valuate  - gives the result of setting x in a polynomial to a value
  33. #     (C)lear     - deletes one polynomial
  34. #     (H)elp      - lists all commands
  35. #     (Q)uit      - end the demonstration
  36. #
  37. ############################################################################
  38. #
  39. #  Links: polystuf
  40. #
  41. ############################################################################
  42.  
  43. link polystuf
  44.  
  45. global filled, undefined, poly_table
  46.  
  47. procedure main()
  48. local option
  49.   poly_table := table()                    # Set up a table that will hold
  50.                                            # all of the polynomials (which
  51.                                            # are tables themselves).
  52.   filled := "That slot is already filled!"
  53.   undefined := "That has not been defined!"
  54.   SetUpDisplay()
  55.   repeat {
  56.     ShowInUse()
  57.     writes ("RWASMECHQ> ")
  58.     option := choice(read())               # Get first letter of entry in
  59.                                            # lower-case format.
  60.     case option of {
  61.       "r": PRead()
  62.       "w": PWrite()
  63.       "a": PCalc ("+")
  64.       "s": PCalc ("-")
  65.       "m": PCalc ("*")
  66.       "e": PEval()
  67.       "c": PClear()
  68.       "h": ShowHelp()
  69.       "q": break
  70.       default: write ("Invalid command!")
  71.     }
  72.     write()
  73.   }
  74. end
  75.  
  76. procedure SetUpDisplay()
  77.   write (center ("Icon v8.10 Polynomial Demo", 80))
  78.   write()
  79.   ShowHelp()
  80.   write (repl("-", 80))
  81.   return
  82. end
  83.  
  84. procedure ShowHelp()
  85.   write (repl(" ", 10), "(R)ead      (W)rite     (A)dd       (S)ubtract")
  86.   write (repl(" ", 10), "(M)ultiply  (E)valuate  (C)lear     _
  87.     (H)elp      (Q)uit")
  88.   return
  89. end
  90.  
  91. procedure ShowInUse()
  92. local keylist
  93.   keylist := list()
  94.   writes ("In Use:")
  95.   every push (keylist, key(poly_table))    # Construct a list of the keys in
  96.                                            # poly_table, corresponding to
  97.                                            # which slots are being used.
  98.   keylist := sort (keylist)
  99.   every writes (" ", !keylist)
  100.   write()
  101.   return
  102. end
  103.  
  104. procedure is_lower(c)
  105.   if /c then fail
  106.   if c == "" then fail
  107.   return (c >>= "a") & (c <<= "z")         # Succeeds only if c is a lower-
  108. end                                        # case letter.
  109.  
  110. procedure choice(s)
  111.   return map(s[1], &ucase, &lcase)         # Returns the first character of
  112.                                            # the given string converted to
  113.                                            # lower-case.
  114. end
  115.  
  116. procedure PRead()
  117. local slot, terms, c, e
  118.   repeat {
  119.     writes ("Which slot to read into? ")
  120.     slot := choice(read())
  121.     if is_lower(slot) then break
  122.   }
  123.   if member (poly_table, slot) then {      # Disallow reading into an
  124.     write (filled)                         # already occupied slot.
  125.     fail
  126.   }
  127.   write ("Input terms as coefficient-exponent pairs.  Enter 0 for")
  128.   write ("coefficient to stop.  Entries must be numerics.")
  129.   terms := list()
  130.   repeat {
  131.     write()
  132.     repeat {
  133.       writes ("Coefficient> ")     
  134.       c := read()
  135.       if numeric(c) then break
  136.     }
  137.     if c = 0 then break
  138.     repeat {
  139.       writes ("   Exponent> ")     
  140.       e := read()
  141.       if numeric(e) then break
  142.     }
  143.     put (terms, c)                         # This makes a list compatible
  144.     put (terms, e)                         # with the format needed by
  145.                                            # procedure poly of polystuf.
  146.   }
  147.   if *terms = 0 then terms := [0, 0]       # No terms = zero polynomial.
  148.   poly_table[slot] := poly ! terms         # Send the elements of terms as
  149.                                            # parameters to poly and store
  150.                                            # the resulting polynomial in the
  151.                                            # proper slot.
  152.   return
  153. end
  154.  
  155. procedure PWrite ()
  156. local slot
  157.   repeat {
  158.     writes ("Which polynomial to display? ")
  159.     slot := choice(read())
  160.     if is_lower(slot) then break
  161.   }
  162.   if member (poly_table, slot) then {      # Make sure there is a polynomial
  163.     write (poly_string(poly_table[slot]))  # to write!
  164.     return
  165.   }
  166.   else {
  167.     write (undefined)
  168.     fail
  169.   }
  170. end
  171.  
  172. procedure PCalc (op)
  173. local slot1, slot2, slot_ans, res
  174.   writes ("Which two polynomials to ")
  175.   case op of {
  176.     "+": write ("add? ")                   # Note that this procedure is
  177.     "-": write ("subtract? ")              # used for all three operations
  178.     "*": write ("multiply? ")              # since similar tasks, such as
  179.   }                                        # checking on the status of slots,
  180.                                            # are needed for all of them.
  181.   repeat {
  182.     writes ("First: ")     
  183.     slot1 := choice(read())
  184.     if is_lower(slot1) then break
  185.   }
  186.   if member (poly_table, slot1) then {
  187.     repeat {
  188.       writes ("Second: ")     
  189.       slot2 := choice(read())
  190.       if is_lower(slot2) then break
  191.     }
  192.     if member (poly_table, slot2) then {
  193.       repeat {
  194.         writes ("Slot for answer: ")     
  195.         slot_ans := choice(read())
  196.         if is_lower(slot_ans) then break
  197.       }
  198.       if member (poly_table, slot_ans) then {
  199.         write (filled)     
  200.         fail
  201.       }
  202.       else {
  203.         case op of {
  204.           "+": {
  205.             res := poly_add(poly_table[slot1], poly_table[slot2])
  206.             writes ("Sum ")
  207.           }
  208.           "-": {
  209.             res := poly_sub(poly_table[slot1], poly_table[slot2])
  210.             writes ("Difference ")
  211.           }
  212.           "*": {
  213.             res := poly_mul(poly_table[slot1], poly_table[slot2])
  214.             writes ("Product ")
  215.           }
  216.         }
  217.         write ("has been defined as polynomial \"", slot_ans, "\"")
  218.         poly_table[slot_ans] := res
  219.       }
  220.     }
  221.     else {
  222.       write (undefined)     
  223.       fail
  224.     }
  225.   }
  226.   else {
  227.     write (undefined)     
  228.     fail
  229.   }
  230.   return
  231. end
  232.  
  233. procedure PEval ()
  234. local slot, x, answer
  235.   repeat {
  236.     writes ("Which polynomial to evaluate? ")
  237.     slot := choice(read())
  238.     if is_lower(slot) then break
  239.   }
  240.   if member (poly_table, slot) then {
  241.     repeat {
  242.       writes ("What positive x to evaluate at? ")
  243.       x := read()
  244.       if numeric(x) then if x > 0 then break
  245.     }
  246.     answer := poly_eval (poly_table[slot], x)
  247.     write ("The result is ", answer)
  248.     return
  249.   }
  250.   else {
  251.     write (undefined)     
  252.     fail
  253.   }
  254. end
  255.  
  256. procedure PClear ()
  257. local slot
  258.   repeat {
  259.     writes ("Which polynomial to clear? ")
  260.     slot := choice(read())
  261.     if is_lower(slot) then break
  262.   }
  263.   if member (poly_table, slot) then {
  264.     delete (poly_table, slot)
  265.     return
  266.   }
  267.   else {
  268.     write (undefined)     
  269.     fail
  270.   }
  271. end
  272.  
  273.