MODULE--------------------------------------------------------------- sorting ---; IMPORT Pathname, Fmt, Text, Wr, FileWr, FilePath, OSError, FSUtils; FROM Msg IMPORT M, D, F; TYPE Node = RECORD key : TEXT := NIL; name : TEXT := NIL; count : INTEGER := 0; start : INTEGER := 0; END; TYPE State = RECORD base_wr : Wr.T; file : TEXT; title : TEXT; limit : INTEGER; next_id : INTEGER; max_len : INTEGER; n_elts : INTEGER; elts : REF ARRAY OF Node; END; PROCEDURE HTMLDir GenDir (READONLY names: ARRAY OF TEXT; wr: Wr.T; file, title: TEXT; limit: INTEGER) = VAR s: State; BEGIN s.base_wr := wr; s.file := file; s.title := title; s.limit := limit; s.next_id := 1; D("GenDir ", file); (* build the initial sorted list of nodes *) s.elts := NEW (REF ARRAY OF Node, NUMBER (names)); FOR i := 0 TO LAST (names) DO WITH x = s.elts[i] DO x.name := names[i]; x.key := Pathname.LastBase (names[i]); x.count := 0; x.start := 0; D(" ", x.name, ", ", x.key); END; END; Sort (s.elts^); (* Find and remove entries with duplicate keys *) s.n_elts := 0; VAR i := 0; BEGIN WHILE (i < NUMBER (s.elts^)) DO VAR j := i+1; BEGIN WHILE (j < NUMBER (s.elts^)) AND Text.Equal (s.elts[i].key, s.elts[j].key) DO INC (j); END; IF (j - i > 1) THEN RemoveDuplicates (s, i, j-i); END; IF (i # s.n_elts) THEN s.elts[s.n_elts] := s.elts[i]; END; INC (s.n_elts); i := j; END; END; END; (* find the length of the longest key *) s.max_len := 0; FOR i := 0 TO s.n_elts-1 DO s.max_len := MAX (s.max_len, Text.Length (s.elts[i].key)); END; EVAL Generate (s, 0, 0, s.n_elts, 0); s.elts := NIL; END GenDir; PROCEDURERemoveDuplicates (VAR s: State; start, len: INTEGER) = <*FATAL ANY*> VAR file := FName (s, s.next_id); wr : FileWr.T; key := s.elts[start].key; BEGIN WITH dir = Pathname.Prefix(file) DO IF dir # NIL THEN IF NOT FSUtils.IsDir(dir) THEN FSUtils.MakeDir(dir); END; END; END; TRY wr := FileWr.Open (file & ".html"); EXCEPT ELSE F("cannot open ", file & ".html"); END; INC (s.next_id); Out (wr, "<HTML>\n<HEAD>\n<TITLE>", key, " locations</TITLE>\n</HEAD>\n"); Out (wr, "<BODY bgcolor=\"#ffffff\">\n<H2>", key, " is located in:<H2>\n<UL>\n"); FOR i := start TO start + len - 1 DO VAR nm := s.elts[i].name; BEGIN Out (wr, "<LI><A HREF=\"", FilePath.Normalize (nm, file), ".html\">"); Out (wr, nm, "</A>\n"); END; END; Out (wr, "</UL>\n</BODY>\n</HTML>\n"); Wr.Close (wr); s.elts[start].name := file; END RemoveDuplicates; PROCEDUREGenerate (VAR s: State; id, start, cnt, prefix: INTEGER): TEXT = VAR cnt0, cnt1, len: INTEGER; file := FName (s, id); BEGIN D("Generate ", file, ", " & Fmt.Int(id), ", " & Fmt.Int(start), ", " & Fmt.Int(cnt), ", " & Fmt.Int(prefix)); (* count the elements with the specified prefix length *) len := prefix; cnt1 := CntPrefixes (s, start, cnt, len); (* find a prefix that generates a non-trivial choice *) WHILE (len <= s.max_len) AND (cnt1 < 2) DO INC (len); cnt1 := CntPrefixes (s, start, cnt, len); END; (* find the largest prefix that's got fewer than limit classes *) REPEAT INC (len); cnt0 := cnt1; cnt1 := CntPrefixes (s, start, cnt, len); UNTIL (len >= s.max_len) OR (cnt1 > s.limit); (* pick the best size *) IF (s.limit - cnt0 <= cnt1 - s.limit) THEN (* use the shorter prefix *) DEC (len); cnt1 := CntPrefixes (s, start, cnt, len); END; (* generate the smaller, non-trivial partitions *) FOR i := start TO start+cnt-1 DO IF s.elts[i].count > 1 THEN VAR id := s.next_id; start := s.elts[i].start; count := s.elts[i].count; name : TEXT; BEGIN INC (s.next_id); name := Generate (s, id, start, count, len+1); ResetElts (s, start, count, i, name); END; END; END; (* generate my elements *) WriteDir (s, file, start, cnt, len); RETURN file; END Generate; PROCEDURECntPrefixes (VAR s: State; start, cnt, len: INTEGER): INTEGER = VAR n_classes := 1; class := start; c_len := Text.Length (s.elts[start].key); BEGIN s.elts[start].count := 1; s.elts[start].start := start; FOR i := start + 1 TO start + cnt - 1 DO IF PrefixMatch (s.elts[class].key, s.elts[i].key, len) THEN INC (s.elts[class].count); IF (c_len < len) AND (c_len < Text.Length (s.elts[i].key)) THEN (* move the class rep *) s.elts[i].count := s.elts[class].count; s.elts[i].start := s.elts[class].start; s.elts[class].count := 0; class := i; END; ELSE INC (n_classes); class := i; c_len := Text.Length (s.elts[i].key); s.elts[i].count := 1; s.elts[i].start := i; END; END; RETURN n_classes; END CntPrefixes; PROCEDUREResetElts (VAR s: State; start, count, base: INTEGER; file: TEXT) = BEGIN FOR i := start TO start + count -1 DO s.elts[i].count := 0; END; s.elts[base].count := count; s.elts[base].start := start; s.elts[base].name := file; END ResetElts; PROCEDUREWriteDir (VAR s: State; file: TEXT; start, cnt, len: INTEGER) = <*FATAL ANY*> CONST Dir_width = 78; (* max # characters per line *) CONST Max_cols = 6; (* max # columns per line *) CONST Gap = 2; (* inter-column gap *) CONST Gap_text = " "; VAR max_len := 0; n_cols := 1; width : CARDINAL; n_rows : CARDINAL; j : CARDINAL; nm : TEXT; nm_len : INTEGER; elts := NEW (REF ARRAY OF INTEGER, cnt); n_elts := 0; wr : Wr.T; base_file : TEXT; BEGIN D("WriteDir ", file); (* find the longest name and pack the elements *) FOR i := start TO start+cnt-1 DO VAR n := s.elts[i].count; BEGIN IF n > 0 THEN elts[n_elts] := i; INC (n_elts); IF n = 1 THEN max_len := MAX (max_len, Text.Length (s.elts[i].key)); ELSE max_len := MAX (max_len, len+3); END; END; END; END; (* compute an approriate layout *) max_len := MAX (5, max_len); INC (max_len, Gap); n_cols := MAX (1, MIN (Dir_width DIV max_len, Max_cols)); n_rows := (n_elts + n_cols - 1) DIV n_cols; width := Dir_width DIV n_cols - Gap; IF (file = NIL) THEN base_file := ""; wr := s.base_wr; ELSE base_file := file; WITH dir = Pathname.Prefix(file) DO IF dir # NIL THEN IF NOT FSUtils.IsDir(dir) THEN FSUtils.MakeDir(dir); END; END; END; TRY wr := FileWr.Open (file & ".html"); EXCEPT OSError.E => M("cannot open file ", file & ".html"); RETURN; END; Out (wr, "<HTML>\n<HEAD>\n<TITLE>", s.title, "</TITLE>\n</HEAD>\n<BODY bgcolor=\"#ffffff\">\n"); END; Out (wr, "<PRE>\n"); FOR row := 0 TO n_rows-1 DO FOR col := 0 TO n_cols-1 DO j := col * n_rows + row; IF (j < n_elts) THEN WITH x = s.elts[elts[j]] DO Out (wr, "<A HREF=\"", FilePath.Normalize (x.name, base_file), ".html\">"); nm := x.key; nm_len := Text.Length (nm); IF (x.count > 1) THEN VAR xxx := MIN (FindMaxLen (s, elts[j], len), width-4); BEGIN IF (nm_len > xxx) THEN nm := Text.Sub (nm, 0, xxx); nm_len := xxx; END; END; Out (wr, nm, "..."); INC (nm_len, 3); ELSE Out (wr, nm); END; END; Out (wr, "</A>"); IF (col # n_cols-1) THEN (* pad to the next column *) FOR x := 1 TO width - nm_len DO Out (wr, " "); END; END; Out (wr, Gap_text); END; END; Out (wr, "\n"); END; Out (wr, "</PRE>\n"); IF (file # NIL) THEN Out (wr, "</BODY>\n</HTML>\n"); Wr.Close (wr); END; END WriteDir; PROCEDUREFindMaxLen (VAR s: State; base, len: INTEGER): INTEGER = VAR start := s.elts[base].start; cnt := s.elts[base].count; key := s.elts[base].key; max := Text.Length (key); BEGIN WHILE (len < max) DO INC (len); FOR i := start TO start + cnt - 1 DO IF NOT PrefixMatch (s.elts[i].key, key, len) THEN RETURN len-1 END; END; END; RETURN len; END FindMaxLen; PROCEDUREPrefixMatch (a, b: TEXT; len: INTEGER): BOOLEAN = VAR min := MIN (MIN (Text.Length (a), Text.Length (b)), len); BEGIN FOR i := 0 TO min-1 DO IF Text.GetChar (a, i) # Text.GetChar (b, i) THEN RETURN FALSE END; END; RETURN (min = len); END PrefixMatch; PROCEDUREOut (wr: Wr.T; a, b, c, d: TEXT := NIL) = <*FATAL ANY*> BEGIN IF (a # NIL) THEN Wr.PutText (wr, a); END; IF (b # NIL) THEN Wr.PutText (wr, b); END; IF (c # NIL) THEN Wr.PutText (wr, c); END; IF (d # NIL) THEN Wr.PutText (wr, d); END; END Out;
TYPE Elem_T = Node; PROCEDUREElem_Compare (a, b: Node): [-1..1] = BEGIN RETURN Text.Compare (a.key, b.key); END Elem_Compare; PROCEDURESort (VAR a: ARRAY OF Elem_T; cmp := Elem_Compare) = BEGIN QuickSort (a, 0, NUMBER (a), cmp); InsertionSort (a, 0, NUMBER (a), cmp); END Sort; PROCEDUREQuickSort (VAR a: ARRAY OF Elem_T; lo, hi: INTEGER; cmp := Elem_Compare) = CONST CutOff = 9; VAR i, j: INTEGER; key, tmp: Elem_T; BEGIN WHILE (hi - lo > CutOff) DO (* sort a[lo..hi) *) (* use median-of-3 to select a key *) i := (hi + lo) DIV 2; IF cmp (a[lo], a[i]) < 0 THEN IF cmp (a[i], a[hi-1]) < 0 THEN key := a[i]; ELSIF cmp (a[lo], a[hi-1]) < 0 THEN key := a[hi-1]; a[hi-1] := a[i]; a[i] := key; ELSE key := a[lo]; a[lo] := a[hi-1]; a[hi-1] := a[i]; a[i] := key; END; ELSE (* a[lo] >= a[i] *) IF cmp (a[hi-1], a[i]) < 0 THEN key := a[i]; tmp := a[hi-1]; a[hi-1] := a[lo]; a[lo] := tmp; ELSIF cmp (a[lo], a[hi-1]) < 0 THEN key := a[lo]; a[lo] := a[i]; a[i] := key; ELSE key := a[hi-1]; a[hi-1] := a[lo]; a[lo] := a[i]; a[i] := key; END; END; (* partition the array *) i := lo+1; j := hi-2; (* find the first hole *) WHILE cmp (a[j], key) > 0 DO DEC (j) END; tmp := a[j]; DEC (j); LOOP IF (i > j) THEN EXIT END; WHILE cmp (a[i], key) < 0 DO INC (i) END; IF (i > j) THEN EXIT END; a[j+1] := a[i]; INC (i); WHILE cmp (a[j], key) > 0 DO DEC (j) END; IF (i > j) THEN IF (j = i-1) THEN DEC (j) END; EXIT END; a[i-1] := a[j]; DEC (j); END; (* fill in the last hole *) a[j+1] := tmp; i := j+2; (* then, recursively sort the smaller subfile *) IF (i - lo < hi - i) THEN QuickSort (a, lo, i-1); lo := i; ELSE QuickSort (a, i, hi); hi := i-1; END; END; (* WHILE (hi-lo > CutOff) *) END QuickSort; PROCEDUREInsertionSort (VAR a: ARRAY OF Elem_T; lo, hi: INTEGER; cmp := Elem_Compare) = VAR j: INTEGER; key: Elem_T; BEGIN FOR i := lo+1 TO hi-1 DO key := a[i]; j := i-1; WHILE (j >= lo) AND cmp (key, a[j]) < 0 DO a[j+1] := a[j]; DEC (j); END; a[j+1] := key; END; END InsertionSort; PROCEDUREFName (VAR s: State; id: INTEGER): TEXT = BEGIN IF (id = 0) THEN RETURN NIL; END; RETURN Fmt.F ("%s_%s", s.file, Fmt.Int (id)); END FName; BEGIN END HTMLDir.