User blog:Rgetar/Ordinal Explorer v1.0

Ordinal Explorer v1.0

Source code:

unit Ord;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StrUtils, Math, ScktComp;

type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Label2: TLabel; Label3: TLabel; ServerSocket1: TServerSocket; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; procedure Button1Click(Sender: TObject); procedure Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure Form1Create(Sender: TObject); procedure Form1Destroy(Sender: TObject); end;

lis=array of record s{,i}: string; c,l: integer; end; rar=array[0..19] of string;

var Form1: TForm1; st,st1,bo,cout,qhost,fa: string; s: lis; f: textfile; b,bn,g: boolean; cn,yn,cl,sl: integer; t: array[0..3] of integer; duq,uq: rar; bst: TMemoryStream; sst: tstringstream; ab:array of byte; implementation

{$R *.dfm}

// swap strings st1 and st2 procedure swap(var st1,st2:string); var st:string; begin st:=st2; st2:=st1; st1:=st; end;

// get position of last symbol p of string st (if l=true then first) function getls(st,p:string; l:boolean=false):integer; var e,np: integer; begin if length(st)=0 then result:=ifthen(l,1,0) else begin if l then e:=0 else e:=length(st)+1; np:=0; repeat if l then inc(e) else dec(e); if st[e]='(' then dec(np);     if st[e]=')' then inc(np); until (not l and (e=1)) or (l and (e=length(st))) or ((st[e]=p) and (np=0)); if not l and (e=1) and (st[1]<>p) then e:=0 else if l and (e=length(st)) and (st[e]<>p) then e:=length(st)+1; result:=e; end; end;

// get last element of set st with separator s function le(st:string;s:string='+'):string; begin result:=copy(st,getls(st,s)+1,length(st)); end;

// get first element of set st with separator s function fe(st:string;s:string='+'):string; begin result:=copy(st,1,getls(st,s,true)-1); end;

// get left rest of set st with separator s function lrest(st:string;s:string='+'):string; begin result:=copy(st,1,getls(st,s)-1); end;

// get right rest of set st with separator s function rrest(st:string;s:string='+'):string; begin result:=copy(st,getls(st,s,true)+1,length(st)); end;

// last term of Cantor normal form st set to beta function ltst(st,beta:string):string; begin if beta='' then result:=lrest(st) else begin if lrest(st)= then result:= else result:=lrest(st)+'+'; result:=result+beta; end; end;

// get successor of ordinal st function suc(st:string):string; begin if st='' then result:='1' else result:=st+'+1'; end;

// get X from successor ordinal st = X + 1 function pred(st:string):string; begin if st='1' then result:='' else result:=copy(st,1,length(st)-2); end;

// get string inside Veblen-like function st function getx(st:string):string; begin result:=copy(st,2,length(st)-2); end;

// get last Veblen-like parameter of CNF term st function get1(st:string):string; begin if st[1]='(' then  result:=le(getx(st),'.') else   result:=st; end;

// get left Veblen-like parameter of CNF term st function get3(st:string):string; begin if st[1]='(' then  result:=lrest(lrest(getx(st),'.'),'.') else   result:=''; end;

// get middle Veblen-like parameter of CNF term st function get2(st:string):string; begin if st[1]='(' then  begin   result:=le('.'+lrest(getx(st),'.'),'.');   if result= then result:=suc(get3(st));   end else   result:=; end;

// get type of ordinal st (0 - 0, 1 - successor, 2 - limit) function getordtype(st:string):byte; begin if st='' then result:=0 else if le(st)='1' then result:=1 else result:=2; end;

// finite ordinal string st to number function fostn(st:string):integer; begin if st='' then result:=0 else result:=(length(st)+1) div 2; end;

// get cardinality of ordinal st function card(st:string):string; begin if pos('(',st)=0 then  result:=st else   begin   st:=get3(fe(st));   if st= then      result:=   else      result:='('+st+'..)';   end; end;

// compare standard forms of ordinals st1, st2 (if st1st2 then 1) function compare(st1,st2:string):shortint; forward;

// get sum of ordinals s1, s function sum(s1,s2:string):string; var l:string; begin if s2='' then result:=s1 else begin l:=fe(s2); while (s1<>'') and (compare(le(s1),l)=-1) do     s1:=lrest(s1); result:=ifthen(s1=,,s1+'+')+s2; end; end;

// right part of ordinal st < ordinal x function rx(st,x:string):string; begin result:=st; while (result<>'') and (compare(result,x)>-1) do result:=rrest(result); end;

// right part of ordinal st with cardinality <= ordinal x function rox(st,x:string):string; begin result:=st; while (result<>'') and (compare(card(result),x)=1) do result:=rrest(result); end;

// left part of ordinal st with cardinalities of all CNF terms > ordinal x function lx(st,x:string):string; begin result:=st; while (result<>'') and (compare(card(le(result)),x)<1) do result:=lrest(result); end;

// left part of ordinal st with cardinalities of all CNF terms larger >= ordinal x function lox(st,x:string):string; begin result:=st; while (result<>'') and (compare(card(le(result)),x)=-1) do result:=lrest(result); end;

// get x0 of ordinal st (st without CNF term with cardinality < card(st)) function x0(st:string):string; begin result:=lox(st,card(st)); end;

// get leo of ordinal st (right part of st with cardinality < card(st)) function leo(st:string):string; begin result:=rx(st,card(st)); end;

function getsf(st:string;l:string='n'):string; forward;

// omega ^ st function omex(st:string):string; var c:string; begin if st='' then result:='1' else begin c:=get3(card(st)); if fe(st)=ifthen(c='','1','('+c+'..)') then st:=rrest(st); result:=getsf('('+ifthen(c=,,c+'..')+st+')'); end; end;

// exponent ex of st = omega ^ ex function exom(st:string):string; var c,z:string; begin if st='1' then result:='' else begin c:=get3(st); z:=get1(st); if compare(card(get1(st)),card(st))=1 then result:=st else result:=sum(ifthen(c='','1','('+c+'..)'),z); end; end;

// is st product of two multipliers, including non-one function isprod(st:string;b:boolean=true):boolean; begin if b then result:=(rrest(st)<>'') and (compare(fe(exom(fe(st))),fe(exom(le(st))))=0) else result:=(st<>'1') and (compare(fe(st),le(st))=0);                                       // without multipliers end;

// left part of ordinal st such as it is product of two non-one multipliers (r is right rest of st) function lprod(st:string; var r:string;b:boolean=true):string; var f,ex: string; begin result:=''; if st<>'' then begin if isprod(st,b) then begin result:=st; r:=''; end else begin f:=fe(st); //ex:=fe(exom(f)); //ex:=f;                                  // without multipliers ex:=ifthen(b,fe(exom(f)),f); repeat result:=sum(result,f); st:=rrest(st); f:=fe(st); //until (st='') or (ex<>fe(exom(fe(st)))); //until (st='') or (ex<>f);                // without multipliers until (st='') or (ex<>ifthen(b,fe(exom(fe(st))),f)); r:=st; end; end; end;

// exponent of left multiplier of non-zero ordinal st such as it is product of two non-one multipliers (r is right multiplier) function elmu(st:string; var r:string):string; var e: integer; e1,e2,s: string; begin s:=exom(fe(st)); e1:=rrest(s); e2:=rrest(exom(le(st))); result:=fe(s); while (e1<>'') and (compare(fe(e1),fe(e2))=0) do  begin result:=sum(result,fe(e1)); e1:=rrest(e1); e2:=rrest(e2); end; e:=length(result); r:=''; while st<>'' do  begin delete(s,1,e); if s<>'' then delete(s,1,1); r:=sum(r,omex(s)); st:=rrest(st); if st<>'' then s:=exom(fe(st)); end; end;

