Задачи на перестановки Опции

[Unconnected]

Привет всем.

Меня заинтересовала задача из соседней темы, про перестановки в числах.

Задача 4 "Сумма двух чисел"
Имя входного файла: sum.in
Имя выходного файла: sum.out
Максимальное время работы на одном тесте: 2 секунды
Максимальный объем используемой памяти: 64 мегабайта

Заданы три числа: a, b, c. Необходимо выяснить, можно ли так переставить цифры в числах a и b, чтобы в сумме получилось c.

Формат входных данных
Входной файл содержит три целых числа: a, b, c (0 < a, b, c < 109). Числа разделены пробелом.

Формат выходных данных
Если искомая перестановка цифр возможна, необходимо вывести в выходной файл слово YES, в противном случае — выведите слово NO. При положительном ответе необходимо вывести во второй строке выходного файла число x, получаемое перестановкой цифр числа a, и число y, получаемое перестановкой цифр числа b, сумма которых равна c. Числа x и y не должны содержать ведущих нулей. Числа в строке разделены пробелом.
Примеры входных и выходных файлов
sum.in sum.out
12 31 25 ***YES***
**********12 13***


12 31 26 ***NO***

Вот что я сделал:

const m=6;

type st = string[3];

var a,b:st;
    m1,m2:array[1..m] of st;
    f:text;
    i,j:byte;
    buf1,buf2,c,code,aa,bb:integer;

Procedure generate(m:array of st;v:st);
var buf:char;
    i:byte;
begin
  if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
  i:=1;
  m[i]:=v;
  repeat
    inc(i);
    m[i][1]:=m[i-1][2];
    m[i][2]:=m[i-1][3];
    m[i][3]:=m[i-1][1];
  until (i=3);
  inc(i);
  m[i][1]:=m[1][1];
  m[i][2]:=m[1][3];
  m[i][3]:=m[1][2];
  repeat
    inc(i);
    m[i][1]:=m[i-1][2];
    m[i][2]:=m[i-1][3];
    m[i][3]:=m[i-1][1];;
  until (i=6);
end;

begin
  assign(f,'sum.in');
  reset(f);
  read(f,aa,bb,c);
  close(f);
  str(aa,a);
  str(bb,b);
  generate(m1,a);
  generate(m2,b);
  for i:=1 to m do
    begin
      val(m1[i],buf1,code);
      for j:=1 to m do
        begin
          val(m2[j],buf2,code);
          if (buf1+buf2=c) then begin
                                  assign(f,'sum.out');
                                  rewrite(f);
                                  writeln(f,'YES');
                                  write(buf1,' ',buf2,' ',c);
                                  close(f);
                                  halt;
                                end;
        end;
    end;
  readln;
  assign(f,'sum.out');
  rewrite(f);
  write(f,'NO');
  close(f);
end.

Мой алгоритм перестановок (для трёхзначных чисел) основан на том, что если в числе переносить первую цифру в конец, пока не получится исходное число, а потом поменять 2 и 3 цифры местами и сделать то же самое, то получатся все перестановки..

Например:
123
231
312
меняем,
132
321
213

Получилось 6 перестановок, как раз 3!, как и должно быть. Моя программа почему-то не заполняет корректно массив (процедура Generate).

Сообщение отредактировано: Unconnected - 18.01.2010 13:21

[volvo]

Моя программа почему-то не заполняет корректно массив (процедура Generate)

Потому что она у тебя вылетает за пределы этого массива: открытый массив индексируется с 0, а не с того индекса, который задан при описании типа. Соответственно, не до M, а до (M-1)... Включи контроль границ и убедись...

[Unconnected]

Получается, надо константу m сделать равной 7? Всё равно не заполняет..

[volvo]

Всё равно не заполняет..

Во-первых, я не совсем понял вот этот твой финт:

if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);

Зачем добавлять "0" и делать из 12 к примеру 120? Ну ладно, допустим... Но... Я бы сделал все-же так:
1)

type
     arrst = array [1 .. m] of st;

2)

procedure generate(VAR m:arrst;v:st);

и третье - скорее всего, главное, заполнял бы массив вот таким образом:

  i:=1;
  m[i]:=v;
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=3);

, понимаешь разницу между тем, что сделал я, и тем, что делал ты? В моем случае длина строки устанавливается корректно, в твоем - нет.

[Unconnected]

Короче, я решил... вроде бы... Добавил кое-что, код, конечно, не очень красивый, зато работает.

