unit a2_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ComCtrls;

type
  BigNumber=array of integer;
  TPermutation=array of cardinal;
  TPartFunction=function (const part:TPermutation;const data:pointer):boolean;
  TForm1 = class(TForm)
    folge: TEdit;                //Eingabefeld für die gebaute Folge von Übungen
    count: TButton;              //Button zum Zählen aller Möglichkeiten
    list: TButton;               //Button zum Auflisten aller Möglichkeiten
    calculatedCount: TEdit;      //Ausgabefeld für die Anzahl
    possibilities: TMemo;        //Ausgabefeld für die Möglichkeiten
    ProgressBar1: TProgressBar;  //Fortschrittsanzeige während der Berechnung
    fromFile: TRadioButton;      //gibt der Wert in folge eine Datei an
    direct: TRadioButton;        //  oder eine Folge
    Title: TLabel;               //design
    Label1: TLabel;              //design
    procedure listClick(Sender: TObject);
    procedure countClick(Sender: TObject);
    procedure directClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
const BASE=1000000000;

//=========================Zählen aller Teilfolgen==============================
{ Addiert zwei Zahlen n1 und n2 gleicher Länge und speichert das Ergebnis in n1

(*) Notationen
             n1[i]         =  i-te Ziffer von n1 (n1[0] ist die höchstwertige)
             n2[i]         =  i-te Ziffer von n2 (n2[0] ist die höchstwertige)
             n1#[i]        =  i-te Ziffer von n1, vor Aufruf der Funktion
             n1'[i]        =  i-te Ziffer von n1, nach der nächsten Anweisung
             length(n1)    =  Anzahl der Ziffern in n1
             length(n2)    =  Anzahl der Ziffern in n2     (wie bei Arrays)
             length(n1)    =  m + 1
             BASE          = 1000000000 = Die verwendete Zahlenbasis

(*) Annahme:1. length(n1')        =  length(n2) = length(overflow)
            2. 0  <=  n1'[i]      <= BASE - 1 für alle i
            3. 0  <=  n2[i]       <= BASE - 1 für alle i
            4. n1#[0] + n2[0] + 1 <  BASE


(*) Gewünschtes Ergebnis:
     1. SUMME_i=0^m(n1'[i]*BASE^(m-i)) =  SUMME(n1#[i]*BASE^(m-i)) + SUMME(n2[i]*BASE^(m-i))     //TODO: Summenzeichen
     2. 0  <=  n1'[i]  <=  BASE - 1 für alle i
}
procedure add(n1:BigNumber;const n2:BigNumber);
var i:integer;
    overflow: boolean;
begin
  overflow:=false;
  for i:=high(n1){m} downto 0 do begin
    { n1[i] = n1#[i], da nur die Ziffern n[j] mit j > i verändert wurden. }
    if overflow then begin //Fall 1: overflow  = true
       {Voraussetzung:
          SUMME_k=i+1^m(n1[k]*BASE^(m-k)) = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) + SUMME_k=i+1^m(n2[k]*BASE^(m-k))-BASE^(m-i)

         (erfüllt durch letzten Schleifendurchlauf)
       }
       n1[i]:=n1[i]+n2[i]+1
       { Folgen der letzten Anweisung:
          SUMME_k=i^m(n1[k]*BASE^(m-k))
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + n1[i]*BASE^(m-i)             | Zerlegung der Summe
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + (n1#[i] + n2[i] + 1) *BASE^(m-i) | Zuweisung einsetzen
          = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) + SUMME_k=i+1^m(n2[k]*BASE^(m-k))-BASE^(m-i) + (n1#[i] + n2[i] + 1) *BASE^(m-i) | Vorraussetzung einfügen
          = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k)) | Summen zusammenfassen

         Es ist nicht garantiert, dass n1#[i] + n2[i] + 1 < BASE, also kann nun
         gelten: n1[i] >= BASE
         Da n1#[i] >= 0 und n2[i] >= 0 ist auch n1[i] >= 0.
       }
    end else begin         //Fall 2: overflow  = false
      {Voraussetzung:
         SUMME_k=i+1^m(n1[i]*BASE^(m-i)) = SUMME_k=i+1^m(n1#[i]*BASE^(m-i)) + SUMME_k=i+1^m(n2[i]*BASE^(m-i))

         (im ersten Durchlauf sind beide Seiten 0, da dann i+1>m, ansonsten ist
          sie durch den letzten Schleifendurchlauf erfüllt)
      }
      n1[i]:=n1[i]+n2[i];
       { Folgen der letzten Anweisung:
          SUMME_k=i^m(n1[k]*BASE^(m-k))
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + n1[i]*BASE^(m-i)             | Zerlegung der Summe
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + (n1#[i] + n2[i]) *BASE^(m-i) | Zuweisung einsetzen
          = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) + SUMME_k=i+1^m(n2[k]*BASE^(m-k))-BASE^(m-i) + (n1#[i] + n2[i]) *BASE^(m-i) | Vorraussetzung einfügen
          = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k)) | Summen zusammenfassen

         Es ist nicht garantiert, dass n1#[i] + n2[i] + 1 < BASE, also kann nun
         gelten: n1[i] >= BASE
         Da n1#[i] >= 0 und n2[i] >= 0 ist auch n1[i] >= 0.
       }
    end;
    { Es gilt nun:
      SUMME_k=i^m(n1[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))

      Möglicherweise ist aber n1[i] >= BASE
    }
    if n1[i]<BASE then begin
      {
        Da n1[i] < BASE ist, sind die an das Ergebnis gestellten Bedingungen erfüllt.
      }
      overflow:=false
      {
        Da nun overflow=false ist, wird nun im nächsten Durchlauf Fall 2 eintreten,
        und die dort beschriebene Vorraussetzung ist erfüllt.
      }
    end else begin
      { Es gilt: n1[i] >= BASE.

        Entweder ist n1[i] = n1#[i] + n2[i] oder n1[i] = n1'[i] + n2[i] + 1,
        es gilt also n1[i] <= n1'[i] + n2[i] + 1.
        Aus n1'[i] <= BASE - 1 und n2[i] <= BASE - 1 (muss beim Funktionsaufruf
        gelten, s.o) folgt: n1[i] <= n1'[i] + n2[i] + 1. <= BASE - 1 + BASE - 1 + 1
        = 2* BASE - 1}

      { Da n1[i] <= 2*BASE - 1 ist n1[i] - BASE <= BASE - 1.
        Da n1[i] >= BASE ist n1[i] - BASE >= 0

        Die zweite an das Ergebnis gestellt Bedingung ist also für n1'[i].

        Für die Summe gilt dann:
           SUMME_k=i^m(n1[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))
       <=> n1[i]*BASE^(m-k) + SUMME_k=i+1^m(n1[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))
       <=> (n1'[i]+BASE)*BASE^(m-i) + SUMME_k=i+1^m(n1[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))
       <=> n1'[i]*BASE*(m-i) + 4BASE^(m-i+1) + SUMME_k=i+1^m(n1[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))
       <=> BASE^(m-i+1) + SUMME_k=i^m(n1'[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k))
       <=> SUMME_k=i^m(n1'[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k)) - BASE^(m-i+1)
       <=> SUMME_k=i^m(n1'[k]*BASE^(m-k)) = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k)) - BASE^(m-(i-1))

       Das heißt das im näcshten Durchlauf, wenn i' = i-1 ist, die Vorraussetung für Fall 2 erfüllt ist
      }
      n1[i]:=n1[i]-BASE;  //Vorraussetzungen erfüllen (s.o)
      overflow:=true;     //Fall 2 eintreten lassen
    end;
  end;

  {
    Da nach Annahme 4 gilt n1#[0] + n2[0] + 1 < BASE gilt, ist overflow = false.
    Das heißt, dass die Vorraussetzung aus Fall 2 gilt, und das ist gerade die
    an das Ergebnis gestellte Bedingung. (Wenn man die jetztige Situation als
    Schleifenanfang mit i=-1 betrachtet).
  }
end;

{ Subtrahiert zwei Zahlen mit gleicher Länge
(*) Notationen
             n1[i]         =  i-te Ziffer von n1 (n1[0] ist die höchstwertige)
             n2[i]         =  i-te Ziffer von n2 (n2[0] ist die höchstwertige)
             n1#[i]        =  i-te Ziffer von n1, vor Aufruf der Funktion
             n1'[i]        =  i-te Ziffer von n1, nach der nächsten Anweisung
             length(n1)    =  Anzahl der Ziffern in n1
             length(n2)    =  Anzahl der Ziffern in n2     (wie bei Arrays)
             length(n1)    =  m + 1
             BASE          = 1000000000 = Die verwendete Zahlenbasis

(*) Annahme:1. length(n1')        =  length(n2) = length(overflow)
            2. 0  <=  n1'[i]      <= BASE - 1 für alle i
            3. 0  <=  n2[i]       <= BASE - 1 für alle i
            4. n1#[0] + n2[0] + 1 <  BASE
            5. SUMME(n1#[i]*BASE^(m-i)) > SUMME(n2[i]*BASE^(m-i))

(*) Gewünschtes Ergebnis:
     1. SUMME_i=0^m(n1'[i]*BASE^(m-i)) =  SUMME(n1#[i]*BASE^(m-i)) - SUMME(n2[i]*BASE^(m-i))     //TODO: Summenzeichen
     2. 0  <=  n1'[i]  <=  BASE - 1 für alle i
}
procedure sub(n1:BigNumber;const n2:BigNumber);
var i:integer;
    overflow: boolean;
begin
  overflow:=False;
  for i:=high(n1){m} downto 1 do begin
    { n1[i] = n1#[i], da nur die Ziffern n[j] mit j > i verändert wurden. }
    if overflow then  begin
       {Voraussetzung:
          SUMME_k=i+1^m(n1[k]*BASE^(m-k)) = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) - SUMME_k=i+1^m(n1[k]*BASE^(m-k))+BASE^(m-i)

         (erfüllt durch letzten Schleifendurchlauf)
       }
      n1[i]:=n1[i]-n2[i]-1
       { Folgen der letzten Anweisung:
          SUMME_k=i^m(n1[k]*BASE^(m-k))
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + n1[i]*BASE^(m-i)                | Zerlegung der Summe
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + (n1#[i] - n2[i] - 1)*BASE^(m-i) | Zuweisung einsetzen
          = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) - SUMME_k=i+1^m(n2[k]*BASE^(m-k))+BASE^(m-i) + (n1#[i] + n2[i] + 1) *BASE^(m-i) | Vorraussetzung einfügen
          = SUMME_k=i^m(n1#[k]*BASE^(m-k)) - SUMME_k=i^m(n2[k]*BASE^(m-k)) | Summen zusammenfassen

         Es ist nicht garantiert, dass n1#[i] - n2[i] - 1 >= 0, also kann nun
         gelten: n1[i] < 0
         Da n1#[i] >= 0 und n2[i] < BASE ist auch n1[i] >= - BASE .
       }
    end else begin
      {Voraussetzung:
         SUMME_k=i+1^m(n1[i]*BASE^(m-i)) = SUMME_k=i+1^m(n1#[i]*BASE^(m-i)) - SUMME_k=i+1^m(n2[i]*BASE^(m-i))

         (im ersten Durchlauf sind beide Seiten 0, da dann i+1>m, ansonsten ist
          sie durch den letzten Schleifendurchlauf erfüllt)
      }
      n1[i]:=n1[i]-n2[i];
       { Folgen der letzten Anweisung:
          SUMME_k=i^m(n1[k]*BASE^(m-k))
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + n1[i]*BASE^(m-i)             | Zerlegung der Summe
          = SUMME_k=i+1^m(n1[k]*BASE^(m-k)) + (n1#[i] - n2[i]) *BASE^(m-i) | Zuweisung einsetzen
          = SUMME_k=i+1^m(n1#[k]*BASE^(m-k)) + SUMME_k=i+1^m(n2[k]*BASE^(m-k))-BASE^(m-i) + (n1#[i] - n2[i]) *BASE^(m-i) | Vorraussetzung einfügen
          = SUMME_k=i^m(n1#[k]*BASE^(m-k)) + SUMME_k=i^m(n2[k]*BASE^(m-k)) | Summen zusammenfassen

         Es ist nicht garantiert, dass n1#[i] + n2[i] + 1 < BASE, also kann nun
         gelten: n1[i] >= BASE
         Da n1#[i] >= 0 und n2[i] >= 0 ist auch n1[i] >= 0.
       }
    end;
    if n1[i]<0 then begin
      overflow:=true;
      n1[i]:=n1[i]+BASE;
    end else overflow:=false;
  end;
end;

function toStr(n: BigNumber):string;
var i,strPos:integer;
    t:string;
    noNull:boolean;
begin
  SetLength(result,length(n) * 9);
  noNull:=false;
  strPos:=1;
  for i:=0 to high(n) do begin
    if noNull or (n[i]<>0) then begin
       t:=IntToStr(n[i]);
       if noNull then begin
         move(t[1],result[i*9+strPos +9-length(t)],length(t));
         FillChar(result[i*9+strPos],9-length(t),ord('0'))
       end else begin
         move(t[1],result[i*9+strPos],length(t));
         strPos:=strPos-9+length(t);
         noNull:=true;
        end;
    end else
      strPos:=strPos-9;
  end;
  SetLength(result,length(n)*9+strpos-1);
  if length(result)=0 then result:='0';
end;

function countParts(const str: string):BigNumber;
var i:integer;
    lastParts: array of BigNumber;
    c: integer;

    numberLen,numberSize:integer;
    oldPossibilities,overflow:BigNumber;
begin
  numberLen:=trunc(length(str)*ln(2)/ln(BASE))+1;
  numberSize:=numberLen*sizeof(integer);

  SetLength(result,numberLen);
  SetLength(oldPossibilities,numberLen);
  SetLength(overflow,numberLen);
  zeromemory(@result[0],numberSize);
  Result[high(result)]:=1;

  SetLength(lastParts,256);
  ZeroMemory(@lastParts[0],length(lastParts)*sizeof(lastParts[0]));

  if length(str)>50 then
    Form1.ProgressBar1.Max:=length(str);

  for i:=1 to length(str) do begin
    c:=ord(str[i]);
    if lastParts[c]=nil then begin //Keine Wiederholung einer Übung
      SetLength(lastParts[c],numberLen);
      Move(result[0],lastParts[c][0],numberSize);
      add(result,result,overflow);
    end else begin
      move(lastParts[c][0],oldPossibilities[0],numberSize);
      move(result[0],lastParts[c][0],numberSize);
      add(result,result,overflow);
      sub(result,oldPossibilities,overflow);
    end;
    if i mod 50=0 then Form1.ProgressBar1.Position:=i;
  end;
end;

//=========================Auflisten aller Teilfolgen===========================

{Alle Teilfolgen einer n-elementigen Folge erzeugen}
procedure createParts(const func:TPartFunction;const perm:TPermutation;const data:pointer);
var selected,j,k:cardinal;
    max:Cardinal;
    part:TPermutation;
    size:^cardinal;
begin
  if length(perm)>31 then
    Raise Exception.Create('too long');

  //Speicber reservieren
  SetLength(part,length(perm));
  //Schneller Zugriff auf die Länge des Arrays (verkleinern ohne Neureservierung)
  size:=pointer(cardinal(part)-4);
  //Anzahl unterschiedlicher Teilfolgen
  max:=1 shl length(perm) - 1;
  //selected durchläuft zwischen 000..000 bis 111.111, alle möglichen Werte
  //0 gibt an, dass der Wert an dieser Stelle nicht in das part-Array geschrieben
  //werden soll.
  //1 gibt an, dass der Wert genommen werden soll.
  for selected:=0 to max do begin
    k:=0; //Anzahl der bisher verwendeten Werte
    for j:=0 to high(perm) do begin
      if selected and (1 shl j) <>0 then begin
        part[k]:=perm[j];
        inc(k);
      end;
    end;
    size^:=k;
    if not func(part,data) then break;
  end;
  size^:=length(perm);
end;

function partFound(const part:TPermutation;const slp:pointer):boolean;
var s:string;
    i:integer;
    sl:Tstringlist;
begin
  sl:=slp;
  if Length(part)> 0 then begin
    s:=chr(part[0]);
    for i:=1 to high(part) do
      s:=s+chr(part[i]);
    sl.add(s);
  end else sl.add('');
  Result:=true;
end;



procedure TForm1.listClick(Sender: TObject);
var s:string;
    vperm:TPermutation;
    i,c:integer;
    sl:TStringList;
begin
  ProgressBar1.Visible:=true;
  possibilities.Clear;
  s:=folge.text;
  sl:=TStringList.create();


  SetLength(vperm,length(s));
  for i:=1 to length(vperm) do
    vperm[i-1]:=ord(s[i]);
  createParts(partFound,vperm,sl);
  sl.sort;
  possibilities.lines.Assign(sl);

  c:=1;
  for i:=1 to sl.Count-1 do
    if (sl[i]<>sl[i-1]) then
      inc(c);

  calculatedCount.text:='Es gibt '+inttostr(c)+' Teilfolgen';
  sl.free;
  ProgressBar1.Visible:=false;
end;






procedure TForm1.countClick(Sender: TObject);
var i:integer;
    s:string;
    f:file;
begin
  ProgressBar1.Visible:=true;
  if direct.Checked then
    s:=folge.text
  else begin
    AssignFile(f,folge.text);
    reset(f,1);
    SetLength(s,FileSize(f));
    BlockRead(f,s[1],filesize(f));
    CloseFile(f);

    for i:=length(s)downto 1 do
      if not (s[i] in ['A'..'Z','Ü','Ö','Ä','ß',#$A]) then begin
        ShowMessage('error: '+inttostr(i)+': '+s[i-1]+s[i]+s[i+1]);
        exit;
      end else if s[i]=#$A then delete(s,i,1);
    for i:=length(s)downto 1 do
      if not (s[i] in ['A'..'Z','Ü','Ö','Ä','ß']) then begin
        ShowMessage('error: '+inttostr(i)+': '+s[i-1]+s[i]+s[i+1]);
        exit;
      end;
  end;
  calculatedCount.text:='Es gibt '+ToStr(countParts(s))+' Teilfolgen';;//+' Teilfolgen';
  ProgressBar1.Visible:=false;
end;


procedure TForm1.directClick(Sender: TObject);
begin
  if direct.Checked then Title.Caption:='Folge der Übungen:'
  else Title.Caption:='Dateiname:';
end;

end.
                  //E:\programs\delphi\bwinf\24\2\2\verwandlung-big.txt