function unone(st:string):string; begin result:=ifthen(st='1','',st); end;

// is st epsilon number function iseps(st:string):boolean; begin //result:=st=omex(st); if (pos('(',st)=0) or (rrest(st)<>) then  result:=false else   result:=(compare(card(get1(st)),card(st))=1) or ((get1(st)=) and (card(st)<>'')) end;

// left sum of lprods of ordinal st until omex beginning from epsilon number (r is right rest of st) function unep(st:string; var r:string; b:boolean=true):string; var s,s1,m:string; begin if b then begin result:=''; s:=lprod(st,s1,b); while (st<>) and not iseps(fe(elmu(s,m))) do  //while (st<>) and not iseps(fe(exom(fe(elmu(s,m))))) do      begin result:=sum(result,s); st:=s1; s:=lprod(st,s1,b); end; r:=st; end else begin result:=st; r:=''; if iseps(st) then swap(result,r); end; {if iseps(st) then                                     // without multipliers begin result:=''; r:=st; end else begin result:=st; r:=''; end; } end;

// finite ordinal e from integer to computer format function cf(e:integer):string; begin result:=''; while e<>0 do  begin dec(e); result:=suc(result); end; end;

function minus(st,x,a:string):boolean; forward;

function les(te:integer;st,a,n:string;p:boolean=false;w:boolean=false):boolean; var q:shortint; s:string; begin result:=true; if compare(get3(a),n)=-1 then begin inc(t[te]); form1.Label3.Caption:=inttostr(t[0])+' / '+inttostr(t[1])+' / '+inttostr(t[2])+' / '+inttostr(t[3]); form1.Label3.Refresh; end; if (st='') and p then result:=false; while result and (st<>'') do  begin s:=le(st); st:=lrest(st); if pos('(',s)=0 then     result:=not p   else      begin      if compare(get3(s),n)<1 then         begin         q:=compare(s,a);         result:=q-1) then      //if (compare(get3(a),n)=-1) or (compare(get3(s),n)>-1) then      if result {and (pos('(',s)<>0)} then result:=les(3,get1(s),a,n,p); end; p:=false; //w:=true; end; end;

// check rest of st for x{-}a function cr(st,a:string):boolean; begin result:=true; st:=lox(rx(st,card(a)),''); while st<>'' do  if cr(get1(fe(st)),a) then st:=rrest(st) else begin result:=false; st:=''; end; end;

// is ordinal st element of x{-}a function minus2(st,x,a:string):boolean; var s:string; begin result:=false; if (compare(rox(st,suc(card(a))),x)=-1) and (compare(rox(st,card(a)),a)=-1) and cr(st,a) then begin result:=true; st:=lx(st,card(a)); s:=x; while compare(fe(st),fe(s))=0 do     begin st:=rrest(st); s:=rrest(s); end; while st<>'' do     if minus(get1(fe(st)),x,a) then st:=rrest(st) else begin result:=false; st:=''; end; end; end;

// is ordinal st element of x{-}a function minus1(st,x,a:string):boolean; var s,y,k:string; begin result:=false; if (pos('(',st)=0) and (pos('(',x)<>0) then result:=true else if (((compare(st,x)=-1) or (compare(card(x),card(a))=1) and (compare(card(st),card(x))=1))) and (compare(rox(st,card(a)),a)=-1) then //if ((compare(card(st),card(x))=1) or (compare(st,x)=-1)) and (compare(rox(st,card(a)),a)=-1) then //if (compare(st,x)=-1) and (compare(rox(st,card(a)),a)=-1) then begin result:=true; k:=lx(st,card(a)); //st:=lx(st,'1'); s:=x; while compare(fe(k),fe(s))=0 do     begin k:=rrest(k); s:=rrest(s); end; while k<>'' do     begin y:=x; //while compare(card(get1(fe(st))),card(y))=1 do y:=get1(fe(y)); //if compare(card(get1(fe(st))),card(x))=1 then y:=get1(fe(x)) else y:=x; if minus(get1(fe(k)),y,a) then k:=rrest(k) else begin result:=false; k:=''; end; end; {if result=true then begin k:=rox(st,card(a)); while k<>'' do        begin if minus(get1(fe(k)),x,a) then begin k:=rrest(k); if pos('(',k)=0 then k:=;           end         else            begin            result:=false;            k:=;            end;         end;      end;}   end; end;

// is ordinal st element of x{-}a function minus0(st,x,a:string):boolean; var s,y:string; begin result:=false; {if (pos('(',st)=0) and (pos('(',x)<>0) then result:=true else} if ((compare(st,x)=-1) or (compare(card(x),card(a))=1) and (compare(card(st),card(x))=1)) and (compare(rox(st,card(a)),a)=-1) then //if ((compare(card(st),card(x))=1) or (compare(st,x)=-1)) and (compare(rox(st,card(a)),a)=-1) then //if (compare(st,x)=-1) and (compare(rox(st,card(a)),a)=-1) then begin result:=true; st:=lx(st,card(a)); //st:=lx(st,'1'); s:=x; while compare(fe(st),fe(s))=0 do     begin st:=rrest(st); s:=rrest(s); end; while st<>'' do     begin y:=x; //while compare(card(get1(fe(st))),card(y))=1 do y:=get1(fe(y)); //if compare(card(get1(fe(st))),card(x))=1 then y:=get1(fe(x)) else y:=x; if minus(get1(fe(st)),y,a) then st:=rrest(st) else begin result:=false; st:=''; end; end; end; end;

function minus; {var b0,b1:boolean; e0,e1:integer;} begin {if minus0(st,x,a)<>minus2(st,x,a) then result:=false else} result:=minus2(st,x,a); {b0:=minus0(st,x,a); b1:=minus2(st,x,a); if b0 then e0:=1 else e0:=0; if b1 then e1:=1 else e1:=0; if e0<>e1 then minus:=b0 else result:=b1;} end;

// is ordinal st element of x{+}a function plus(st,x,a:string):boolean; begin

//if (compare(rox(st,suc(card(a))),x)=-1) and (compare(rox(st,card(a)),a)=-1) and cr(rx(st,card(a)),a) then

result:=(pos('(',st)<>0) and       //(compare(rox(st,suc(card(a))),x)=-1) and        ((compare(st,x)=-1) or ((compare(card(x),card(a))=1) and (compare(card(st),card(x))=1))) and        ((compare(le(st),a)=0) or plus(get1(le(st)),x,a)) and        minus(lrest(st),x,a);

//result:=(pos('(',st)<>0) and (((compare(st,x)=-1) or (compare(card(x),card(a))=1) and (compare(card(st),card(x))=1))) and ((compare(le(st),a)=0) or plus(get1(le(st)),x,a)) and minus(lrest(st),x,a); //result:=(pos('(',st)<>0) and ((compare(st,x)=-1) or (compare(card(st),card(x))=1)) and ((compare(le(st),a)=0) or plus(get1(le(st)),x,a)) and minus(lrest(st),x,a); //result:=(pos('(',st)<>0) and (compare(st,x)=-1) and ((compare(le(st),a)=0) or plus(get1(le(st)),x,a)) and minus(lrest(st),x,a); end;

