{*******************************************************************************
*                                                                              *
*  Simulationsprogramm fuer einen extrem redundanzarmen Textcodierer (Teil 2)  *
*                                                                              *
********************************************************************************
*                                                                              *
*  Verfasser : Dipl.-Ing. Jochen Meyer   Adresse : TH Darmstadt                *
*  Telefon   : 0 61 51 / 16 - 36 66                Institut fuer Datentechnik  *
*  Programm  : Netz                                Merckstr. 25                *
*  Datum     : 11.07.1988                          D-6100 Darmstadt            *
*                                                                              *
*******************************************************************************}

program netz(input, output, codefile) ;

  const
    textfilename = 'USRDSK2:[D93F]4_CODE_??.' ;
    netzfilename = 'USRDSK2:[D93F]5_NETZ_??.' ;

    verbindungen_max =   254 ; { (verbindungen_max+2)^2 >= Anzahl aller Zellen }
    zelle_hashteiler = 78643 ; { > 1,2 * Anzahl der Wortzellen }
    zelle_max_index  = zelle_hashteiler - 1 ;
    puffer_max_index =    10 ; { maximale Wortanzahl einer Gruppenzelle }
    inhaltsmax       =  1279 ; { 20 Bloecke mit inhaltstyp }
    verbindungsmax   =  1706 ; { 40 Bloecke mit verbindungstyp }
    zellenmax        =  1126 ; { 44 Bloecke mit zellentyp }

  type
    filenamentyp = packed array[1..24] of char ;

    inhaltszeiger     = ^inhaltstyp ;
    verbindungszeiger = ^verbindungstyp ;
    zellenzeiger      = ^zellentyp ;

    inhaltstyp = record
                   wort   : integer ;
                   zeiger : inhaltszeiger ;
                 end ;

    verbindungstyp = record
                       zelle  : zellenzeiger ;
                       dicke  : integer ;
                       zeiger : verbindungszeiger ;
                     end ;

    zellentyp = record
                  inhalt            : inhaltszeiger ;
                  wortanzahl        : integer ;
                  verbindung        : verbindungszeiger ;
                  verbindungsanzahl : integer ;
                  zeiger            : zellenzeiger ;
                end ;

    datentyp = record
                 durchgang,
                 wortzellen,
                 gruppenzellen,
                 woerter_max,
                 woerter,
                 verbindungen,
                 speicherplatz  : integer ;
                 netz_fertig    : boolean ;
               end ;

  var
    codefile : file of integer ;
    zelle    : array[0..zelle_max_index] of zellenzeiger ;
    daten    : datentyp ;
    ebene    : integer ;

  function filename(name : filenamentyp ; ebene : integer) : filenamentyp ;

    begin
      name[22] := chr(ebene div 10 + 48) ;
      name[23] := chr(ebene mod 10 + 48) ;
      filename := name ;
    end ;

  procedure baue_netz_auf(ebene : integer) ;

    const
      leer = maxint - 2 ;

    var
      puffer           : array[1..puffer_max_index] of integer ;
      freier_inhalt    : inhaltszeiger ;
      freie_verbindung : verbindungszeiger ;
      freie_zelle,
      vorgaenger,
      nachfolger       : zellenzeiger ;
      wortanzahl,
      code, i          : integer ;

    procedure loesche_netz ;

      var
        i : integer ;

      begin
        for i := 0 to zelle_max_index do
          zelle[i] := nil ;
        with daten do
          begin
            durchgang     := 0 ;
            wortzellen    := 0 ;
            gruppenzellen := 0 ;
            woerter_max   := 1 ;
            woerter       := 0 ;
            verbindungen  := 0 ;
            speicherplatz := zelle_hashteiler div 128 + 1 ;
          end ;
        freier_inhalt    := nil ;
        freie_verbindung := nil ;
        freie_zelle      := nil ;
      end ;

    procedure fuelle_puffer(wortanzahl : integer) ;

      var
        i, j : integer ;

      begin
        for i := 1 to (puffer_max_index - wortanzahl) do
          puffer[i] := puffer[i + wortanzahl] ;
        for j := (puffer_max_index - wortanzahl + 1) to puffer_max_index do
          case eof(codefile) of
            false : read(codefile, puffer[j]) ;
            true  : puffer[j] := leer ;
          end ;
      end ;

    procedure neuer_inhalt(var neu : inhaltszeiger) ;

      type
        inhaltsarray = [volatile] array[1..inhaltsmax] of inhaltstyp ;

      var
        inhalt : ^inhaltsarray ;
        i      : integer ;

      begin
        if (freier_inhalt = nil)
          then
            begin
              new(inhalt) ;
              freier_inhalt := address(inhalt^[1]) ;
              for i := 1 to (inhaltsmax - 1) do
                inhalt^[i].zeiger := address(inhalt^[i + 1]) ;
              inhalt^[inhaltsmax].zeiger := nil ;
              with daten do
                speicherplatz := speicherplatz + inhaltsmax div 64 + 1 ;
            end ;
        neu           := freier_inhalt ;
        freier_inhalt := neu^.zeiger ;
      end ;

    procedure neue_zelle(var neu : zellenzeiger) ;

      type
        zellenarray = [volatile] array[1..zellenmax] of zellentyp ;

      var
        zelle : ^zellenarray ;
        i     : integer ;

      begin
        if (freie_zelle = nil)
          then
            begin
              new(zelle) ;
              freie_zelle := address(zelle^[1]) ;
              for i := 1 to (zellenmax - 1) do
                zelle^[i].zeiger := address(zelle^[i + 1]) ;
              zelle^[zellenmax].zeiger := nil ;
              with daten do
                speicherplatz := speicherplatz + 5 * zellenmax div 128 + 1 ;
            end ;
        neu         := freie_zelle ;
        freie_zelle := neu^.zeiger ;
      end ;

    procedure isoliere_verbindung(var anfang, verbindung : verbindungszeiger) ;

      var
        vormerk : verbindungszeiger ;

      procedure suche_haeufigste_verbindung(zeig : verbindungszeiger ;
        var vormerk, merk : verbindungszeiger) ;

        var
          maximum : integer ;

        begin
          maximum := zeig^.dicke ;
          vormerk := nil ;
          merk    := zeig ;
          while (zeig^.zeiger <> nil) do
            begin
              with zeig^.zeiger^ do
                if (dicke > maximum)
                  then
                    begin
                      maximum := dicke ;
                      vormerk := zeig ;
                      merk    := zeig^.zeiger ;
                    end ;
              zeig := zeig^.zeiger ;
            end ;
        end ;

      begin
        suche_haeufigste_verbindung(anfang, vormerk, verbindung) ;
        case (vormerk = nil) of
          true  : anfang := anfang^.zeiger ;
          false : with vormerk^ do
                    zeiger := zeiger^.zeiger ;
        end ;
      end ;

    procedure suche_zelle(var zell : zellenzeiger ; var wortanzahl : integer) ;

      var
        zeig   : zellenzeiger ;
        hash,
        anzahl : integer ;

      procedure neue_wortzelle(var zelle : zellenzeiger) ;

        begin
          neue_zelle(zelle) ;
          with zelle^ do
            begin
              neuer_inhalt(inhalt) ;
              with inhalt^ do
                begin
                  wort   := puffer[1] ;
                  zeiger := nil ;
                end ;
              wortanzahl        := 1 ;
              verbindung        := nil ;
              verbindungsanzahl := 0 ;
              zeiger            := nil ;
            end ;
          with daten do
            begin
              wortzellen := wortzellen + 1 ;
              woerter    := woerter + 1 ;
            end ;
        end ;

      procedure teste_inhalt(inhalt : inhaltszeiger ;
        var wortanzahl : integer) ;

        begin
          wortanzahl := 1 ;
          repeat
            case (inhalt^.wort = puffer[wortanzahl]) of
              true  : begin
                        inhalt     := inhalt^.zeiger ;
                        wortanzahl := wortanzahl + 1 ;
                      end ;
              false : wortanzahl := 1 ;
            end ;
          until (inhalt = nil) or (wortanzahl = 1) ;
          wortanzahl := wortanzahl - 1 ;
        end ;

      begin
        hash := puffer[1] mod zelle_hashteiler ;
        case (zelle[hash] = nil) of
          true  : begin
                    neue_wortzelle(zelle[hash]) ;
                    zell       := zelle[hash] ;
                    wortanzahl := 1 ;
                  end ;
          false : begin
                    zeig := zelle[hash] ;
                    while (zeig^.inhalt^.wort <> puffer[1]) do
                      begin
                        if (zeig^.zeiger = nil)
                          then
                            neue_wortzelle(zeig^.zeiger) ;
                        zeig := zeig^.zeiger ;
                      end ;
                    wortanzahl := 0 ;
                    repeat
                      if (zeig^.wortanzahl > wortanzahl)
                        then
                          begin
                            teste_inhalt(zeig^.inhalt, anzahl) ;
                            if (anzahl > wortanzahl)
                              then
                                begin
                                  zell       := zeig ;
                                  wortanzahl := anzahl ;
                                end ;
                          end ;
                      zeig := zeig^.zeiger ;
                    until (zeig = nil) ;
                  end ;
        end ;
      end ;

    procedure verknuepfe_zellen(vorgaenger, nachfolger : zellenzeiger) ;

      var
        zeig : verbindungszeiger ;

      procedure neue_verbindung(var neu : verbindungszeiger ;
        var verbindungsanzahl : integer ; nachfolger : zellenzeiger) ;

        type
          verbindungsarray = [volatile] array[1..verbindungsmax] of
            verbindungstyp ;

        var
          verbindung : ^verbindungsarray ;
          i          : integer ;

        begin
          if (freie_verbindung = nil)
            then
              begin
                new(verbindung) ;
                freie_verbindung := address(verbindung^[1]) ;
                for i := 1 to (verbindungsmax - 1) do
                  verbindung^[i].zeiger := address(verbindung^[i + 1]) ;
                verbindung^[verbindungsmax].zeiger := nil ;
                with daten do
                  speicherplatz := speicherplatz +
                    3 * verbindungsmax div 128 + 1 ;
              end ;
          neu              := freie_verbindung ;
          freie_verbindung := neu^.zeiger ;
          with neu^ do
            begin
              zelle  := nachfolger ;
              dicke  := 0 ;
              zeiger := nil ;
            end ;
          verbindungsanzahl := verbindungsanzahl + 1 ;
          with daten do
            verbindungen  := verbindungen + 1 ;
        end ;

      procedure neue_gruppenzelle(vorgaenger : zellenzeiger) ;

        var
          nachfolger : verbindungszeiger ;
          zelle      : zellenzeiger ;

        procedure kombiniere_inhalt(var inhalt : inhaltszeiger ;
          var wortanzahl : integer ; vorgaenger, nachfolger : inhaltszeiger) ;

          var
            zeig : inhaltszeiger ;

          begin
            neuer_inhalt(inhalt) ;
            zeig       := inhalt ;
            zeig^.wort := vorgaenger^.wort ;
            vorgaenger := vorgaenger^.zeiger ;
            wortanzahl := 1 ;
            while (vorgaenger <> nil) do
              begin
                neuer_inhalt(zeig^.zeiger) ;
                zeig       := zeig^.zeiger ;
                zeig^.wort := vorgaenger^.wort ;
                vorgaenger := vorgaenger^.zeiger ;
                wortanzahl := wortanzahl + 1 ;
              end ;
            zeig^.zeiger := nachfolger ;
            while (nachfolger <> nil) do
              begin
                nachfolger := nachfolger^.zeiger ;
                wortanzahl := wortanzahl + 1 ;
              end ;
            with daten do
              begin
                if (wortanzahl > woerter_max)
                  then
                    woerter_max := wortanzahl ;
                woerter := woerter + wortanzahl ;
              end ;
          end ;

        begin
          with vorgaenger^ do
            begin
              isoliere_verbindung(verbindung, nachfolger) ;
              verbindungsanzahl := verbindungsanzahl - 1 ;
            end ;
          zelle := vorgaenger ;
          while (zelle^.zeiger <> nil) do
            zelle := zelle^.zeiger ;
          neue_zelle(zelle^.zeiger) ;
          with zelle^.zeiger^ do
            begin
              kombiniere_inhalt(inhalt, wortanzahl, vorgaenger^.inhalt,
                nachfolger^.zelle^.inhalt) ;
              verbindung        := nil ;
              verbindungsanzahl := 0 ;
              zeiger            := nil ;
            end ;
          nachfolger^.zeiger := freie_verbindung ;
          freie_verbindung   := nachfolger ;
          with daten do
            begin
              gruppenzellen := gruppenzellen + 1 ;
              verbindungen  := verbindungen - 1 ;
              netz_fertig   := false ;
            end ;
        end ;

      begin
        with vorgaenger^ do
          case (verbindung = nil) of
            true  : begin
                      neue_verbindung(verbindung, verbindungsanzahl,
                        nachfolger) ;
                      verbindung^.dicke := 1 ;
                    end ;
            false : begin
                      zeig := verbindung ;
                      while (zeig^.zelle <> nachfolger) do
                        begin
                          if (zeig^.zeiger = nil)
                            then
                              neue_verbindung(zeig^.zeiger, verbindungsanzahl,
                                nachfolger) ;
                          zeig := zeig^.zeiger ;
                        end ;
                      with zeig^ do
                        dicke := dicke + 1 ;
                      if (verbindungsanzahl > verbindungen_max)
                        then
                          neue_gruppenzelle(vorgaenger) ;
                    end ;
          end ;
      end ;

    procedure loesche_verbindungen ;

      var
        zell : zellenzeiger ;
        zeig : verbindungszeiger ;
        i    : integer ;

      begin
        for i := 0 to zelle_max_index do
          begin
            zell := zelle[i] ;
            while (zell <> nil) do
              begin
                with zell^ do
                  if (verbindung <> nil)
                    then
                      begin
                        zeig := verbindung ;
                        while (zeig^.zeiger <> nil) do
                          zeig := zeig^.zeiger ;
                        zeig^.zeiger      := freie_verbindung ;
                        freie_verbindung  := verbindung ;
                        verbindung        := nil ;
                        verbindungsanzahl := 0 ;
                      end ;
                zell := zell^.zeiger ;
              end ;
          end ;
        daten.verbindungen := 0 ;
      end ;

    procedure bearbeite_netz ;

      var
        zeig      : zellenzeiger ;
        nummer, i : integer ;

      procedure sortiere_verbindungen(var verbindung : verbindungszeiger ;
        var haeufigkeit : integer) ;

        var
          anfang, ende : verbindungszeiger ;

        begin
          haeufigkeit := 0 ;
          if (verbindung <> nil)
            then
              begin
                anfang := verbindung ;
                isoliere_verbindung(anfang, verbindung) ;
                ende        := verbindung ;
                haeufigkeit := ende^.dicke ;
                while (anfang <> nil) do
                  begin
                    isoliere_verbindung(anfang, ende^.zeiger) ;
                    ende        := ende^.zeiger ;
                    haeufigkeit := haeufigkeit + ende^.dicke ;
                  end ;
              end ;
        end ;

      procedure sortiere_zellen(var zelle : zellenzeiger ;
        var nummer : integer) ;

        var
          anfang, ende : zellenzeiger ;

        procedure isoliere_zelle(var anfang, zelle : zellenzeiger) ;

          var
            vormerk : zellenzeiger ;

          procedure suche_haeufigste_zelle(zeig : zellenzeiger ;
            var vormerk, merk : zellenzeiger) ;

            var
              maximum : integer ;

            begin
              maximum := zeig^.verbindungsanzahl ;
              vormerk := nil ;
              merk    := zeig ;
              while (zeig^.zeiger <> nil) do
                begin
                  with zeig^.zeiger^ do
                    if (verbindungsanzahl > maximum)
                      then
                        begin
                          maximum := verbindungsanzahl ;
                          vormerk := zeig ;
                          merk    := zeig^.zeiger ;
                        end ;
                  zeig := zeig^.zeiger ;
                end ;
            end ;

          begin
            suche_haeufigste_zelle(anfang, vormerk, zelle) ;
            case (vormerk = nil) of
              true  : anfang := anfang^.zeiger ;
              false : with vormerk^ do
                        zeiger := zeiger^.zeiger ;
            end ;
          end ;

        begin
          if (zelle <> nil)
            then
              begin
                anfang := zelle ;
                isoliere_zelle(anfang, zelle) ;
                ende             := zelle ;
                ende^.wortanzahl := nummer ;
                nummer           := nummer + 1 ;
                while (anfang <> nil) do
                  begin
                    isoliere_zelle(anfang, ende^.zeiger) ;
                    ende             := ende^.zeiger ;
                    ende^.wortanzahl := nummer ;
                    nummer           := nummer + 1 ;
                  end ;
              end ;
        end ;

      begin
        nummer := 1 ;
        for i := 0 to zelle_max_index do
          begin
            zeig := zelle[i] ;
            while (zeig <> nil) do
              begin
                with zeig^ do
                  sortiere_verbindungen(verbindung, verbindungsanzahl) ;
                zeig := zeig^.zeiger ;
              end ;
            sortiere_zellen(zelle[i], nummer) ;
          end ;
      end ;

    procedure zeige_statistik ;

      begin
        with daten do
          begin
            writeln('|') ;
            write('|  Groesse des Netzes                   :') ;
            writeln((wortzellen + gruppenzellen + 1): 7, '   Zellen') ;
            write('|  Gruppenzellen/Wortzellen             :') ;
            writeln((gruppenzellen / wortzellen): 9: 1) ;
            if (gruppenzellen > 0)
              then
                begin
                  write('|  Woerter pro Zelle (Maximalwert)      :') ;
                  writeln(woerter_max: 7) ;
                  write('|  Woerter pro Zelle (Mittelwert)       :') ;
                  writeln((woerter / (wortzellen + gruppenzellen)): 9: 1) ;
                end ;
            write('|  Verbindungen pro Zelle (Maximalwert) :') ;
            writeln(verbindungen_max: 7) ;
            write('|  Verbindungen pro Zelle (Mittelwert)  :') ;
            writeln((verbindungen / (wortzellen + gruppenzellen)): 9: 1) ;
            write('|  Belegter Arbeitsspeicher             :') ;
            writeln(speicherplatz: 7, '   Seiten') ;
          end ;
      end ;

    begin
      writeln('|') ;
      writeln('+------------------------------------------------------------') ;
      writeln('|') ;
      writeln('|  Ich baue das Netz der ', ebene: 1, '-ten Ebene auf !') ;
      writeln('|') ;
      with daten do
        begin
          loesche_netz ;
          open(codefile, filename(textfilename, ebene), history := old) ;
          repeat
            durchgang   := durchgang + 1 ;
            netz_fertig := true ;
            reset(codefile) ;
            for i := 0 to ebene do
              read(codefile, code) ;
            fuelle_puffer(puffer_max_index) ;
            suche_zelle(vorgaenger, wortanzahl) ;
            fuelle_puffer(wortanzahl) ;
            if (puffer[1] <> leer)
              then
                begin
                  repeat
                    suche_zelle(nachfolger, wortanzahl) ;
                    verknuepfe_zellen(vorgaenger, nachfolger) ;
                    fuelle_puffer(wortanzahl) ;
                    vorgaenger := nachfolger ;
                  until (puffer[1] = leer) ;
                  case netz_fertig of
                    false : loesche_verbindungen ;
                    true  : bearbeite_netz ;
                  end ;
                end ;
            writeln('|  ', durchgang: 1, '-ter Lese-Durchgang beendet !') ;
          until netz_fertig ;
          close(codefile) ;
          zeige_statistik ;
        end ;
    end ;

  procedure schreibe_netz(ebene : integer) ;

    const
      trennsymbol = maxint ;

    var
      zeig : zellenzeiger ;
      i    : integer ;

    procedure schreibe_nachfolgerliste ;

      type
        nachfolgerarray = array[1..verbindungen_max] of zellenzeiger ;

      var
        nachfolger : nachfolgerarray ;
        zeig       : zellenzeiger ;
        i, j, k    : integer ;

      procedure sortiere_zelle_ein(zelle : zellenzeiger ;
        var nachfolger : nachfolgerarray) ;

        const
          ausserhalb = verbindungen_max + 1 ;

        var
          unten, mitte, oben, i : integer ;

        begin
          unten := 1 ;
          mitte := verbindungen_max ;
          oben  := ausserhalb ;
          repeat
            case (nachfolger[mitte] = nil) of
              true  : oben := mitte ;
              false : case (zelle^.verbindungsanzahl >
                        nachfolger[mitte]^.verbindungsanzahl) of
                        true  : oben  := mitte ;
                        false : unten := mitte ;
                      end ;
            end ;
            mitte := (unten + oben) div 2 ;
          until (mitte = unten) ;
          if (oben <> ausserhalb)
            then
              begin
                if (nachfolger[unten] <> nil)
                  then
                    if (zelle^.verbindungsanzahl <=
                      nachfolger[unten]^.verbindungsanzahl)
                      then
                        mitte := oben ;
                for i := verbindungen_max downto (mitte + 1) do
                  nachfolger[i] := nachfolger[i - 1] ;
                nachfolger[mitte] := zelle ;
              end ;
        end ;

      begin
        for i := 1 to verbindungen_max do
          nachfolger[i] := nil ;
        for j := 0 to zelle_max_index do
          begin
            zeig := zelle[j] ;
            while (zeig <> nil) do
              begin
                sortiere_zelle_ein(zeig, nachfolger) ;
                zeig := zeig^.zeiger ;
              end ;
          end ;
        write(codefile, trennsymbol) ;
        for k := 1 to verbindungen_max do
          if (nachfolger[k] <> nil)
            then
              write(codefile, nachfolger[k]^.wortanzahl) ;
        write(codefile, trennsymbol) ;
      end ;

    procedure schreibe_zelle(zelle : zellenzeiger) ;

      begin
        with zelle^ do
          begin
            while (inhalt <> nil) do
              begin
                write(codefile, inhalt^.wort) ;
                inhalt := inhalt^.zeiger ;
              end ;
            write(codefile, trennsymbol) ;
            while (verbindung <> nil) do
              begin
                write(codefile, verbindung^.zelle^.wortanzahl) ;
                verbindung := verbindung^.zeiger ;
              end ;
            write(codefile, trennsymbol) ;
          end ;
      end ;

    begin
      writeln('|') ;
      write('|  Ich schreibe das Netz der ', ebene: 1) ;
      writeln('-ten Ebene auf Platte !') ;
      open(codefile, filename(netzfilename, ebene), history := new) ;
      rewrite(codefile) ;
      write(codefile, verbindungen_max) ;
      schreibe_nachfolgerliste ;
      for i := 0 to zelle_max_index do
        begin
          zeig := zelle[i] ;
          while (zeig <> nil) do
            begin
              schreibe_zelle(zeig) ;
              zeig := zeig^.zeiger ;
            end ;
        end ;
      close(codefile) ;
    end ;

  begin
    writeln ;
    writeln('+------------------------------------------------------------') ;
    writeln('|') ;
    writeln('|  Extrem redundanzarmer Textcodierer (Teil 2: NETZ)') ;
    writeln('|') ;
    repeat
      write('|  Welche Ebene soll ich bearbeiten ? [1..23] ') ;
      readln(ebene) ;
      writeln ;
    until (ebene in [1..23]) ;
    baue_netz_auf(ebene) ;
    with daten do
      if ((wortzellen + gruppenzellen) < sqr(verbindungen_max + 2))
        then
          schreibe_netz(ebene) ;
    writeln('|') ;
    writeln('+------------------------------------------------------------') ;
    writeln ;
  end .