Произведения (Delphi, Pascal)

Program mult;

{$APPTYPE CONSOLE}

Uses
 Sysutils;

Type
 NA = Array [1..19] Of Integer;

Var
 S: String;
 lon: Integer;
 used, tempused: Set Of Byte;
 max: Integer;
 n, n2, R: Int64;
 minget, getted: Integer;
 A: Array [0..1000000] Of Record
                         A: Int64;
                                     B: Int64;
                                     C: Int64;
                        End;
 anmarr: Array[0..11,0..19] Of Int64;
 error: Integer;

Function GetLength(N: Int64): Integer;
 Begin
  result:=0;
  if n<10 then result:=1
  else
   if n<100 then result:=2
  else
   if n<1000 then result:=3
  else
   if n<10000 then result:=4
  else
   if n<100000 then result:=5
  else
   if n<1000000 then result:=6
  else
   if n<10000000 then result:=7
  else
   if n<100000000 then result:=8
  else
   if n<1000000000 then result:=9
  else
   if n<10000000000 then result:=10
  else
   if n<100000000000 then result:=11
  else
   if n<1000000000000 then result:=12
  else
   if n<10000000000000 then result:=13
  else
   if n<100000000000000 then result:=14
  else
   if n<1000000000000000 then result:=15
  else
   if n<10000000000000000 then result:=16
  else
   if n<100000000000000000 then result:=17
  else
   if n<1000000000000000000 then result:=18;
 End;

Function Anm(n, m: Integer): Int64;
Var
 I: Integer;
Begin
 Result:=1;
 For i:=m-n+1 To m Do
  Result:=Result*i;
End;

Function TenStp(st: Integer): Int64;
Begin
 result:=1;
 case st of
  0: result:=1;
  1: result:=10;
  2: result:=100;
  3: result:=1000;
  4: result:=10000;
  5: result:=100000;
  6: result:=1000000;
  7: result:=10000000;
  8: result:=100000000;
  9: result:=1000000000;
 10: result:=10000000000;
 11: result:=100000000000;
 12: result:=1000000000000;
 13: result:=10000000000000;
 14: result:=100000000000000;
 15: result:=1000000000000000;
 16: result:=10000000000000000;
 17: result:=100000000000000000;
 18: result:=1000000000000000000;
 end;
End;

Function GetNumber(A: NA; Count: Integer): Int64;
Var
 I: Integer;
 ten: Integer;
Begin
 Result:=0;
 ten:=1;
 if (s[a[1]]='0')and(count>1) then error:=1;
 For i:=count DownTo 1 do
  Begin
   Result:=Result+(Ord(S[a])-48)*Ten{stp(count-i)};
   ten:=ten*10;
  End;
End;

Function GetPer(Num, Count, Free: Integer): Int64;
Var
 A: NA;
 I, j, k, temp: Integer;
Begin
 error:=0;
 dec(num);
 temp:=free-count+1;
 k:=1;
 a[count]:=(num mod temp)+1;
 For i:=Count-1 Downto 1 Do
  Begin
   k:=k*(free-i);
   temp:=free-i+1;
   a:=((num div k) mod temp)+1;
  End;
 For i:=1 To count Do
  Begin
   k:=0;
   For j:=1 to lon Do
    if not (j in used) then
     Begin
      inc(k);
      if k=a then
       Begin
        a:=j;
        include(used, j);
        break;
       End;
     End;
  End;
  Result:=GetNumber(a, count);
End;

Procedure Sort(var S: String);
Var
 I, J, lon: Integer;
 ch: Char;
Begin
 lon:=Length(S);
 For i:=1 To lon-1 Do
  For j:=i+1 To lon Do
   Begin
    If s>s[j] Then
     Begin
      ch:=s;
      s:=s[j];
      s[j]:=ch;
     end;
   End;  
End;

Procedure Add(n, n2, r: Int64);
Var
 res: String;
 Bt: Set Of Byte;
 i, j: Integer;
Begin
 For i:=0 to getted-1 Do
  if ( ((n=a.A)and(n2=a.b)) or (n2=a.a))and(r=a.C) then exit;
 bt:=used;
 res:=IntToStr(r);
 Sort(res);
 j:=1;
 For i:=1 To Lon Do
  Begin
   if not (i in bt) then
    if res[j]<>s then exit else inc(j);
  End;
 if n=n2 then inc(minget);
 a[getted].a:=n;
 a[getted].b:=n2;
 a[getted].c:=r;
 inc(getted);
End;

Var
 i, j, k, l: Int64;
 c: Integer;
 F: TextFile;
Begin
 I:=0;
 While i<=11 Do
  Begin
   j:=0;
   While j<=19 Do
    Begin
     anmarr[i, j]:=anm(i, j);
     inc(j);
    End;
   inc(i);
  End;
 AssignFile(F, 'input.txt');
 Reset(F);
 ReadLn(F, S);
 CloseFile(F);
 lon:=Length(s);
 Sort(S);
 getted:=0;
 minget:=0;
 max:=lon div 3;
 i:=1;
 While i<=max Do
  Begin
   j:=1;
   While j<=anmarr[i, lon] Do
    Begin
     used:=[];
     n:=getper(j, i, lon);
     if (n=0) Then
      if (j<>1)or(pos('00',s)=0 )then
       begin
        inc(j);
        continue;
       end;
     if error<>0 then begin inc(j); continue; end;
     if n=0 then used:=[1,2];
     tempused:=used;
     if n=0 then
      Begin
       l:=1;
       While l<=anmarr[lon-2, lon] Do
        Begin
           used:=tempused;
           n2:=getper(l, lon-2, lon);
           if n2=0 then begin inc(l); continue; end;
           if error<>0 then begin inc(l);continue; end;
           Add(0, n2, 0);
           inc(l);
        End;
      End
     Else
      Begin
       k:=1;
       While k<=(lon-i-1) Do
        Begin
         if getlength(n*(tenstp(k)-1))<(lon-i-k) then Begin inc(k); continue end else
          if getlength(n*tenstp(k-1))>(lon-i-k) then break;
         l:=1;
         While l<=anmarr[k, lon] Do
          Begin
           used:=tempused;
           n2:=getper(l, k, lon-i);
           if n2=0 then begin inc(l); continue; end;
           if error<>0 then begin inc(l);continue; end;
           r:=n*n2;
           if getlength(r)>(lon-i-k) then break;
           if getlength(r)=(lon-i-k) then
           Add(n, n2, r);
           inc(l);
          End;
         inc(k);
        End;
      End;
     inc(j);
    End;
   inc(i);
  End;
 AssignFile(F, 'output.txt');
 Rewrite(F);
 WriteLn(F, getted*2-minget);
 For c:=0 To getted-1 Do
  Begin
   Writeln(f, a[c].a, ' ', a[c].b, ' ', a[c].c);
   if a[c].a<>a[c].b then
    Writeln(f, a[c].b, ' ', a[c].a, ' ', a[c].c);
  End;
 CloseFile(F);
end.