home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / mep1 / Samples / Programs / concordance.icn < prev    next >
Encoding:
Text File  |  1990-11-23  |  2.8 KB  |  95 lines  |  [TEXT/PICN]
  1. ############################################################################
  2. #
  3. #     This program produces a simple concordance to standard
  4. #  output. Words less than three chracters long are ignored.
  5. #
  6. #     There are two options:
  7. #
  8. #    -l n    set maximum line length to n (default 72), starts new line
  9. #    -w n    set maximum width for word to n (default to 12), truncates
  10. #
  11. #     There are lots of possibilities for improving this program and adding
  12. #  functionality to it. For example, a list of words to be ignored could be
  13. #  provided.  The formatting could be made more flexible, and so on.
  14. #
  15. ############################################################################
  16. #
  17. #     This program uses a table whose keys are strings and whose values are
  18. #  tables. In these tables, keys are line numbers and values are counts.
  19. #  This is a little elaborate, but it does the job.
  20. #
  21. #     Note that the program is organized to make it easy (via item()) to
  22. #  handle other kinds of tabulations.
  23. #
  24. ############################################################################
  25. #
  26. #  Caution: The programming technqiue used in this program requires a
  27. #           lot of memory. Do not attempt to use this program to produce
  28. #           a concordance of a large file.
  29. # 
  30. #############################################################################
  31. #
  32. #  Links: getopt
  33. #
  34. ############################################################################
  35.  
  36. link getopt
  37.  
  38. global uses, colmax, namewidth, lineno
  39.  
  40. procedure main(args)
  41.  
  42.    opts := getopt(args,"l+w+")[1]
  43.    colmax := \opts["l"] | 72
  44.    namewidth := \opts["w"] | 12
  45.  
  46.    uses := table()
  47.    lineno := 0
  48.  
  49.    every tabulate(item(line),lineno)
  50.  
  51.    uselist := sort(uses,3)        # sort by uses
  52.    while name := get(uselist) do {
  53.       line := left(name,namewidth)    # build up line numbers
  54.       numbers := sort(get(uselist),3)
  55.       while line ||:= get(numbers) do {
  56.          count := get(numbers)
  57.          if count = 1 then line ||:= ", "
  58.             else line ||:= "(" || count || "), "
  59.          }
  60.       format(line)    # output results in desired format
  61.       }
  62. end
  63.  
  64. procedure tabulate(name,lineno)
  65.    /uses[name] := table(0)
  66.    uses[name][lineno] +:= 1
  67. end
  68.  
  69. procedure format(line)
  70.    while *line > colmax + 2 do {
  71.       i := colmax + 2
  72.       until line[i -:= 1] == " "        # back off to break point
  73.       write(line[1:i])
  74.       line := repl(" ",namewidth) || line[i + 1:0]
  75.       }
  76.    write(line[1:-2])
  77. end
  78.  
  79. procedure item()
  80.  
  81.    name := getfile("File for concordance?") | fail
  82.    infile := open(name) | stop("*** cannot open ",name)
  83.    while line := read(infile) do {
  84.       lineno +:= 1
  85.       write(right(lineno,6),"  ",line)
  86.       line := map(line)                # fold to lowercase
  87.       i := 1
  88.       line ? while tab(upto(&letters)) do {
  89.          word := tab(many(&letters))
  90.          if *word < 3 then next            # skip short words
  91.          suspend word
  92.          }
  93.       }
  94. end
  95.