const m=6;

type st = string[3];

var a,b,cc:st;
    m1,m2:array[1..m] of st;
    ll:array[1..3] of byte;
    f:text;
    i,j:byte;
    buf1,buf2,c,code,aa,bb:integer;

Procedure generate(m:array of st;v:st;num:byte);
var buf:char;
    i:byte;
begin
  if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
  i:=1;
  m[i]:=v;
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=3);
  inc(i);
  m[i]:=m[1][1]+m[1][3]+m[1][2];
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=6);
  if (num=1) then for i:=1 to 6 do m1[i]:=m[i]
    else for i:=1 to 6 do m2[i]:=m[i]
end;

Function getlength(v:integer):byte;
var t:string[3];
begin
  str(v,t);
  getlength:=length(t);
end;

begin
  assign(f,'sum.in');
  reset(f);
  read(f,aa,bb,c);
  close(f);
  str(aa,a);
  str(bb,b);
  str(c,cc);
  ll[1]:=length(a);ll[2]:=length(b);ll[3]:=length(cc);
  generate(m1,a,1);
  generate(m2,b,2);
  if c<100 then c:=c*10;
  for i:=1 to m do
    begin
      val(m1[i],buf1,code);
      for j:=1 to m do
        begin
          val(m2[j],buf2,code);
          if (buf1+buf2=c) then begin
                                  assign(f,'sum.out');
                                  rewrite(f);
                                  writeln(f,'YES');
                                  if ll[1]<getlength(buf1) then
                                  repeat
                                    buf1:=buf1 div 10;
                                  until (ll[1]=getlength(buf1));
                                  if ll[2]<getlength(buf2) then
                                  repeat
                                    buf2:=buf2 div 10;
                                  until (ll[2]=getlength(buf2));
                                  if ll[3]<getlength© then
                                  repeat
                                    c:=c div 10
                                  until (ll[3]=getlength©);
                                  write(f,buf1,' ',buf2,' ',c);
                                  close(f);
                                  halt;
                                end;
        end;
    end;
  readln;
  assign(f,'sum.out');
  rewrite(f);
  write(f,'NO');
  close(f);
end.

Кстати, volvo, я так и не понял, почему твой код заполнения массива работает, а мой - нет? Мой ведь вроде бы на те же позиции копирует символы, только вручную, а твой просто присоединяет, вроде как и на те же места..

[volvo]

а твой просто присоединяет, вроде как и на те же места..

Мало просто скопировать символы... Надо еще и длину строки установить, если ты заполняешь строку вручную. А если делать так, как я показал - то это делает компилятор, тебе об этом можно не заботиться...

[Unconnected]

А как установить её, длину, вручную? Может, SetLength?

[volvo]

Может, SetLength?

Если у тебя 32-битный компилятор - то SetLength, если 16-битный - то прямой записью длины строки в ее нулевой байт...

[Unconnected]

Ого, не знал, спасибо за помощь

[Lapp]

Обычно в подобных случаях генерировать перестановки проще всего с помощью рекурсии. Вот, смотри:

const
  m=2;  //количество слагаемых
var
  c,i: integer;
  a: array [1..m] of record
    v,x: integer;
    s: string;
    d: set of byte
  end;
  f: text;

procedure Dig(n,k: integer);
var
  i,z: integer;
begin
  if k=0 then
    if n=m then begin
      z:=0;
      for i:=1 to m do z:=z+a[i].x;
      if z=c then begin
        WriteLn(f,'YES');
        for i:=1 to m do Write(f,a[i].x,' ');
        Close(f);
        Halt
      end
    end
    else Dig(n+1,Length(a[n+1].s))
  else with a[n] do for i:=1 to Length(s) do if not (i in d) then begin
    x:=x*10+Ord(s[i])-48;
    Include(d,i);
    Dig(n,k-1);
    Exclude(d,i);
    x:=(x-Ord(s[i])+48) div 10
  end
end;

begin
  Assign(f,'sum.in');
  ReSet(f);
  for i:=1 to m do with a[i] do begin
    Read(f,v);
    Str(v,s);
    d:=[];
    x:=0
  end;
  ReadLn(f,c);
  Close(f);
  Assign(f,'sum.out');
  ReWrite(f);
  Dig(1,Length(a[1].s));
  WriteLn(f,'NO');
  Close(f)
end.