// compare standard forms of ordinals st1, st2 (if st1st2 then 1) function compare2(st1,st2:string):shortint; var p1,p2:shortint; b,c:boolean; //p:string; begin result:=0; if st1<>st2 then begin p1:=pos('(',st1);  p2:=pos('(',st2); if p1<>p2 then if p1>p2 then result:=1 else result:=-1 else if p1=0 then if length(st1)<>length(st2) then if length(st1)>length(st2) then result:=1 else result:=-1 else else if (lrest(st1)=) and (lrest(st2)=) then begin //result:=compare(card(get3(st1)),card(get3(st2))); result:=compare(get3(st1),get3(st2)); if result=0 then begin

{p:=get1(st1); st1:=stringreplace(st1,p,getsf(p),[]); p:=get1(st2); st2:=stringreplace(st2,p,getsf(p),[]); if st1=st2 then result:=0 else}

if (compare(card(get1(st1)),card(st1))<1) and (compare(card(get1(st2)),card(st1))<1) then result:=compare(get1(st1),get1(st2)) else begin {if compare(get1(st1),get1(st2))=1 then b:=true else b:=false; if b then swap(st1,st2); if les(0,get1(st1),st2,get3(st1)) then //if minus(get1(st1),get1(st2),st2) then result:=-1 else if not les(1,get1(st1),st2,get3(st1),true) then //if not plus(get1(st1),get1(st2),st2) then result:=1; if b then result:=-result;}

{b:=false; c:=true; if les(0,get1(st1),st2,get3(st1)) then begin b:=true; swap(st1,st2); if les(0,get1(st1),st2,get3(st1)) then c:=false; end; if not b or (b and c) then if not les(1,get1(st1),st2,get3(st1),true) then result:=1 else else result:=compare(get1(st1),get1(st2)); if b then result:=-result;}

{if les(0,get1(st1),st2,get3(st1)) then begin if les(0,get1(st2),st1,get3(st2)) then result:=compare(get1(st1),get1(st2)) else begin if not les(1,get1(st2),st1,get3(st2),true) then result:=-1; end; end else begin if not les(1,get1(st1),st2,get3(st1),true) then result:=1; end;}

result:=compare(get1(st1),get1(st2)); if result=0 then begin b:=false; c:=true; if les(0,get1(st1),st2,get3(st1)) then begin b:=true; swap(st1,st2); if les(0,get1(st1),st2,get3(st1)) then c:=false; end; if not b or (b and c) then if not les(1,get1(st1),st2,get3(st1),true) then result:=1; if b then result:=-result; end else begin if result=1 then b:=true else b:=false; if b then swap(st1,st2); if les(0,get1(st1),st2,get3(st1)) then result:=-1 else if les(1,get1(st1),st2,get3(st1),true) then result:=0 else result:=1; if b then result:=-result; end;

end;

{if minus(get1(st1),get1(st2),st2) then result:=-1 else if minus(get1(st2),get1(st1),st1) then result:=1;} end; end else while (result=0) and ((st1<>) or (st2<>)) do              begin result:=compare(fe(st1),fe(st2)); if result=0 then begin st1:=rrest(st1); st2:=rrest(st2); end; end; end; end;

// compare standard forms of ordinals st1, st2 (if st1st2 then 1) function compare1(st1,st2:string):shortint; var p1,p2:shortint; b:boolean; begin result:=0; if st1<>st2 then begin p1:=pos('(',st1);  p2:=pos('(',st2); if p1<>p2 then if p1>p2 then result:=1 else result:=-1 else if p1=0 then if length(st1)<>length(st2) then if length(st1)>length(st2) then result:=1 else result:=-1 else else if (lrest(st1)=) and (lrest(st2)=) then begin result:=compare(card(get3(st1)),card(get3(st2))); if result=0 then begin if compare(get1(st1),get1(st2))=1 then b:=true else b:=false; if b then swap(st1,st2); if minus(get1(st1),get1(st2),st2) then result:=-1 else if not plus(get1(st1),get1(st2),st2) then result:=1; if b then result:=-result; end; {if minus(get1(st1),get1(st2),st2) then result:=-1 else if minus(get1(st2),get1(st1),st1) then result:=1;} end else while (result=0) and ((st1<>) or (st2<>)) do              begin result:=compare(fe(st1),fe(st2)); if result=0 then begin st1:=rrest(st1); st2:=rrest(st2); end; end; end; end;

// compare standard forms of ordinals st1, st2 (if st1st2 then 1) function compare0(st1,st2:string):shortint; var s1,s2:string; p1,p2:shortint; b:boolean; begin if st1=st2 then result:=0 else begin result:=-1; p1:=pos('(',st1);  p2:=pos('(',st2); if p1>p2 then result:=1 else if p1+p2=0 then if length(st1)>length(st2) then result:=1 else else if p1+p2=2 then begin s1:=fe(st1); s2:=fe(st2); if (s1<>st1) or (s2<>st2) then begin result:=compare(s1,s2); if result=0 then result:=compare(rrest(st1),rrest(st2)); end else begin result:=compare(card(get3(s1)),card(get3(s2))); if result=0 then if (compare(card(get1(s1)),card(s1))<1) and (compare(card(get1(s2)),card(s2))<1) then result:=compare(get1(s1),get1(s2)) else begin result:=-1; s1:=get1(s1); s2:=get1(s2); while fe(s1)=fe(s2) do                    begin s1:=rrest(s1); s2:=rrest(s2); end; if compare(fe(s1),fe(s2))=-1 then begin b:=false; s2:=st2; end else begin b:=true; s1:=s2; s2:=st1; end; while s1<>'' do                    if ifthen(compare(card(s1),card(s2))=1,compare(get1(fe(s1)),s2),compare(fe(s1),s2))>-1 then //if compare(get1(fe(s1)),s2)>-1 then begin result:=1; s1:=''; end else s1:=rrest(s1); if b then result:=-result; end; end; end; end; end;

function compare; //var //b0,b1:shortint; begin if bn then result:=compare2(st1,st2) else result:=compare1(st1,st2); {b0:=compare0(st1,st2); b1:=compare1(st1,st2); result:=b1; if b0<>b1 then result:=b0 else result:=b1;} end;

// get cofinality of ordinal st function cof(st:string):string; var g1,c,x:string; begin if st='' then result:='' else begin st:=le(st); if st='1' then result:='1' else begin c:=card(st); g1:=get1(st); if g1='' then result:=c else if getordtype(g1)=1 then begin if (compare(card(g1),c)=1) and (compare(cof(x0(g1)),'')>-1) and (compare(cof(x0(g1)),c)<1) then result:=cof(x0(g1)) else result:=''; end else begin x:=cof(g1); if compare(x,c)=1 then result:='' else result:=x; end; end; end; end;

// check if ordinal (x+s) is in standard form function sf(x,s:string):boolean; var g1,s1,s2:string; begin g1:=get1(s); if (x<>'') and (compare(card(g1),card(le(x)))=1) then result:=true else if x=g1 then result:=true else begin s1:=x; s2:=g1; while fe(s1)=fe(s2) do     begin s1:=rrest(s1); s2:=rrest(s2); end; if ((s1=) and (s2=) and (x<>'')) or (compare(fe(s1),fe(s2))=1) then result:=true else begin s1:=rrest(s1); while (s1<>'') and not sf(get1(fe(s1)),x) do        s1:=rrest(s1); result:=s1<>''; end; end; end;

// possible standard form of infinite ordinal st with one CHF term function psf(st:string):string; var c:string; begin c:=card(st); repeat st:=le(get1(st)); //until compare(card(st),c)<1; until (pos('(',st)=0) or (compare(card(st),c)<1); result:=st; end;

function maxcard(st:string):string; begin result:=card(st); repeat st:=get1(st); if compare(card(st),result)=1 then result:=card(st); st:=le(st); until (pos('(',st)=0); end;

function tel(st,p,l:string):boolean; var s:string; begin result:=true; while result and (st<>p) do  begin s:=get1(st); st:=le(s); result:=les(2,lrest(s),l,''); end; end;

function maxc(st,l:string):string; var s:string; begin result:=''; while pos('(',st)<>0 do  begin   s:=fe(st);   st:=rrest(st);   if compare(card(s),l)=1 then   //if card(s)<>'' then      s:=maxc(get1(s),l);   if compare(s,result)=1 then      result:=s   end; end;

// get standard form of ordinal st function getsf1(st:string;l:string='n'):string; var p:string; begin result:=st; if l='n' then l:=card(st); //if compare(card(st),'')=0 then if pos('(',st)<>0 then  if rrest(st)<> then      result:=getsf(fe(st),l)+'+'+getsf(rrest(st),l)   else      {if compare(card(get1(st)),card(st))<1 then         begin         st:=getsf1(get1(st));         if (pos('(',st)<>0) and (rrest(st)=) and (compare(card(get1(st)),card(st))=1) then result:=st; end else} begin p:=get1(st); p:=getsf(p,l); if get3(st)='' then p:='('+p+')' else p:='('+get3(st)+'..'+p+')'; if compare(st,p)=0 then st:=p; result:=st; p:=psf(st); //if (compare(card(p),card(st))=0) and plus(get1(st),get1(p),p) then result:=p; //if card(p)=card(st) then //if (pos('(',p)<>0) {and (compare(maxcard(p),card(st))=1)} and (compare(card(get1(p)),card(p))=1) and (compare(get1(p),get1(st))=1) and les(2,get1(st),p,get3(st),true) then result:=p;        //if (pos('(',p)<>0) and plus(get1(st),get1(p),p) then result:=p; //if compare(p,st)=0 then result:=getsf(p); //if (compare(p,st)=0) and (tel(st,p,l)) then result:=getsf(p); if (compare(p,st)=0) and ((maxc(st,l)='') or (compare(maxc(p,l),maxc(st,l))>-1)) then result:=getsf(p); end; end;

// get standard form of ordinal st function getsf0(st:string):string; var p:string; begin result:=st; if pos('(',st)<>0 then  if rrest(st)<>'' then      result:=getsf0(fe(st))+'+'+getsf0(rrest(st))   else      begin      p:=getsf0(psf(st));      //if (compare(card(p),card(st))=0) and plus(get1(st),get1(p),p) then result:=p;      if (pos('(',p)<>0) and plus(get1(st),get1(p),p) then result:=p; end; end;

// get standard form of ordinal st function getsf; begin if bn then result:=getsf1(st,l) else result:=getsf0(st); end;

// get standard form of ordinal st {function getsf(st:string):string; var x,s,c:string; begin result:=st; if pos('(',st)<>0 then if lrest(st)<> then  result:=getsf(lrest(st))+'+'+getsf(le(st)) else   begin   c:=card(st);   x:=get1(st);   s:=le(x);   x:=lrest(x);   if (getordtype(s)=2) and (compare(card(get1(s)),c)=1) and ((x=) or (compare(le(x),c)=1)) and not sf(x,s) then      result:=getsf(s);   end; end;}

// get n-th element of fs of ordinal st function fs(st,n:string):string; var c,s,x,z:string; i:integer; begin if pos('(',st)=0 then     result:=pred(st)                              // natural else begin   if st=bo then      begin      result:=;      repeat         if n= then            begin            result:='('+result+')';            n:='s';            end         else            begin            result:='('+n+'..'+result+')';            n:=pred(n);            end;         until n='s';      end   else begin c:=lrest(st); if c<> then   begin   s:=fs(le(st),n);                                 // > 1 CNF terms   if s<> then s:='+'+s;   result:=c+s;   end else   begin   c:=card(st);   s:=get1(st);   if s= then      result:=n                                                        // 1   else      begin      z:='('+ifthen(get3(st)=,,get3(st)+'.')+ifthen(get2(st)=suc(get3(st)),,get2(st))+ifthen((get3(st)=) and (get2(st)=suc(get3(st))),,'.'); if getordtype(s)=1 then begin x:=cof(x0(s)); if (compare(card(s),c)=1) and (compare(x,'')>-1) and (compare(x,c)<1) then begin x:=fs(x0(s),n);                                           // 3 if x<>'' then x:=x+'+'; result:=z+x+z+pred(s)+')'+'+1)'; //result:=z+x+getsf(z+pred(s)+')')+'+1)'; end else if compare(card(s),c)<1 then begin result:='';                                            // 2 if n<>'' then begin x:=z+pred(s)+')';                 //x:=getsf(x);                  for i:=1 to fostn(n) do                     result:=result+'+'+x;                  delete(result,1,1);                  end;               end            else               begin               result:=z+fs(x0(s),z+pred(s)+')'+'+1')+')';      // 4               //result:=z+fs(x0(s),getsf(z+pred(s)+')')+'+1')+')';               //result:=getsf(z+fs(x0(s),z+pred(s)+')'+'+1')+')');               for i:=1 to fostn(n) do                  result:=z+fs(x0(s),result)+')'; end; end else begin x:=cof(s); if (compare(x,'')>-1) and (compare(x,c)<1) then begin result:=z+fs(s,n)+')';                                    // 5            //result:=getsf(result);            //if (n=) or (n='1') then result:=getsf(result);            end         else            begin            result:=z+fs(s,)+')';                                    // 6 //if n='' then result:=getsf(result); //result:=getsf(result); for i:=1 to fostn(n) do              result:=z+fs(s,result)+')';            end;         end;      end;   end; end; end; {if compare(result,st)>-1 then result:=st;} end;

function convert(st:string;z:boolean=false):string; var s,ex,m,sex,r,em,us:string; b,mu,l,lo,sp:boolean;

function conveps(s:string):string; var x,c,c1,c2,l1:string; begin x:=get1(s); c:=get3(s); c1:=card(s); c2:=card(x); if l and (fe(x)='('+suc(c)+'..)') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#949;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..)') and (fe(rrest(x))='('+suc(c)+'..)') and (card(rrest(rrest(x)))<>'('+suc(c)+'..)') then result:='&#950;'+convert(sum(ifthen(c=,,'('+c+'..)+('+c+'..)+1'),rrest(rrest(x))),true)+'' else if l and (fe(x)='('+suc(c)+'..)') and (fe(rrest(x))='('+suc(c)+'..)') and (fe(rrest(rrest(x)))='('+suc(c)+'..)') and (card(rrest(rrest(rrest(x))))<>'('+suc(c)+'..)') then result:='&#951;'+convert(sum(ifthen(c=,,'('+c+'..)+('+c+'..)+('+c+'..)+1'),rrest(rrest(rrest(x)))),true)+'' else if l and (fe(x)='('+suc(c)+'..1)') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#913;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..((1..)))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#914;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..(1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#915;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..(1..)+(1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#916;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..(1..1))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='v'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..(1..(1..)))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='V'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if l and (fe(x)='('+suc(c)+'..(1+1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='H'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+'' else if lo and (x='') then result:='&#937;'+ifthen(c='1',,+convert(c,true)+'') else begin l1:=''; while sp and (lrest(x)='') and (compare(c2,c1)=1) do           begin l1:=suc(l1); x:=get1(x); c1:=c2; c2:=card(x); end; result:='&#966;'+ifthen(c=,,+convert(c)+)+ifthen(l1=,,+convert(l1)+)+'('+convert(x,true)+')' end; end;

begin lo:=uq[11]=''; if uq[9]<>'' then result:=st else if pos('(',st)=0 then     result:=ifthen(st=,ifthen(z,'0',),inttostr(ceil(length(st)/2))) else   if st=bo then      result:='&#966;'+ifthen(lo,'&#969;','&#966;(0)')+'(0)'   else      begin      mu:=uq[5]<>;      l:=uq[8]=;      sp:=uq[10]=;      result:=;      repeat         s:=lprod(st,st,mu);         ex:=elmu(s,m);         r:=;         if ex= then            m:=inttostr(ceil(length(m)/2))         else            begin            while ex<> do               begin               sex:=unep(ex,ex,mu);               if sex<> then                  begin                  if lo then                     begin

sex:=unone(convert(sex)); sex:='&#969;'+ifthen(sex=,,+sex+); end else begin sex:=unone(omex(sex)); if sex<>'' then sex:=conveps(sex); end; r:=r+sex; end else begin sex:=elmu(lprod(ex,ex,mu),em); b:=(rrest(sex)='') or (fe(em)='1') or isprod(em,mu); em:=unone(ifthen(b,,'(')+convert(em)+ifthen(b,,')')); us:=unone(convert(omex(rrest(sex))))+em; r:=r+conveps(fe(sex))+ifthen(us=,,+us+); end; end; b:=(fe(m)='1') or isprod(m,mu); m:=unone(ifthen(b,,'(')+convert(m)+ifthen(b,,')')); end; result:=result+ifthen(result=,,' + ')+r+m; until st=''; end; end;

function convert_old(st:string;z:boolean=false):string; var e:integer; s,a,delta:string;

function getb(x:string):string; begin result:=''; while x<>'' do  begin result:=result+'+'+omex(get1(fe(x))); x:=rrest(x); end; delete(result,1,1); result:=getsf(result); end;

function geta(s:string):string; var x,c,c1,c2,l:string; begin if s='1' then result:=s else begin x:=get1(s); c:=get3(s); c1:=card(s); c2:=card(x); if (compare(c1,'')<1) or (compare(c2,c1)=1) then //if true then begin if lrest(s)='' then if (c='') and (c2<>'(1..)') then result:='&#969;'+ifthen(x=,,+ifthen(pos('(',x)=0,convert('1+'+x),convert(x))+)

{else if (c='') and (fe(x)='(1..)') and (card(rrest(x))<>'(1..)') then result:='&#949;'+convert(rrest(x),true)+'' else if (c='1') and (fe(x)='(1+1..)') and (card(rrest(x))<>'(1+1..)') then result:='&#949;'+convert(sum('(1..)+1',rrest(x)),true)+'' } else if (fe(x)='('+suc(c)+'..)') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#949;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..)') and (fe(rrest(x))='(1..)') and (card(rrest(rrest(x)))<>'(1..)') then result:='&#950;'+convert(rrest(rrest(x)),true)+''} else if (fe(x)='('+suc(c)+'..)') and (fe(rrest(x))='('+suc(c)+'..)') and (card(rrest(rrest(x)))<>'('+suc(c)+'..)') then result:='&#950;'+convert(sum(ifthen(c=,,'('+c+'..)+('+c+'..)+1'),rrest(rrest(x))),true)+''

{else if (c='') and (fe(x)='(1..)') and (fe(rrest(x))='(1..)') and (fe(rrest(rrest(x)))='(1..)') and (card(rrest(rrest(rrest(x))))<>'(1..)') then result:='&#951;'+convert(rrest(rrest(rrest(x))),true)+''} else if (fe(x)='('+suc(c)+'..)') and (fe(rrest(x))='('+suc(c)+'..)') and (fe(rrest(rrest(x)))='('+suc(c)+'..)') and (card(rrest(rrest(rrest(x))))<>'('+suc(c)+'..)') then result:='&#951;'+convert(sum(ifthen(c=,,'('+c+'..)+('+c+'..)+('+c+'..)+1'),rrest(rrest(rrest(x)))),true)+''

{else if (c='') and (fe(x)='(1..1)') and (card(rrest(x))<>'(1..)') then result:='&#913;'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..1)') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#913;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..((1..)))') and (card(rrest(x))<>'(1..)') then result:='&#914;'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..((1..)))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#914;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..(1..))') and (card(rrest(x))<>'(1..)') then result:='&#915;'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..(1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#915;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..(1..)+(1..))') and (card(rrest(x))<>'(1..)') then result:='&#916;'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..(1..)+(1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='&#916;'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..(1..1))') and (card(rrest(x))<>'(1..)') then result:='v'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..(1..1))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='v'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..(1..(1..)))') and (card(rrest(x))<>'(1..)') then result:='V'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..(1..(1..)))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='V'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

