Program Symm_numb; {Программа поиска симметричных чисел, которые являются
частными от деления чисел, состоящих из 10 неповторяющихся цифр, и 9}
{16 апреля 2005 г.}
Uses CRT;
type TN = array [1..12] of Byte;
var
  k, k1 : LongInt;
  i, j, X, Y : Integer;
  h : Byte;
  NCount, NC9 : LongInt;
const
  N : TN = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0);
  Ndiv : TN = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  {Последний байт для накопления...}
Procedure View(__N : TN);
var
  j1 : Word;
begin
  for j1 := 1 to 10 do
    Write(__N[j1]);
end;
Procedure Divide9;
var
  i1 : Word;
  _N : Extended;
begin
  _N := 0;
  for i1 := 9 downto 0 do
    _N := _N*10 + 1.0*N[10-i1];
  Ndiv[11] := Round(_N - Int(_N/9.0)*9.0);
  _N := _N / 9;
{  ___N := _N;}
  for i1 := 0 to 9 do
    begin
      Ndiv[10-i1] := Round(_N - Int(_N/10.0)*10.0);
      _N := Int(_N / 10);
    end;
end;
Function CheckDiv : Boolean;{Симметрично ли частное}
var
  q : Word;
  p : Boolean;
begin
  p := True;
  for q := 0 to 3 do
    p := p and (Ndiv[q+2] = Ndiv[10-q]);
    {q+1, q+2, q+3; q+2 ищет те, которые были нужны}
  CheckDiv := p;
end;
begin
  NCount := 0;
  NC9 := 0;
  asm
    mov ax, 3
    int 10h
  end;
  WriteLn;
  i := 1;
  j := 1;
  k := 1;
  Repeat
    i := 10;
    While N[i-1] > N[i] do dec(i);
    j := i - 1;
    h := N[j];
    While N[i+1] > h do inc(i);
    N[j] := N[i];
    N[i] := h;
    i :=j + 1;
    k := 10;
    While i < k do
      begin
        h := N[i];
        N[i] := N[k];
        N[k] := h;
        inc(i);
        dec(k)
      end;
    inc(NCount);
    if NCount mod 3000 = 0 then
    begin
      X := WhereX;
      Y := WhereY;
      GotoXY(1, 1);
      Write('NCount = ', NCount, ' NC9 = ', NC9, '                                        ');
      GotoXY(X, Y);
    end;
    Divide9;
    if CheckDiv then
      begin
        inc(NC9);
        Write('Число /');
        View(N);
{      Write(':', ___N:1:1);}
        Write('/, частное от деления на 9 = ');
        View(Ndiv);
        WriteLn;
      end;
    if Keypressed then
      if ReadKey = #27 then Break;
  Until j = 0;
  Write('Число перестановок: ', NCount);
  WriteLn(', число найденных чисел: ', NC9);
end.

{
Function CheckDif : Boolean;
var
  q, i : Word;
  p, p1 : Boolean;
begin
  p := True;
  p1 := False;
  for q := 0 to 9 do
    begin
      for i := 0 to 9 do
        p1 := p1 or (N[i] = q);
      p := p and p1;
      p1 := False;
    end;
    CheckDif := p;
end;

Procedure _inc;
var
  i : Word;
begin
  inc(N[0]);
  for i := 0 to 9 do
    begin
      if N[i] > 9 then
        begin
          inc(N[i+1]);
          N[i] := 0;
        end;
    end;
end;
  for k1 := 0 to 9 do
    for k := 0 to 999999999 do
      begin
        _inc;
        Divide9;
        if k mod 100000 = 0 then
        begin
          X := WhereX;
          Y := WhereY;
          GotoXY(1, 1);
          Write('k = ', k, '                                                     ');
          GotoXY(X, Y);
        end;
        if (Ndiv[10] = 0) and (CheckDiv) and (CheckDif) then
          begin
            Write('Число /');
            View(N);
            Write('/, частное от деления на 9 = ');
            View(Ndiv);
            WriteLn;
          end;
      end;

}

Назад