Эта программа работает с числами любой длины и любым количеством слагаемых (но последнее нужно задавать заранее константой m).
Конечно, время работы несколько страдает.. Но при m=2, пролетает быстро; не исключено, что в 2 сек уложишься. Разберешься? Комменты по запросу .

[Lapp]

Unconnected, можно я выскажу несколько замечаний?
Во-первых, при входных данных:
53 10 135
- твоя программа выдает:
YES
35 10 135
- что неверно..

Далее, у тебя путаница в передачей массива в подпрограмму. Нужно сделать специальный тип и передавать его. Конструкция, которую использовал ты (array без пределов) в данном случае не годится, она служит другой цели и используется иначе. Я сделал изменения в твоем коде (помечено //), посмотри; так программа не вылетает при включенном range check.

Отступы.. Они должны быть ВСЕГДА на одну и ту же величину. Сдвиг НЕ ДОЛЖЕН зависеть от того, за чем он идет: var, type или begin в конце строки - всегда на одно и то же число позиций (обычно 2, но можно и 4) от начала предыдущей строки. Исключений нет. Точка.
Это было непререкаемое правило. А теперь совет..
Лучше писать begin (repeat, case..) не на новой строке, а на той же. Это не только позволяет сэкономить строчку и отступ, но - самое главное - позволяет практически исключить такую ситуацию:

for i:=1 to 5 do 
  begin
    a:=b;
    b:=1
  end;
c:=d;  // вот эта строчка начинается не с end, это плохо

Лучше так:

for i:=1 to 5 do begin
  a:=b;
  b:=1
end;   // блок закрывается end'ом
c:=d;  // теперь это обычная строка текста

Если пишешь так, то появление в коде сдвинутой влево строки, НЕ начинающеся с end - почти всегда признак ошибки. Блок всегда начинается со строки, заканчивающейся begin (repeat, case..) и заканчивается строкой, начинающейся с end (until), и его тело сдвинуто. Всякое отступление от этого правила - признак возможной ошибки. Исключения случаются (они вносятся обычно оператором if .. then .. else), но их тоже проще отловить, если точно следуешь этому правилу. Очень рекомендую привыкнуть к такому способу написания кода.

Теперь твоя программа, немного исправленная мной.

const
  m=6;

type
  tSt = string[3];               //
  tArSt = array[1..m]of tSt;     //

var
  a,b,cc: tSt;
  m1,m2: tArSt;                  //
  ll: array[1..3] of byte;
  f:text;
  i,j:byte;
  buf1,buf2,c,code,aa,bb:integer;

Procedure generate(m:tArSt; v:tSt; num:byte);     //
var
  buf:char;
  i:byte;
begin
  if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
  i:=1;
  m[i]:=v;
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=3);
  inc(i);
  m[i]:=m[1][1]+m[1][3]+m[1][2];
  repeat
    inc(i);
    m[6]:='123';
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=6);
  if (num=1) then for i:=1 to 6 do m1[i]:=m[i]
    else for i:=1 to 6 do m2[i]:=m[i]
end;

Function getlength(v:integer):byte;
var
  t:string[3];
begin
  str(v,t);
  getlength:=length(t);
end;

begin
  assign(f,'sum.in');
  reset(f);
  read(f,aa,bb,c);
  close(f);
  str(aa,a);
  str(bb,b);
  str(c,cc);
  ll[1]:=length(a);ll[2]:=length(b);ll[3]:=length(cc);
  generate(m1,a,1);
  generate(m2,b,2);
  if c<100 then c:=c*10;
  for i:=1 to m do begin
    val(m1[i],buf1,code);
    for j:=1 to m do begin
      val(m2[j],buf2,code);
      if (buf1+buf2=c) then begin
        assign(f,'sum.out');
        rewrite(f);
        writeln(f,'YES');
        if ll[1]<getlength(buf1) then repeat
          buf1:=buf1 div 10;
        until (ll[1]=getlength(buf1));
        if ll[2]<getlength(buf2) then repeat
          buf2:=buf2 div 10;
        until (ll[2]=getlength(buf2));
        if ll[3]<getlength© then repeat
          c:=c div 10
        until (ll[3]=getlength©);
        write(f,buf1,' ',buf2,' ',c);
        close(f);
        halt;
      end;
    end;
  end;
  readln;
  assign(f,'sum.out');
  rewrite(f);
  write(f,'NO');
  close(f);
end.