{else if (c='') and (fe(x)='(1..(1+1..))') and (card(rrest(x))<>'(1..)') then result:='H'+convert(rrest(x),true)+''} else if (fe(x)='('+suc(c)+'..(1+1..))') and (card(rrest(x))<>'('+suc(c)+'..)') then result:='H'+convert(sum(ifthen(c=,,'('+c+'..)+1'),rrest(x)),true)+''

else begin l:=''; while (lrest(x)='') and (compare(c2,c1)=1) do           begin l:=suc(l); x:=get1(x); c1:=c2; c2:=card(x); end; result:='&#966;'+ifthen(c=,,+convert(c)+)+ifthen(l=,,+convert(l)+)+'('+convert(x,true)+')' end else result:=convert(s); end else begin if compare(card(fe(x)),c1)=1 then result:=s else begin while (x<>'') and (compare((card(le(x))),c1)=-1) do        x:=lrest(x); if compare(fe(x),c1)<1 then x:=card(s)+ifthen(x=,,'+')+x; result:='&#937;'; if c<>'1' then result:=result++convert(c)+; x:=convert(getb(x)); if x<>'1' then result:=result++x+; end; end; end; end;

function getd(s:string):string; var x,c:string; begin c:=card(s); if c='' then result:='1' else begin x:=get1(s); if compare(card(x),c)=1 then result:='1' else begin while (x<>'') and (compare((card(fe(x))),c)=0) do        x:=rrest(x); result:=omex(x); end; end; end;

