IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задача на перестановки и минимальное число
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Kost

Репутация: -  0  +


В общем, такая задача. Есть какое-то произвольное число (количество цифр <=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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Профи
****

Группа: Пользователи
Сообщений: 705
Пол: Мужской

Репутация: -  20  +


Переводить из строки в число не надо, т.к. такого типа в паскале нет, чтоб 20 знаков умещалось. Надо дописать пару функций: разность между числами, представленными строкой, отношение ">", "<". Или поискать модуль работы с длиной арифметикой и выдернуть эти функции оттуда.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






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?
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 30.09.2020 14:12
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name