Надеюсь, ты сможешь извлечь из этого пользу )).
И жду исправления работы в описанной выше ситуации!

[volvo]

Далее, у тебя путаница в передачей массива в подпрограмму. Нужно сделать специальный тип и передавать его. Конструкция, которую использовал ты (array без пределов) в данном случае не годится, она служит другой цели и используется иначе.

А я уже говорил, что надо бы описывать тип (в сообщении №4 я назвал его arrst), но автор продолжает упорно использовать открытые массивы, из-за чего и огребает проблемы на ровном месте...

Посмотрим, получится ли у тебя его убедить...

[Unconnected]

Короче, переделал я вообще механизм программы, т.к. добавление нулей это, видимо, дохлый номер, из-за которого и получалась ошибка, приведённая Lapp'ом.

const
  m=6;

type
  tSt = string[3];
  tArSt = array[1..m] of tSt;


var a,b,cc:tst;
    m1,m2:tArSt;
    f:text;
    i,j:byte;
    buf1,buf2,c,code,aa,bb:integer;
    kol:array[1..2] of byte;

Procedure generate(m:tArSt;v:tst;num:byte);
var buf:char;
    i:byte;
begin
  i:=1;
  m[i]:=v;
  if length(v)=1 then kol[num]:=1;
  if length(v)=2 then begin
    kol[num]:=2;
    m[2]:=v[2]+v[1];
  end;
  if length(v)=3 then begin
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=3);
  inc(i);
  m[i]:=m[1][1]+m[1][3]+m[1][2];
  repeat
    inc(i);
    m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
  until (i=6);
  end;
  if (num=1) then for i:=1 to kol[num] do m1[i]:=m[i]
    else for i:=1 to kol[num] do m2[i]:=m[i]
end;

begin
  assign(f,'sum.in');
  reset(f);
  read(f,aa,bb,c);
  close(f);
  str(aa,a);
  str(bb,b);
  str(c,cc);
  generate(m1,a,1);
  generate(m2,b,2);
  for i:=1 to kol[1] do
    begin
      val(m1[i],buf1,code);
      for j:=1 to kol[2] do begin
          val(m2[j],buf2,code);
          if (buf1+buf2=c) then begin
                                  assign(f,'sum.out');
                                  rewrite(f);
                                  writeln(f,'YES');
                                  write(f,buf1,' ',buf2,' ',c);
                                  close(f);
                                  halt;
                                end;
      end;
    end;
  assign(f,'sum.out');
  rewrite(f);
  write(f,'NO');
  close(f);
end.

Про передачу в программу массива без пределов - просто я считал, что так и нужно передавать массивы в качестве входных параметров процедур\функций. Буду знать)

Lapp, за форматирование спасибо, приму к сведению (уже даже вроде бы принял, правя код)

С рекурсивным решением разберусь, мне как раз надо научиться делать такое.

[volvo]

Procedure generate(m:tArSt;v:tst;num:byte);

Ничего не забыл?

[Unconnected]

Мм нет вроде, а что, что-то забыл? Там массивы уже с типами..

[volvo]

Там не хватает слова Var... Не надо передавать в процедуру массив только как хранилище данных, заполнять его там, и тут же копировать в глобальную переменную. Ибо сразу возникает вопрос: а зачем ты вообще массив передаешь в процедуру?

Я в курсе, что ЗДЕСЬ (в данной программе) это работает... Но у тебя в процедуру передается лишний параметр, от которого можно избавиться (я про num). К тому же внутри процедуры моментально уберется лишний же цикл и условие... И вообще, это - неправильный путь. Правильный - работать с подпрограммами через параметры, а не через побочные эффекты...

И опять я убеждаюсь, что все, что делается мной на форуме пропускается мимо ушей... Я ж писал, "Как не надо писать программы", и там говорилось в частности о том, что надо избегать использования глобальных переменных, и о том, что переменная должна описываться как можно ниже в тексте программы - нет, опять этого никто не читает... Неинтересно? Заработало и ладно? Ну, что ж... Больше в этот процесс вмешиваться не буду, пишите, "чтоб работало, сдам и фиг с ним".

[Unconnected]

Да, и правда, если добавить var, то переписывание в глобальный массив становится ненужным... Только num всё равно передавать придётся, ибо с помощью него записывается длина v в массив длин.

volvo, у меня не такой опыт в программировании, чтобы сразу делать так, как правильнее, а не как в голову пришло.