begin if pos('(',st)=0 then  if st=bo then      result:='&#966;&#969;(0)'   else      result:=ifthen(st=,ifthen(z,'0',),inttostr(ceil(length(st)/2))) else      begin      s:=le(st);      result:=;      repeat         a:=geta(s);         e:=0;         delta:=;         repeat            inc(e);            delta:=getd(s)+ifthen(delta=,,'+')+delta;            st:=lrest(st);            s:=le(st);            until (st=) or (geta(s)<>a);         if result<> then            result:=' + '+result;         if (system.ord(a[1])<58) and (system.ord(a[1])>47) then            result:=inttostr(e)+result         else            begin            delta:=getsf(delta);            if pos('(',delta)=0 then if delta='1' then delta:='' else delta:=convert(delta) else if fe(delta)=le(delta) then delta:=convert(delta) else delta:='('+convert(delta)+')'; result:=a+delta+result; end; until st='' end; end;

// small expansion of pair c > l function se(c,l:string):string; var u:integer; n:string; begin n:=''; repeat result:=fs(c,n); {z:=''; while a<>'' do           begin z:=z+'+'+getsf(fe(a)); a:=rrest(a); end; if z<>'' then delete(z,1,1); a:=z;} {if compare (a,getsf(a))<>0 then a:=a else} result:=getsf(result); n:=suc(n); {if a='((1..)+((1..)+(1..)))' then n:=suc(n);} {if n='1+1+1+1+1+1+1+1' then //if n='1+1+1+1+1' then n:=suc(n);} until (l='-') or (compare(result,l)=1); for u:=3 to yn do        n:=suc(n); if yn>1 then result:=getsf(fs(c,n)); end;

