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 / tests / general / ilib.icn < prev    next >
Text File  |  2002-01-24  |  10KB  |  391 lines
  1. #  a simple test of many of the core library procedures
  2.  
  3. link core
  4. link options
  5. link rational
  6.  
  7. $define LSIZE 16
  8. $define GENLIMIT 25
  9.  
  10. procedure main()
  11.    local L, LR, T, r1, r2, r3, argv
  12.  
  13.    L := [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5]
  14.    LR := lreverse(L)
  15.    T := table("0")
  16.    T["one"] := 101
  17.    T["two"] := 22
  18.    T["three"] := 333
  19.  
  20.    write()
  21.    write("convert:")            # convert
  22.    gen(exbase10, 11213, 8)
  23.    gen(inbase10, 11213, 8)
  24.    gen(radcon, 11213, 4, 7)
  25.  
  26.    write()
  27.    write("datetime:")            # datetime
  28.    HoursFromGmt := 7
  29.    gen(ClockToSec, "14:27:43")
  30.    gen(DateLineToSec, "Friday, September 7, 1984  1:07 pm")
  31.    gen(DateToSec, "1984/09/07")
  32.    gen(SecToClock, 14 * 3600 + 27 * 60 + 43)
  33.    gen(SecToDate, 463338000)
  34.    gen(SecToDateLine, 463385237)
  35.    gen(SecToUnixDate, 463385237)
  36.    gen(IsLeapYear, 2004)
  37.    gen(dayoweek, 7, 9, 1984)
  38.    gen(julian, 9, 7, 1984)
  39.    gen(saytime, "15:00:47")
  40.    # several procedures that return records omitted
  41.  
  42.    write()
  43.    write("factors:")            # factors
  44.    gen(divisors, 360)
  45.    lst(divisorl, 576)
  46.    gen(factorial, 0)
  47.    gen(factorial, 6)
  48.    lst(factors, 360)
  49.    gen(genfactors, 360)
  50.    gen(gfactorial, 5, 2)
  51.    gen(ispower, 81, 4)
  52.    gen(isprime, 97)
  53.    gen(nxtprime, 97)
  54.    lst(pfactors, 360)
  55.    lst(prdecomp, 360)
  56.    lst(prdecomp, 504)
  57.    gen(prime)
  58. #  gen(primel)        # not testable without data file
  59. #  gen(primeorial, 12)    # not testable without data file
  60.    gen(sfactors, 360)
  61.    every gen(squarefree, 23 to 30)
  62.  
  63.    write("[testing factorizations]")
  64.    every tfact(1 to 100)
  65.    write("[testing prime numbers]")
  66.    tprimes(100)
  67.  
  68.    write()
  69.    write("io:")                # io
  70.    gen(exists, "/foo/bar/baz/not/very/likely")
  71.    gen(directory, "/tmp")
  72.    # several others omitted
  73.  
  74.    write()
  75.    write("lists:")            # lists
  76.    lst(lcollate, L, LR)
  77.    lst(lcompact, L)
  78.    lst(lclose, [3, 1, 4, 1])
  79.    lst(ldelete, copy(L), 3)
  80.    lst(ldupl, L, 2)
  81.    lst(lequiv, L, copy(L))
  82.    lst(lextend, L, 20)
  83.    lst(lfliph, L)
  84.    lst(lflipv, L)
  85.    lst(limage, L)
  86.    gen(lindex, L, 5)
  87.    lst(linterl, L, LR)
  88.    lst(llayer, L, L)
  89.    lst(llpad, L, 14, 0)
  90.    lst(lltrim, L, set([3]))
  91.    lst(lpalin, L)
  92.    lst(lpermute, L)
  93.    lst(lreflect, L)
  94.    lst(lremvals, L, 1, 5)
  95.    lst(lrepl, L, 2)
  96.    lst(lresidue, L, 3)
  97.    lst(lreverse, L)
  98.    lst(lrotate, L, 4)
  99.    lst(lrpad, L, 14, 0)
  100.    lst(lrtrim, L, set([3, 5]))
  101.    lst(lrundown, L, LR)
  102.    lst(lrunup, L, LR)
  103.    lst(lshift, L, 3)
  104.    lst(lswap, L)
  105.    lst(lunique, L)
  106.    lst(lmaxlen, L, integer)
  107.    lst(lminlen, L, integer)
  108.    lst(sortkeys, L)
  109.    lst(sortvalues, L)
  110.    lst(str2lst, "Once upon a midnight dreary", 5)
  111.    # several others omitted
  112.  
  113.    write()
  114.    write("math:")            # math
  115.    gen(binocoef, 16, 5)
  116.    gen(cosh, &pi / 3)
  117.    gen(sinh, &pi / 3)
  118.    gen(tanh, &pi / 3)
  119.  
  120.    write()
  121.    write("numbers:")            # numbers 
  122.    gen(adp, 2147483647)
  123.    gen(adr, 2147483647)
  124.    gen(amean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
  125.    gen(ceil, &pi)
  126.    gen(commas, 2147483647)
  127.    every gen(decimal, 1, 1 to 20)
  128.    gen(decipos, &pi, 6, 10)
  129.    gen(digprod, 2147483647)
  130.    gen(digred,  2147483647)
  131.    gen(digroot, 2147483647)
  132.    gen(digsum,  2147483647)
  133.    gen(distseq, 1, GENLIMIT)
  134.    gen(div, 355, 113)
  135.    gen(fix, 355, 113, 10, 4)
  136.    gen(floor, &phi)
  137.    gen(frn, &pi, 10, 4)
  138.    gen(gcd, 42, 120)
  139.    gen(gcdl, 42, 120, 81)
  140.    gen(gmean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
  141.    gen(hmean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
  142.    gen(large, 214748364721474836472147483647)
  143.    gen(lcm, 20, 24)
  144.    gen(lcm, 20, 24, 16)
  145.    gen(mantissa, &e)
  146.    gen(max, &e, &pi, &phi)
  147.    gen(mdp, 2147483647)
  148.    gen(mdr, 2147483647)
  149.    gen(min, &e, &pi, &phi)
  150.    gen(mod1, 21, 7)
  151.    gen(npalins, 2)
  152.    gen(residue, 21, 7, 14)
  153.    gen(roman, 1989)
  154.    gen(round, &e)
  155.    gen(sign, -47)
  156.    gen(spell, 47193)                # result is not strictly correct
  157.    gen(sum, 1, 1, 2, 3, 5, 8, 13, 21, 42)
  158.    gen(trunc, &phi)
  159.    gen(unroman, "MCMLXXIV")
  160.  
  161.    write()
  162.    write("options:")            # options  (not part of core)
  163.    argv := ["-abc","-","-s","-v","-i","42","-r","98.6","--","-b","x","y"] 
  164.    tbl(options, copy(argv))
  165.    tbl(options, copy(argv), "scrivab")
  166.    tbl(options, copy(argv), "a:s:i:r:b:")
  167.    tbl(options, copy(argv), "a:s!v!i+r.b!")
  168.    tbl(options, copy(argv), "-abc: -s: irvb")
  169.    tbl(options, argv, "a:svi:r")
  170.    every writes(" ", "  argv        " | !argv | "\n")
  171.  
  172.    write()
  173.    write("random:")            # random
  174.    gen(rand_num)
  175.    gen(rand_int, 20)
  176.    gen(randomize)
  177.    gen(randrange, 30, 50)
  178.    gen(randrangeseq, 52, 99)
  179.    gen(randseq, 1903)
  180.    gen(rng) 
  181.    gen(shuffle, "A23456789TJQK")
  182.  
  183.    write()
  184.    write("rational:")            # rational  (not part of core)
  185.    rat(str2rat, "(355/113)")
  186.    r1 := rat(real2rat, 355. / 113.)
  187.    gen(rat2str, r1)
  188.    gen(rat2real, r1)
  189.    r2 := rat(negrat, r1)
  190.    r3 := rat(reciprat, r1)
  191.    rat(addrat, r1, r3)
  192.    rat(subrat, r1, r3)
  193.    rat(mpyrat, r1, r2)
  194.    rat(divrat, r1, r3)
  195.    rat(medrat, rational(2,5,1), rational(11,7,1))
  196.    rat(medrat, rational(5,13,1), rational(4,5,1))
  197.    trat()
  198.  
  199.    write()
  200.    write("records:")            # records
  201.    gen(field, DateRec(), 7)
  202.    gen(fieldnum, DateRec(), "weekday")
  203.  
  204.    write()
  205.    write("scan:")            # scan
  206.  
  207.    write()
  208.    write("sets:")            # sets
  209.    stt(cset2set, &digits)
  210.    stt(domain, T)
  211.    tbl(inverse, T)
  212.    #   pairset, T    returns list of lists
  213.    stt(range, T)
  214.    stt(seteq, set([4, 7, 1]), set([7, 1, 4]))
  215.    stt(setlt, set([4, 7, 1]), set([7, 3, 1, 4]))
  216.    gen(simage, set(L))
  217.  
  218.    write()
  219.    write("sort:")            # sort
  220.    lst(isort, "Quoth The Raven: Nevermore", map)
  221.  
  222.    write()
  223.    write("strings:")            # strings
  224.    gen(cat, "abc", "def", "ghi")
  225.    gen(charcnt, "deinstitutionalization", 'aeiou')
  226.    gen(collate, "abcde", "12345")
  227.    gen(comb, "abcde", 3)
  228.    gen(compress,
  229.       "Mississippi bookkeeper unsuccessfully lobbies heedless committee")
  230.    gen(csort,    "sphinx of black quartz judge my vow")
  231.    gen(decollate,"saturday in the park")
  232.    gen(deletec,  "deinstitutionalization", 'aeiou')
  233.    gen(deletep,  "deinstitutionalization", [3, 4])
  234.    gen(deletes,  "deinstitutionalization", "ti")
  235.    gen(diffcnt,  "deinstitutionalization")
  236.    gen(extend,   "choco", 60)
  237.    gen(fchars,   "deinstitutionalization")
  238.    gen(interleave,"abcde", "123")
  239.    gen(ispal,    "abcdcba")
  240.    gen(maxlen,   ["quick", "brown", "fox", "jumped"])
  241.    gen(meander,  "abcd", 3)
  242.    gen(multicoll,["quick", "brown", "fox"])
  243.    gen(ochars,   "deinstitutionalization")
  244.    gen(odd_even, "31415926535")
  245.    gen(palins,   "abcd", 3)
  246.    gen(permutes, "abc")
  247.    gen(pretrim,  "   And in conclusion...")
  248.    gen(reflect,  "abc",  , "*")
  249.    gen(reflect,  "abc", 1, "*")
  250.    gen(reflect,  "abc", 2, "*")
  251.    gen(reflect,  "abc", 3, "*")
  252.    gen(replace,  "deinstitutionalization", "ti", "le")
  253.    gen(replacem, "deinstitutionalization", "ti", "le", "eon", "ine")
  254.    gen(replc,    "abc", [3, 1, 2])
  255.    gen(rotate,   "housecat", -3)
  256.    gen(schars,   "deinstitutionalization")
  257.    gen(scramble, "deinstitutionalization")
  258.    gen(selectp,  "deinstitutionalization", [3, 4, 6, 9, 11, 19])
  259.    gen(slugs,    "fly.me.to.the.moon.and.let.me.sing.among.the.stars", 11, '.')
  260.    gen(starseq,  "ab")
  261.    gen(strcnt,   "ti", "deinstitutionalization")
  262.    gen(substrings, "deinstitutionalization", 3, 3)
  263.    gen(transpose, "housecat", "12345678", "61785234")
  264.    gen(words,    "fly.me.to.the.moon.and.let.me.sing.among.the.stars", '.')
  265.  
  266.    write()
  267.    write("tables:")            # tables
  268.    lst(keylist, T)
  269.    lst(kvallist, T)
  270.    tbl(tbleq, T, copy(T))
  271.    tbl(tblunion, T, copy(T))
  272.    tbl(tblinter, T, copy(T))
  273.    tbl(tbldiff, T, copy(T))
  274.    tbl(tblinvrt, T)
  275.    lst(tbldflt, T)
  276.    tbl(twt, T)
  277.    lst(vallist, T)
  278.  
  279. end
  280.  
  281. procedure gen(p, a[])            #: test a simple procedure or generator
  282.    &random := 4747
  283.    writes(left(image(p)[11:0], LSIZE - 1))
  284.    every writes(" ", ((p ! a) \ GENLIMIT) | "\n")
  285.    return
  286. end
  287.  
  288. procedure lst(p, a[])            #: test a procedure that returns a list
  289.    local L
  290.  
  291.    L := (p ! a) | ["[FAILED]"]
  292.    writes(left(image(p)[11:0], LSIZE - 1))
  293.    every writes(" ", (!L \ GENLIMIT) | "\n")
  294.    return
  295. end
  296.  
  297. procedure stt(p, a[])            #: test a procedure that returns a set
  298.    local L
  299.  
  300.    L := sort(p ! a) | ["[FAILED]"]
  301.    writes(left(image(p)[11:0], LSIZE - 1), " {")
  302.    every writes(" ", (!L \ GENLIMIT) | "}\n")
  303.    return
  304. end
  305.  
  306. procedure tbl(p, a[])            #: test a procedure that returns a table
  307.    local k, T, L
  308.  
  309.    writes(left(image(p)[11:0] | "", LSIZE - 1))
  310.    if T := (p ! a) then {
  311.       L := sort(T, 3)
  312.       while writes(" ", get(L), ":", get(L))
  313.       write()
  314.       }
  315.    else
  316.       write("[FAILED]")
  317.    return \T
  318. end
  319.  
  320. procedure rat(p, a[])            #: test a procedure that rets a rational
  321.    local v
  322.    v := p ! a
  323.    write(left(image(p)[11:0], LSIZE), rat2str(\v) | ["[FAILED]"])
  324.    return \v
  325. end
  326.  
  327. procedure tfact(n)            #: test factorization of n
  328.    local D, F, P, i, v
  329.  
  330.    F := factors(n)
  331.    # every writes(" ", (n || ":") | !F | "\n")      # uncomment to show factors
  332.    v := 1
  333.    every v *:= !F
  334.    if v ~= n then
  335.       write("   ", n, ": PRODUCT OF FACTORS = ", v)
  336.  
  337.    F := set(F)
  338.    P := pfactors(n)
  339.    if *P ~= *F then
  340.       write("   ", n, ": PRIME FACTOR COUNT = ", *P)
  341.    every i := !P do
  342.       if not member(F, i) then
  343.          write("   ", n, ": MISSING PRIME FACTOR ", i)
  344.  
  345.    D := set()
  346.    every insert(D, divisors(n))
  347.    every i := 1 to n do
  348.       if member(D, i) then {
  349.          if n % i ~= 0 then write ("   ", n, ": BOGUS DIVISOR ", i)
  350.          }
  351.       else {
  352.          if n % i == 0 then write ("   ", n, ": MISSING DIVISOR ", i)
  353.          }
  354. end
  355.  
  356. procedure tprimes(n)            #: test the first n primes
  357.    local i, L1, L2, L3
  358.  
  359.    L1 := []
  360.    every i := seq() do {
  361.       if isprime(i) then {
  362.          put(L1, i)
  363.          if *L1 = n then break
  364.          }
  365.       }
  366.  
  367.    every put(L2 := [], prime() \ n)
  368.  
  369.    L3 := []
  370.    i := 1
  371.    while *L3 < n do
  372.       put(L3, i := nxtprime(i))
  373.  
  374.    every i := 1 to n do
  375.       if not (L1[i] = L2[i] = L3[i]) then
  376.          write("   PRIME ENTRY ", i, ":   ", L1[i], ", ", L2[i], ", ", L3[i])
  377. end
  378.  
  379. procedure trat()            #: test rational arithmetic
  380.    local r1, r2, L, n, d, r, g
  381.  
  382.    write("[testing conversions]")
  383.    L := [2, 3, 5, 7, 9, 17, 19, 27, 45, 63, 75, 81, 98, 99, 121, 175, 225]
  384.    every (n := !L) & (d := !L) do {
  385.       r := real2rat(n * (1. / d))
  386.       g := gcd(n, d)
  387.       if r.numer ~= n / g | r.denom ~= d / g then
  388.          write("   REAL2RAT: ", n, " / ", d, " => ", r.numer, " / ", r.denom)
  389.       }
  390. end
  391.