[Lapp]

А я уже говорил, что надо бы описывать тип
...
Посмотрим, получится ли у тебя его убедить...

Извиняюсь, повторился. Но в данном случае каша маслом не испортилась, пациент все же скорее жив, чем мертв, в отличие от многих других )). Вдвоем убедим!

добавление нулей это, видимо, дохлый номер, из-за которого и получалась ошибка

Да, то, что лидирующие нули не нужно учитывать, довольно сильно меняет ситуацию. Я рыпнулся было делать перестановки, но быстро остыл и переключился на рекурсию. Не хочу сказать, что это невозможно или намного труднее, но все же требует внимательности в разработке алгоритма. А рекурсия - дубовый метод, много мозгов не требует )). Тут, правда, осложнение в том, что переставляемая строка разбита на участки (числа); это потребовало передачи двух параметров в рекурсивную процедуру. А тем более, начальные условия такие щадящие. [прошло полчаса] Ха, интересно! Я думал, что увеличение количества чисел резко замедлит работу программы. Но..
Например, вот такие входные данные:

1372 62 552 381 6924 91 1583 4973 21 8119 30504

(при m=10, разумеется) легко выдают ответ:

YES
1372 62 552 381 6924 91 1853 9437 21 9811 

- и увеличения времени на глаз не заметно! А штука в том, что.. Unconnected, сможешь ответить, почему?

[volvo]

Только num всё равно передавать придётся

Это тебе только кажется

ибо с помощью него записывается длина v в массив длин.

Это значит что? Ты просто "не умеешь это готовить". Вот твоя же программа, но туда кое-что добавлено, я комментариями оставил твой прежний вариант. И что, понадобилось передавать num?

const
  m=6;
type
  tSt = string[3];
  tArSt = record
    arr: array[1..m] of tSt;
    kol: byte;
  end;

    // kol:array[1..2] of byte;
Procedure generate(var m:tArSt;v:tst); // ;num:byte);
var buf:char;
    i:byte;
begin
  i:=1;
  m.arr[i]:=v;
  if length(v)=1 then m.kol:=1; // kol[num]:=1;
  if length(v)=2 then begin
    m.kol:=2;
    // kol[num]:=2;
    m.arr[2]:=v[2]+v[1];
  end;
  if length(v)=3 then begin
  repeat
    inc(i);
    m.arr[i]:=m.arr[i-1][2]+m.arr[i-1][3]+m.arr[i-1][1];
  until (i=3);
  inc(i);
  m.arr[i]:=m.arr[1][1]+m.arr[1][3]+m.arr[1][2];
  repeat
    inc(i);
    m.arr[i]:=m.arr[i-1][2]+m.arr[i-1][3]+m.arr[i-1][1];
  until (i=6);
  end;
  (*
  if (num=1) then for i:=1 to kol[num] do m1[i]:=m[i]
    else for i:=1 to kol[num] do m2[i]:=m[i]
  *)
end;

var a,b,cc:tst;
    m1,m2:tArSt;
    f:text;
    i,j:byte;
    buf1,buf2,c,code,aa,bb:integer;

begin
  assign(f,'sum.in');
  reset(f);
  read(f,aa,bb,c);
  close(f);
  str(aa,a);
  str(bb,b);
  str(c,cc);
  generate(m1,a); //,1);
  generate(m2,b); //,2);
  for i:=1 to m1.kol do // kol[1] do
    begin
      val(m1.arr[i],buf1,code);
      for j:=1 to m2.kol do begin // kol[2] do begin
          val(m2.arr[j],buf2,code);
          if (buf1+buf2=c) then begin
                                  assign(f,'sum.out');
                                  rewrite(f);
                                  writeln(f,'YES');
                                  write(f,buf1,' ',buf2,' ',c);
                                  close(f);
                                  halt;
                                end;
      end;
    end;
  assign(f,'sum.out');
  rewrite(f);
  write(f,'NO');
  close(f);
end.

[Lapp]

volvo, я понимаю твое возмущение:

пишите, "чтоб работало, сдам и фиг с ним".

- и я тебя поддерживаю, но Unconnected'а на этот раз это, вроде, не должно касаться, ибо эту задачу он стал делать, вроде как по собственной инициативе из чистого интереса )). На все требуется время, даже на запоминание азбучных истин . Лучше поддержать его порыв, мне кажется - впрочем, я не сомневаюсь, что ты это сделаешь ))..