// levelup procedure levelup; var e,i,y,u: integer; n,l,p,a,c{,z,it}: string; begin e:=0; c:=s[e].s; i:=s[e].c; y:=0; form1.Label2.Caption:=inttostr(cn)+'                      '; form1.Label2.Refresh; //while (i>-1) and (y<1000) do //while i>-1 do repeat begin n:=''; if i=-1 then begin l:='-'; p:=''; end else begin l:=s[i].s;     p:=suc(l); end; //it:=s[e].i;  {if l='((((1..))+((1..))))+((1..))' then n:='';} if compare(c,p)=0 then //if c=p then begin {if c<>p then form1.Label2.Caption:='';} e:=i; if e>-1 then begin c:=s[e].s;        i:=s[e].c;         if i=-1 then e:=i; end; dec(cn); form1.Label2.Caption:=inttostr(cn)+'                      '; form1.Label2.Refresh; end else begin a:=se(c,l); u:=0; while ulength(s) then setlength(s,length(s)*2); form1.Label1.Caption:=inttostr(sl); form1.Label1.Refresh; e:=y; s[e].c:=i; s[e].s:=a; s[e].l:=cl; if u<>yn then begin n:=pred(n); a:=getsf(fs(c,n)); end; //s[e].i:=it+convert(pred(n),true); //if a='1' then s[1].i:=s[e].i+'0'; end; c:=a; end; end; until e=-1; cn:=y; inc(cl); end;

function ruq(st:string;uq:rar):rar; var e,i:integer; begin st:=st+'='; result:=uq; while (st<>'=') and (st<>'') do  begin e:=system.ord(st[1])-48; delete(st,1,1); i:=pos('=',st); result[e]:=leftstr(st,i-1); delete(st,1,i); end; end;

function wuq(st:string):string; var e:integer; huq:rar; begin huq:=ruq(st,uq); result:=''; for e:=0 to length(uq)-1 do  if huq[e]<>duq[e] then begin if result<>'' then result:=result+'='; result:=result+chr(e+48)+huq[e]; end; end;

// get html link s, displaying string st function getrefs(s, st: string):string; begin result:=''+st+''; end;

procedure ads(st:string); begin if g then //cout:=cout+st+#13#10 cout:=cout+st else writeln(f,st); end;

procedure starthtml; begin cout:=''; st:='  a {text-decoration: none; color: blue;} a:hover {text-decoration: underline;} a:visited {color: blue;} '; st:='sup {font-size: 0.83rem;}'+st; st:='sub {font-size: 0.83rem;}'+st; st:=' '+st; ads(st); end;

procedure endhtml; begin if g then begin st:=#13#10#13#10#13#10+' Formats:'; st:=st+' ['+getrefs(wuq('9'+ifthen(uq[9]=,'0',)),ifthen(uq[9]=,,'not ')+'computer format')+']'; st:=st+' ['+getrefs(wuq('8'+ifthen(uq[8]=,'0',)),ifthen(uq[8]='','without','with')+' &#949;, &#950;, &#951;, &#913;, &#914;, &#915;, &#916;, v, V, H')+']'; st:=st+' ['+getrefs(wuq(';'+ifthen(uq[11]=,'0',)),ifthen(uq[11]='','without','with')+' &#969;, &#937;')+']'; st:=st+' ['+getrefs(wuq(':'+ifthen(uq[10]=,'0',)),ifthen(uq[10]='','without','with')+' finite subscripts of &#966;')+']'; st:=st+' ['+getrefs(wuq('5'+ifthen(uq[5]=,'0',)),ifthen(uq[5]='','with','without')+' infinite multipliers')+'] '; ads(st); st:=#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10; ads(st); st:=#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10; ads(st); st:=#13#10#13#10+' ['+getrefs(wuq('3'+ifthen(uq[3]=,'0',)),ifthen(uq[3]='','hide','show')+' [expand]s')+']'; st:=st+' ['+getrefs(wuq('6'+ifthen(uq[6]=,'0',)),ifthen(uq[6]='','hide','show')+' ordinal links')+'] '; ads(st); end else begin ads(' '); st:='Total '+inttostr(sl)+' ordinals. ';  ads(st); end; ads(' '); end;

function ors(st:string;b:boolean=true):string; begin result:=convert(st,true); {st:=s[0].s; while s[i].i<>'' do  begin st:=st+'['+s[i].i[1]+']'; delete(s[i].i,1,1); end;} //st:=st+' '; if b and (uq[6]='') then result:=getrefs(wuq('0'+st+'=1-=20=40=7'+duq[7]),result); end;

// create output list procedure createlist; var e,i,j:integer; st:string; begin cl:=0; if not g then begin st:='D:\Delphi\Ord3\1.htm'; assignfile(f,st); rewrite(f); end; starthtml; e:=0; i:=s[0].c; j:=-1; while i>-1 do  begin s[e].c:=j; j:=e; e:=i; i:=s[e].c;  end; i:=e; s[e].c:=j; if g and (uq[3]=) and (s[i].s<>) then begin st:=wuq('0'+s[i].s+'=1-=21'); st:=' ['+getrefs(st,'expand')+'] '; ads(st); end; while i>-1 do  begin st:=ors(s[i].s); if s[i].l>0 then st:='<li style="list-style-type: none">'+st+'</li>'; while s[i].l>cl do     begin st:=''+st; inc(cl); end; while s[i].l<cl do     begin st:='</ul>'+st; dec(cl); end; ads(st); e:=i; i:=s[i].c;  if g and (i>-1) and (le(s[i].s)<>'1') then begin if uq[3]='' then begin st:=wuq('0'+s[i].s+'=1'+s[e].s+'=21'); st:='<li style="list-style-type: none"> ['+getrefs(st,'expand')+'] </li></ul>'; end else st:=#13#10; ads(st); end else begin st:=#13#10; ads(st); end; end; if g then begin ads(#13#10+' '+#13#10); st:=inttostr(sl)+' ordinal'+ifthen(sl=1,'','s')+' '; ads(st); st:=wuq('2'+inttostr(strtoint(uq[2])+1)); st:=#13#10+'['+getrefs(st,'expand all')+']'; if uq[2]<>'0' then st:=st+' ['+getrefs(wuq('20'),'collapse all')+']'; ads(st); end; endhtml; if not g then closefile(f); end;

// reset list of ordinals procedure resetlist; begin form1.Label1.Caption:='                                                    '; form1.Label1.Refresh; form1.Label2.Caption:='                                                    '; form1.Label2.Refresh; sl:=ifthen(uq[1]='-',1,2); setlength(s,sl); //s[0].s:='((1..(1..(1..)+)))';         // ordinal //s[0].s:='((1..(1+1..)))';         // ordinal //s[0].s:='((1..(1+1..)+))';         // ordinal //s[0].s:='((1..(1+1..(1..))))';         // ordinal //s[0].s:='((1..(1+1..(1..(1..)))))';         // ordinal

//s[0].s:='((1..(1+1..(1+1..))))';         // ordinal //s[0].s:='((1..(1+1..(1+1+1..))))';         // ordinal s[0].s:=uq[0];                        // ordinal s[0].c:=sl*2-3;           // lesser element s[0].l:=0; //s[0].i:='';

