unit a2_u;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Memo2: TMemo;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    Button2: TButton;
    Label2: TLabel;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Button5: TButton;
    label3: TEdit;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
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.Button1Click(Sender: TObject);
var s:string;
    vperm:TPermutation;
    i,c,g:integer;
    sl:TStringList;
    count:array of integer;
begin
  memo1.Clear;
  Memo2.Clear;
  s:=Edit1.text;
  sl:=TStringList.create();

  g:=StringGrid1.RowCount;
  if (g=2)and (stringgrid1.Tag=0) then g:=1
  else StringGrid1.RowCount:=StringGrid1.RowCount+1;
  StringGrid1.Cells[0,g]:=s;
  stringgrid1.Tag:=1;

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

  SetLength(count,length(s)+1);
  c:=1;
  ZeroMemory(@count[0],sizeof(count[0])*length(count));
  count[0]:=1;
  for i:=1 to sl.Count-1 do begin
    if (sl[i]<>sl[i-1]) then begin
      inc(c);
      inc(count[length(sl[i])]);
    end;
  end;
  for i:=0 to high(count) do begin
    memo2.lines.add('Länge '+IntToStr(i)+':  '+IntToStr(count[i]));
    StringGrid1.Cells[i+2,g]:=IntToStr(count[i]);
  end;
  Memo2.Lines.add('Länge gesamt: '+IntToStr(c));
  StringGrid1.Cells[1,g]:=IntToStr(c);
  sl.free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  StringGrid1.Cells[1,0]:='total';
  for i:=1 to 10 do
    StringGrid1.Cells[i+1,0]:=inttostr(i);
  StringGrid1.ColWidths[0]:=64;
end;
{
   Bewegt man in einer Folge mit exakt 2 Wiederholungen beide in dieselbe Richtung um die selbe Strecke ändert sich die Anzahl der Teilfolgen nicht!
   Dasselbe gilt für 3
   (beides scheint auch zu gelten, wenn es Wiederholunge von anderen Zeichen gibt, aber nicht wenn ein Zeichen über die Wiederholung eines anderen bewegt wird)

   Das anhängen eines neuen Buchstabens verdoppelt die Anzahl der Teilmengen
}(*)

 a          2     *2   +  2      *2-0
 ab         4     *2   +  2      *2-0
 abc        8     *1.5 +  4      *2-4      4: ab    cc
 abcc       12         + 10      *2-2      2: a     bccb
 abccb      22         + 21      *2-1      1:       abccba
 abccba     43         + 21      *2-22    22: abccb aa
 abccbaa    64         + 52      *2-12    12: abcc  baab
 abccbaab  116         +108      *2-8      8: abc   cbaabc
 abccbaabc 224

 (*)

function countParts(const str: string):int64;
var i:integer;
    lens:array of int64;
    lastPos: array         of integer;
    lp: integer;
begin
  SetLength(lens,length(str)+1);
  ZeroMemory(@lens[0],length(lens)*sizeof(lens));
  lens[0]:=1;
  SetLength(lastPos,256);
  ZeroMemory(@lastPos[0],length(lastPos)*sizeof(lastPos));
  for i:=1 to length(str) do begin
    lens[i]:=lens[i-1]*2;
    lp:=lastPos[ord(str[i])];
    if lp>0 then begin
      lens[i]:=lens[i]-lens[lp-1];
    end;
    lastPos[ord(str[i])]:=i;
  end;
  Result:=lens[length(str)];
end;

type BigNumber=array of integer;

(* Addiert zwei Zahlen mit gleicher Länge
   Übertrag wird beachtet, ABER:
     * die Zahl muss genügend Nullen enthalten, um ihn zu speichern
     * Ist n1=n2, wird jeder Übertrag verdoppelt!
*)
procedure add(s1:BigNumber;const s2:BigNumber{;const stop:integer=0});
var i:integer;
begin
  for i:=high(s1) downto 0 do begin
    s1[i]:=s1[i]+s2[i];
    if s1[i]>=1000000000 then begin
      s1[i]:=s1[i]-1000000000;
      inc(s1[i-1]);
    end;
  end;
end;

(* Subtrahiert zwei Zahlen mit gleicher Länge
   (Übertrag wird beachtet, eine mögliche Verlängerung jedoch nicht)
*)
procedure sub(s1:BigNumber;const s2:BigNumber{;const stop:integer});
var i:integer;
begin
  for i:=high(s1) downto {stop}0 do begin
    s1[i]:=s1[i]-s2[i];
    if s1[i]<0 then begin
      s1[i]:=s1[i]+1000000000;
      dec(s1[i-1]);
    end;
  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 countPartsVL(const str: string):BigNumber;
var i:integer;
    lastParts: array of BigNumber;
    c: integer;

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

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

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

  if length(str)>1000 then begin
    Form1.ProgressBar1.Max:=length(str);
  end;

  for i:=1 to length(str) do begin
    Move(result[0],oldResult[0],numberSize);

    c:=ord(str[i]);
    if lastParts[c]=nil then SetLength(lastParts[c],numberLen)
    else sub(result,lastParts[c]);
    Move(oldresult[0],lastParts[c][0],numberSize);

    add(result,oldResult);
    if i>1000 then Form1.ProgressBar1.Position:=i;
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  Label2.Caption:=IntToStr(countParts(edit1.text));//;+' Teilfolgen';
end;

procedure TForm1.Button3Click(Sender: TObject);
var a,b:BigNumber;
begin
  SetLength(a,10);
  SetLength(b,10);
  ZeroMemory(@a[0],length(a)*sizeof(a[0]));
  zeroMemory(@b[0],length(b)*sizeof(b[0]));
  a[7]:=1;
  a[8]:=1;
  a[9]:=10;
  b[9]:=11;
  sub(a,b);
  edit2.text:=toStr(a);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Label3.text:=ToStr(countPartsVL(edit1.text));//+' Teilfolgen';

end;

procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
    s:string;
    f:file;
begin
  AssignFile(f,edit1.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;
  Label3.text:=ToStr(countPartsVL(s));//+' Teilfolgen';
end;
//E:\programs\delphi\bwinf\24\2\2\verwandlung-big.txt
end.

