Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача на перестановки и минимальное число
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
1qsd
В общем, такая задача. Есть какое-то произвольное число (количество цифр <=20). В нем произвольным образом переставляются цифры. Потом находится модуль разности:
abs|число с переставленными числами - обратное к нему|
Таким образом находится много разностей модулей - и надо найти минимальную разность.
Причем, если минимальных разностей несколько, то требуется та, где число с переставленными числами - минимальное.

Вот я задачу вроде решил, но работает она только до количества цифр <=7. А надо, чтобы работала до <=20. Помогите

 Program Gsort;
procedure obr(var a,b:string);
var
 i:longint;
begin
b:='';
for i:=1 to length(a) do b:=a[i]+b;
end;

var
  s,st,str1,Ch1,Ch2: string;
  a: array[0..100] of integer;
  masMIN: array [1..10000] of longint;
  n,i,j,h,k,q,z: integer;
  stCh,str1Ch,MinRaz: longint;

begin
  z:=1;
  masMIN[1]:=0;
  readln(s);
  n := length(s);
  fillchar(a,sizeof(a),0);

  for i:=1 to n do a[i]:=i;

  repeat
    st:='';
    for i:=1 to n do
    begin
    st:=s[a[i]]+st;
    end;

    obr(st,str1);

    write('modul = |',st,' - ',str1,'| = ');

    val(st,stCh,q);
    val(str1,str1Ch,q);

    Ch1:=st;
    masMIN[z]:=abs(stCh-str1Ch);
    writeln(masMIN[z]);
    if z>1 then
    begin
     if masmin[z] < minRaz
        then
        begin
           Ch2:=st;
           MinRaz:=masmin[z];
        end;
     if (Ch2>Ch1) and ((masmin[z] < minRaz) or (masmin[z] = minRaz)) then Ch2:=Ch1;
    end;

    if z=1 then
    begin
      Ch2:=st;
      minRaz:=masMIN[1];
    end;
    inc(z);

    {readln;}

    i := n;
    while a[i-1]>a[i] do dec(i);
    j:=i-1;
    h:=a[j];
    while a[i+1]>h do inc(i);
    a[j]:=a[i];  a[i]:=h;
    i:=j+1; k:=n;
    while i<k do begin
       h:=a[i]; a[i]:=a[k]; a[k]:=h;
       inc(i); dec(k)
    end
  until j=0;

writeln('min raznost ', MinRaz);
writeln('min chislo ', Ch2);
readln;
end.

Malice
Переводить из строки в число не надо, т.к. такого типа в паскале нет, чтоб 20 знаков умещалось. Надо дописать пару функций: разность между числами, представленными строкой, отношение ">", "<". Или поискать модуль работы с длиной арифметикой и выдернуть эти функции оттуда.
Алена
1qsd,
const
  max_n = 20;

var
  mas: array[1 .. max_n] of byte;
  s: string;


procedure swap_it(I, K: integer);
var X: byte;
begin
  X := mas[I]; mas[I] := mas[K]; mas[K] := X;
end;

function abs_minus(s_num, s_inv: string): string;
const
  digits: string = '0123456789';
var
  T: string;
  i, X, InvX: integer;
  get: boolean;
begin
  if s_num < s_inv then begin
    T := s_num; s_num := s_inv; s_inv := T;
  end;

  get := false; T := '';
  for i := length(s_num) downto 1 do begin

    if get then begin

      X := pos(s_num[i], digits) - 2;
      if X < 0 then inc(X, 10);
      get := false;

    end
    else
      X := pos(s_num[i], digits) - 1;

    InvX := pos(s_inv[i], digits) - 1;

    get := InvX > X;
    if get then begin
      T := digits[(X + 10 - InvX) + 1] + T;
    end
    else T := digits[(X - InvX) + 1] + T;
  end;

  abs_minus := T;
end;

var
  s_number, s_inverse, s_result: string;
  s_min, s_inv_min: string;

  n, i, j, k: integer;
  p: integer;

begin
  writeln('enter number [1 .. 7 digits]: '); readln(s);
  n := length(s);

  s_min := '';
  for i := 1 to n do s_min := s_min + '9';

  for i := 1 to n do mas[I] := I;
  while True do begin

    s_number := ''; s_inverse := '';
    for p := 1 to n do begin
      s_number := s_number + s[mas[p]];
      s_inverse := s[mas[p]] + s_inverse;
    end;
    s_result := abs_minus(s_number, s_inverse);
    writeln(s_number, ' <--> ', s_inverse, ' :: ', s_result);

    if s_min > s_result then begin
      s_min := s_result; s_inv_min := s_inverse;
    end
    else
      if (s_min = s_result) and (s_inv_min > s_inverse) then begin
        s_inv_min := s_inverse;
      end;

    I := n;
    while (i > 0) and (mas[I] >= mas[I+1]) do dec(I);
    if I = 0 then break;

    for J := I + 1 to n do
      if mas[J] > mas[I] then K := J;
    swap_it(I, K);
    inc(I);
    J := N;

    while I < J do begin
      swap_it(I, J); inc(I); dec(J);
    end;
  end;

  writeln('min raznost ', s_min);
  writeln('min chislo ', s_inv_min);
end.

Оно вроде работает, только:
1. У меня почему-то стойкое ощущение, что в алгоритме вычитания строк у меня недочет, хотя поймать его мне не удалось.
2. Для 8-ми значного числа работает уже пару секунд, если не отключать вывод на экран. Представляешь, что будет при n = 20?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.