if sl=2 then begin s[1].s:=uq[1]; s[1].c:=-1; s[1].l:=0; end; end;

// start procedure TForm1.Button1Click(Sender: TObject); begin cl:=1; g:=false; //st:=inttostr(compare('((1..))','((1..(1+1..)))')); {st:=inttostr(compare('((1..(1+1..)))','((1..(1+1..(1+1+1..))))')); st:=inttostr(compare('((1..(1+1..)))','((1..(1..(1+1..))+1))'));

st:=inttostr(compare('((1..(1+1..(1..(1+1..(1+1..))))+1))','((1..(1+1..((1..(1+1..(1..(1+1..(1+1..))))+1)))+(1..(1+1..(1+1..)))+1))')); st:=inttostr(compare('((1..(1+1..(1..(1+1..(1+1..))))+1))',fs('((1..(1+1..((1..(1+1..(1..(1+1..(1+1..))))+1)))+(1..(1+1..(1+1..)))+1))','1'))); st:=fs('((1..(1+1..((1..(1+1..(1..(1+1..(1+1..))))+1)))+(1..(1+1..(1+1..)))+1))','');

st:=inttostr(compare('((1..(1+1..(1..))+1))','((1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1))')); st:=inttostr(compare('((1..(1+1..(1..(1+1..(1+1..))))+1))',fs('((1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1))',''))); st:=fs('((1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1))','');

st:=getsf(st); st:=fs(st,''); st:=fs(st,''); st:=fs(st,''); st:=fs(st,''); st:=fs(st,'1+1'); st:=fs(st,'');

st:='((1..(1+1..(1..))+))'; st:=fs(st,'1+1'); st:=fs(st,''); st:=fs(st,''); st:=fs(st,'1+1'); st:=fs(st,''); st:=fs(st,''); st:=fs(st,'1'); st:=fs(st,''); st:=fs(st,''); st:=fs(st,'1');

st:=fs(st,''); st:=fs(st,''); st:=fs(st,'');

st:=fs(st,'1'); st:=fs(st,''); st:=fs(st,'1');

st:=fs('((1..(1+1..((1..(1+1..(1..(1+1..(1+1..))))+1)))+(1..(1+1..(1+1..)))+1))',''); st:=fs('((1..(1+1..((1..(1+1..(1..(1+1..(1+1..))))+1)))+1))','');

st:=fs('(1..(1+1..(1..))+1)',''); st:=fs('((1..(1+1..(1..))+1))',''); st:=fs('(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1)','');}

st:=getsf('(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..))))'); //b:=minus('((1..(1+1..(1..))+1))','(1+1..(1..))','(1..(1+1..(1..)))');

//st:=inttostr(compare('(((1..))+1)','((((1..))+1))')); //b:=minus1('((1..))+1','(((1..))+1)','((((1..))+1))'); //b:=minus0('((1..(1..)))','(1..)','(1..(1..))'); //b:=minus2('((1..(1..)))','(1..)','(1..(1..))');

st:=fs('(1..(1+1..(1..)))','((1..(1+1..(1..(1+1..)))))'); st:=getsf('(1..(1+1..((1..(1+1..(1..(1+1..)))))))'); st:=fs('((1..(1+1..(1..(1+1..(1..))))))','1'); st:=fs('(1..(1+1..(1..(1+1..(1..)))))','((1..(1+1..(1..(1+1..)))))'); st:=fs('(1+1..(1..(1+1..(1..))))','((1..(1+1..(1..(1+1..)))))'); st:=fs('(1..(1+1..(1..)))','((1..(1+1..(1..(1+1..)))))'); st:=getsf('(1..(1+1..((1..(1+1..(1..(1+1..)))))))'); b:=plus('(1+1..((1..(1+1..(1..(1+1..))))))','(1+1..(1..(1+1..)))','(1..(1+1..(1..(1+1..))))'); cn:=compare('((1..(1+1..))+(1..(1+1..)+((1..(1+1..))+(1..))))','((1..(1+1..))+(1..(1+1..)))'); bn:=false; bn:=true; st:=fs('((1..(1+1..))+1)','1'); st:=fs(st,'1+1'); st:=fs(st,'1'); st:=fs(st,''); st:=fs(st,'1'); st:=fs('((1..(1..(1+1..)+((1..(1+1..))))))','1+1'); cn:=compare('((1..(1+1..)+((1..(1+1..)))))','((1..(1+1..))+((1..(1+1..)))+1)'); cn:=compare('((1..(1..(1+1..)+((1..(1+1..))))))','((1..(1+1..))+((1..(1+1..)))+1)'); cn:=compare('((1..(1..(1+1..)+((1..(1+1..1))))))','((1..(1+1..))+((1..(1+1..)))+1)'); cn:=compare('((1..(1..(1+1..)+((1..(1+1..1))))))','((1..(1+1..)))'); cn:=compare('(1..(1..(1+1..)+((1..(1+1..1)))))','(1..(1+1..))'); st:=card('(1..(1..(1+1..)+((1..(1+1..1)))))'); st:=getsf('(1..(1..(1+1..)+((1..(1+1..1)))))'); st:=getsf('(1..(1..(1+1..)+((1..(1+1..)))))'); st:='(1..(1..(1+1..1)+((1..(1+1..1)))))'; //b:=les(get1(st),get1(st),'1',true); //b:=les('(1..(1+1..1))','(1..(1+1..)+((1..(1+1..1))))','1'); cn:=compare('(1..(1+1..1))','(1..(1+1..)+((1..(1+1..1))))'); //b:=les('(1..(1+1..)+((1..(1+1..)+(1+1..))))','(1..(1+1..)+((1..(1+1..)+(1+1..))))','1',true); t[0]:=0; t[1]:=0; t[2]:=0; t[3]:=0; st:='((1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1))'; cn:=compare(st,'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,''),'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,'1'),'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,'1+1'),'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,'1+1+1'),'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,'1+1+1+1'),'((1..(1+1..(1..))+1))'); cn:=compare(fs(st,'1+1+1+1+1'),'((1..(1+1..(1..))+1))'); st:=fs(st,''); st:=fs('(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1)',''); st:=fs('((1..(1+1..(1..))+1))',''); st:=getsf('((1..((1..(1+1..)+(1..(1+1..(1..)))+1))+(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..))))+1))'); st:=getsf('(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..))))'); cn:=compare('(1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..))))','(1..(1+1..(1..)))'); cn:=compare('((1..(1+1..)))','((1..(1..(1+1..))))'); cn:=compare('((1..(1+1..)))','((1..(1+1..))+1)'); cn:=compare('((1..(1..(1+1..))))','((1..(1+1..))+1)'); cn:=compare('((1..(1+1..)))','((1..(1..(1+1..)))+1)'); cn:=compare('((1..(1..(1+1..))))','((1..(1..(1+1..)))+1)'); cn:=compare('((1..(1+1..)))','((1..(1..(1+1..)))+1)'); st:=getsf('((1..(1..(1+1..))))'); st:=fs('((1..(1+1..((1..(1+1..(1..))+1)))+(1..(1+1..(1..)))+1))',''); st:=getsf(st); st:=getsf('((1..(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))))'); st:=getsf('(1..(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..)))))'); cn:=compare('(1..(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..)))))','(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))'); cn:=compare('(1..(1..(1+1..)+(1..(1+1..1))))','(1..(1+1..)+(1..(1+1..1)))'); b:=les(1,'(1..(1+1..)+(1..(1+1..1)))','(1..(1+1..)+(1..(1+1..1)))','1',true); cn:=compare('((1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))+((1..(1+1..(1..(1+1..)))))+1+1)','((1..(1+1..(1..)))+((1..(1+1..(1..(1+1..)))))+1)'); cn:=compare(fs('((1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))+((1..(1+1..(1..(1+1..)))))+1+1)',''),'((1..(1+1..(1..)))+((1..(1+1..(1..(1+1..)))))+1)'); st:='((1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))+((1..(1+1..(1..(1+1..)))))+1+1)'; cn:=compare(st,fs(st,''));

cn:=compare('((1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))+((1..(1+1..(1..(1+1..)))))+1)','((1..(1+1..(1..)))+((1..(1+1..(1..(1+1..)))))+1)'); st:=getsf('((1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))+((1..(1+1..(1..(1+1..)))))+1)'); cn:=compare('(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))','(1..(1+1..(1..)))'); st:=getsf('(1..(1+1..((1..(1+1..(1..(1+1..)))))+1)+(1..(1+1..(1..))))'); st:='((1..(1..(1+1..((1..(1+1..(1..(1+1..)))+1))+1)+(1..(1+1..(1..(1+1..)))))))'; cn:=compare(st,getsf(st)); st:=getsf(st); st:='(1..(1+1..((1..(1+1..(1..(1+1..)))+1))+1)+(1..(1+1..(1..(1+1..)))))'; cn:=compare(st,getsf(st)); st:=getsf(st); st:=convert(''); st:=convert('1'); st:=convert('1+1'); st:=convert('1+1+1+1+1+1+1+1+1+1+1+1+1'); st:=convert(''); st:=convert('+1'); st:=convert('+1+1'); st:=convert('+1+1+1+1+1+1+1+1+1+1+1+1+1'); st:=convert('+'); st:=convert('++1'); st:=convert('++1+1'); st:=convert('++1+1+1+1+1+1+1+1+1+1+1+1+1'); st:=convert('+++++++++++++1+1+1+1+1'); st:=convert('(1)'); b:=iseps(''); st:=convert('()'); st:=convert('(1..1)+(1..)'); st:=convert('(1..(1..))'); st:=convert('(1..(1..(1..)+))'); st:=convert('(1..(1..(1..)))'); st:=convert(''); st:=convert(''); st:=convert(''); st:=convert(''); st:=elmu('((1+1)+(1)+++)+((1+1)+(1)++)+((1+1)+(1)+)',st1); st:=elmu('1',st1); st:=convert('(1..(1..))'); st:=elmu('(1)',st1); st:=unep(st,st1);

cn:=1; yn:=1; uq[0]:=bo; uq[1]:='-'; resetlist; levelup; levelup; levelup; levelup; //levelup; yn:=1; //levelup; createlist; end;

// read HTTP from cin to q... {procedure readhttp; var e:integer; begin e:=pos(' ',cin)+1; qm:=leftstr(cin,e-2); qurl:=copy(cin,e,posex(' ',cin,e)-e); delete(qurl,1,1); e:=pos('Host: ',cin)+6; qhost:=copy(cin,e,posex(#13#10,cin,e)-e); e:=pos(#13#10#13#10,cin)+4; qc:=copy(cin,e,length(cin)); end;}

{procedure cb(st:string; var b:boolean); begin if leftstr(qc,length(st)+4)=st+'=on&' then begin delete(qc,1,length(st)+4); b:=true; end else b:=false; end;}

// client request procedure TForm1.Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); var e,i:integer; cin,url:string; begin // cin - client request, cout - server response cin:=Socket.ReceiveText; e:=pos(' ',cin)+1; url:=copy(cin,e,posex(' ',cin,e)-e); delete(url,1,1); e:=pos('Host: ',cin)+6; qhost:=copy(cin,e,posex(#13#10,cin,e)-e);

if url='favicon.ico' then Socket.SendText(fa) else begin g:=true; cl:=1; cn:=1; yn:=1; uq:=ruq(url,duq);

if uq[4]='' then begin resetlist; for e:=1 to strtoint(uq[2]) do        levelup; createlist; end else begin starthtml; if (uq[3]=) and (uq[0]<>) then begin st:=wuq('0'+uq[0]+'=1-=21=4'); st:='<li style="list-style-type: none"> ['+getrefs(st,'expand')+'] </li></ul>'; ads(st); end; ads(+ors(uq[0],false)+); ads(#13#10#13#10#13#10#13#10+'Elements of fundamental sequence:'+#13#10#13#10); if uq[0]='' then i:=-1 else if le(uq[0])='1' then i:=0 else i:=strtoint(uq[7]); for e:=0 to i do        ads(inttostr(e)+'. '+ors(getsf(fs(uq[0],cf(e))))+#13#10#13#10); if uq[0]='' then ads((empty)+#13#10#13#10) else if le(uq[0])<>'1' then ads(' +getrefs(wuq('7'+inttostr(strtoint(uq[7])+1)),'(more) )+#13#10#13#10); endhtml; end;

Socket.SendText(cout); end; Socket.Close; form1.Label4.Caption:=''; form1.Label5.Caption:=''; form1.Label6.Caption:=''; form1.Label7.Caption:=''; form1.Label4.Refresh; form1.Label5.Refresh; form1.Label6.Refresh; form1.Label7.Refresh; end;

// open program procedure TForm1.Form1Create(Sender: TObject); begin bn:=true; bo:='(.)'; duq[0]:=bo;           // larger ordinal duq[1]:='-';          // lesser ordinal duq[2]:='0';          // number of expansion levels duq[3]:='';           // show / hide [expand]s duq[4]:='';           // mode (list / fs) duq[5]:='';           // without / with multipliers duq[6]:='';           // show / hide ordinal links duq[7]:='4';          // number of fs elements in fs mode duq[8]:='';           // with / without letters except phi, omega, Omega duq[9]:='';           // human / computer format duq[10]:='';          // without / with subscripts of phi duq[11]:='';          // with / without omega, Omega

fa:='#0#0#1#0#1#0#32#32#4#0#0#0#0#0$e8#2#0#0#22#0#0#0#40#0#0#0#32#0#0#0#64#0#0#0#1#0#4#0#0#0#0#0#0#2#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'; fa:=fa+'#0$80#0#0$80#0#0#0$80$80#0$80#0#0#0$80#0$80#0$80$80#0#0$80$80$80#0$c0$c0$c0#0#0#0$ff#0#0$ff#0#0#0$ff$ff#0$ff#0#0#0$ff#0$ff'; fa:=fa+'#0$ff$ff#0#0$ff$ff$ff#0$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0'; fa:=fa+'#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0'; fa:=fa+'#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0'; fa:=fa+'#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff'; fa:=fa+'#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff'; fa:=fa+'#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff#0#0#0#0#0#0#0#0#0#0#0#0#0#0$ff$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$fe#3$e0$7f$f8#1$80#31$f8#0'; fa:=fa+'$80#15$f0#0#0#7$e0$70#15#7$e0$f8#31#7$c0$f8#31$83$c0$fc#31$83$c1$fc#31$83$c1$fc#63$83$c1$fc#63$83$c1$fc#63$83$c1$fc'; fa:=fa+'#63$83$c1$fc#63$83$c0$ff$ff$83$e0$ff$ff$83$e0$ff$ff#7$e0$ff$ff#7$f0$7f$ff#7$f0$7f$fe#15$f8#63$fe#15$f8#63$fc#31$ff'; fa:=fa+'$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff$ff'; ServerSocket1.open; end;

// close program procedure TForm1.Form1Destroy(Sender: TObject); begin ServerSocket1.Close; end;

end.