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

[Unconnected]

А рекурсия - дубовый метод, много мозгов не требует )).

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

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//1-е условие выхода.Длина слагаемого будет 0-ой тогда,когда будет (Dig(n,k-1); k=1) 
    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))//если n-ый элемент был обработан, но есть ещё эл-ты, то обрабатываем следующий
  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);//здесь самое интересное и непонятное, видимо, собственно запись в a[i].x нужного числа.
    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);//v-численное представление слагаемого, s - строчное.
    Str(v,s);
    d:=[];
    x:=0
  end;
  ReadLn(f,c); //считываем сумму
  Close(f);
  Assign(f,'sum.out');
  ReWrite(f);
  Dig(1,Length(a[1].s)); //первый запуск процедуры,передаётся единица,т.е берем 1е слагаемое, и длина первого слаг-ого
  WriteLn(f,'NO'); //выводим NO,ибо если a+b=c выполнится,то сюда исполнение не дойдёт
  Close(f)
end.

Мне понравилась строка Ord(s[i])-48, получается, это быстрый способ перевести строку с цифрой в цифру.
Куда мне анализировать, почему время не увеличивается - я в механизм работы въехать не могу..)) Хотя, меня преследует ощущение, что в цикле else with a[n] do for i:=1 to Length(s) do if not (i in d) then begin всегда будет обрабатываться только 1ый символ, но это мои интуитивные домыслы конечно)) К ним я пришёл, расписав на бумаге значения переменных при двух двузначных слагаемых. Наверное, ошибся где-то.

Запрос. На комментарии:)

И что, понадобилось передавать num?

Не понадобилось, так лучше.

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

[Unconnected]

//подновил время, правил пост

[Lapp]

К моим мозгам она чересчур требовательна))

Ошибаешься; ниже убедишься.

Короче, я попробовал для начала понять, что она делает эта рекурсия, расставил примерные комментарии..

От комментариев мало толку, если они просто выражают словами то, что написано на языке. Старайся вложить в комменты больше смысла. Я понимаю, что тут ты не мог это сделать, это на будущее для собственных прог )).

Куда мне анализировать, почему время не увеличивается - я в механизм работы въехать не могу..))

Для этого не нужно глубоко въезжать в алгоритм. С этого и начнем..
Каков бы ни был олгоритм - это все равно перебор. Согласен? Этого знания достаточно.
На первый взгляд кажется, что такие совпадения (описанные в условии, когда сумма равна заданному числу) должны быть достаточно редки. И поэтому когда я подготавливал входные данные, я делал так:
- пишу несколько слагаемых (10 штук, для этого нужно заменить тип integer на LongInt в слагаемых и сумме);
- считаю их сумму и приписываю ее сзади;
- перемешиваю цифры в слагаемых.
Такой способ, конечно, гарантирует ответ YES при правильной работе программы. После этого я запускал прогу.. и она выдает ответ через мгновение. Почему?
Во-первых, я заметил, что ответ не тот, который я поготовил, а другой. Я решил: повезло, оказался еще один ответ! - и немного изменил данные (слагаемые и сумму, чтоб снова гарантировать ответ). И снова аналогичный результат. Вот тогда я, наконец, дал себе труд подумать минуту..
Собственно, минуты не потребовалось. У меня 10 слагаемых, каждое от 2 до 4 знаков. Всего примерно 30 цифр. Сколько существует перестановок 30 цифр? Ответ: бешеное количество, а именно 30!. Даже если учесть, что из этих 30 цифр всего 10 различных, их число все равно остается фантастическим. Это число гораздо больше самой суммы, и больше длины диапазона, в котором сумма может меняться. Что это означает? То, что:
1. если мы наобум напишем слагаемые и сумму, ответ с подавляющей вероятностью будет YES;
2. на каждую сумму существует не просто несколько, а очень много разных комбинаций, удовлетворяющих условию.
Это понятно? Если нет, перечитай, пока не разберешься. А когда разберешься, сразу станет само собой понятно, что программа находит первую из очень многих комбинаций, удовлетворяющих решению, и для этого ей не требуется слишком много времени. Поскольку ей нет нужды сканировать все комбинации. А раз валидных комбинаций много, значит, скорее всего есть и вблизи начала поиска.. )

Когда это все промелькнуло в моей голове (как задница того комара, который налетел на лобовое стекло), я просто закомментировал две строчки в проге:

// close(f);
// Halt;

- рассудительно решив, что уж теперь-то истинное время работы программы (перебор всех возможных комбинаций) от меня не уйдет.. Хрен-та! Я запустил прогу, увидел, что она действительно не вышла сразу, прикрыл окошко и пошел заниматься чем-то другим. Когда я минут через 20-30 снова заглянул в то окно, программа все работала. Я прервал ее по Ctrl-C и пошел в Far смотреть выходной файл. Его размер был 50 МБ, в нем было больше миллиона строк.. То есть программа уже нашла примерно миллион решений и прилежно продолжала искать остальные - видимо, полагая, что мне это жизненно важно )). Думаю, она делала бы это всю мою оставшуюся жизнь..

Забавно, что при небольшом числе слагаемых и цифр результат как раз обратный: получить заранее заданную сумму двух двузначных числе посредством перестановок их слагаемых намного труднее. По-видимому, мозг улавливает этот факт и потом пропорционально его масштабирует. То есть происходит нечто подобное тому, что мешает нормальным людям понять Теорию Относительности: мозг основывается на чувственном опыте и с большим трудом поддается перестройке под давлением разумной агументации..

Про рекурсию напишу чуть-чуть позже..

[Lapp]

Так, процесс в целом нам стал более понятен, теперь можно перейти к более техническим вопросам

Запрос. На комментарии:)

RFC? Ok.
Давай я лучше попробую описать способ. Думаю, это будет полезнее.

Для начала забудем про рекурсию. Рекурсия не должна быть самоцелью. Она должна появиться сама собой из естественного пути решения.

Итак, у нас есть набор цифр, записанных в массив (или строку, что то же самое). Нам нужно найти все возможные перестановки. Как?
Извини, но твой способ не совсем ... мм.. удобный, а точнее - неуниверсальный. Давай действовать иначе.. Всего у нас n позиций. На первую мы ставим в цикле по очереди все имеющиеся цифры (элементы массива цифр). Далее, на каждом конкретном шагу этого цикла мы ставим на вторую позицию все элементы массива цифр, кроме того, который поставили на первую. То есть вложенный цикл с проверкой. Если позиций больше двух, повтояем то же самое. Вот пример для перемешивания цифр в 4-значном числе:

a:='2601';
n:=Length(a);  // 4
r:='';
for i1:=1 to n do begin
  r:=r+a[i1];
  for i2:=1 to n do if i2<>i1 then begin
    r:=r+a[i2];
    for i3:=1 to n do if (i3<>i1)and(i3<>i2) then begin
      r:=r+a[i3];
      for i4:=1 to n do if (i4<>i1)and(i4<>i2)and(i4<>i3) then begin // этот цикл можно заменить просто на i4:=10-i3-i2-i1
        ProcessIt; // перемешивание завершено, тут проверка условия задачи и вывод результата
      end
    end
  end
end;

Все просто и понятно, так ведь? Вложенный цикл, причем вложенность равна длине (значности) исходного числа. Но, со всеми преимуществами, налицо и один недостаток. Дело в том, что Паскаль не допускает чего-то типа "вложенности переменной длины". И что же, нам для каждой длины делать свой фрагмент кода?? Вообще-то, не такой уж и абсурдный вариант, как кажется на первый взгляд. Длин будет вряд ли больше 1 - 2 десятков - так, что же? В исходной задаче вообще можно было ограничиться двумя вариантами (двузначные и трехзначниые) - разве это много? Определяем длину числа и переводим стрелки на нужный кусок программы..
Это, конечно, некрасиво .. И никто не гарантирует, что в другой задаче не будет большего числа вариантов, типа сто или тысяча. Как быть?

Путей для разрешения этой проблемы несколько.
Первый, самый банальный..
На каждом этапе вложенности делать проверку глубины. Глубину мы можем отслеживать с помощью некоторой специальной переменной, назовем ее Depth. При входе на очередной уровень, мы инкриминируем эту переменную и сравниваем ее с максимальной глубиной (равной длине числа). Приведенный мной выше кусок можно модифицировать в соответствии со сказанным так, что он будет работать для длин от 1 до 4:

a:='2601';
n:=Length(a);  // 4
Depth:=0;
r:='';
for i1:=1 to n do begin
  r:=r+a[i1];
  Inc(Depth);   // увеличиваем глубину
  if Depth=n then ProcessIt else for i2:=1 to n do if i2<>i1 then begin
    r:=r+a[i2];
    Inc(Depth);   // увеличиваем глубину
    if Depth=n then ProcessIt else for i3:=1 to n do if (i3<>i1)and(i3<>i2) then begin
      r:=r+a[i3];
      Inc(Depth);   // увеличиваем глубину
      if Depth=n then ProcessIt else for i4:=1 to n do if (i4<>i1)and(i4<>i2)and(i4<>i3) then begin
        ProcessIt
      end;
      Dec(Depth);   // выныриваем
    end;
    Dec(Depth);   // выныриваем
  end;
  Dec(Depth);   // выныриваем
end;

Здесь мы избежали дублирования больших кусков кода, но нам пришлось несколько раз (в схожей ситуации) вызывать процедуру обработки результата, что тоже несколько коробит.. Да и сам по себе вложенный цикл тоже не радует глаз: мы должны предусмотреть вложенность, равную максимально возможной длине числа. В нашем примере это всего лишь 3, но будем смотреть шире!

Я сказал, что путей у нас не один. Что еще мы можем придумать? Строго говоря, есть еще средства.. Например, мы можем организовать схему с одним циклом, но со сложным манипулированием индексом. То есть в тотмомент, когда по индее нужно было бы войти во вложенный цикл мы будем сохранять текущий индекс в специальном массиве (длины, равной длине числа) и присваивать ему начальное значение (единицу). Тем самым цикл уже будет совсем другим, новым. Затем, когда нужно выходить из вложенного цикла, мы будем вынимать заранее сохраненное значение из массива - то есть возвращаться на предыдущий уровень. Цикл при этом будет продолжаться, как ни в чем ни бывало.. Индексом того массива для запоминания параметра цикла будет служить все та же Depth.
Схема вполне осуществимая, хотя и не самая простая. В чем ее суть? В том, что мы повторно используем код несколько раз. Сначала для одного цикла, потом для вложенного, потом для следующего вложенного.. Код один, но параметр цикла, поскольку он сохраняется и перекладывается туда-обратно, различный на разных этапах. Не надо сейчас сразу бросаться писать код для этого алгоритма, просто уясни, что такая схема вполне осуществима.

Уяснил? Продолжаем.
На чем мы остановились? На том, что максимально увеличили КПД написанного нами кода, посредством использования его с различными данными (вспомни, что программа=алгоритм+данные). Позвольте, но ведь в Паскале уже есть средство для этого! Это средство называется процедура/функция. Она делает как раз то, что мы хотим: выполняет тот же самый код с разными данными! Эти данные передаются в параметрах. При этом старые параметры никуда не деваются, не забываются, не затираются, а остаются в стэке. Таким образом, нам даже не нужно будет сохранять параметр цикла (и другие данные, если потребуется) в специально подготовленном для этого массиве! И сам массив, выходит, нам тоже не нужен.

Давай ближе к делу. Нам нужно организовать вложенный цикл? Хорошо. Мы сделаем процедуру, которая содержит цикл. А в том месте, в котором мы должны были бы перейти к вложенному циклу, мы просто поставим вызов этой же самой процедуры. При этом процедура работает с глобальными параметрами (кроме переменной цикла), так что все тип-топ, никакой пуницы. Вот она, рекурсия, и вылезла - сама собой, причем в полной красе )). Осталось добавить только еще одну маленькую деталь..

Когда вложенные циклы написаны явно, у нас практически нет опасности зациклиться: мы пройдем каждый цикл и в конце концов выйдем. Если же мы просто будем вызывать и вызывать нашу рекурсивную процедуру, входя все глубже и глубже, то как мы будем вылезать обратно?? Вот тут все-таки нужно использовать специальную переменную, которую в принципе можно организовать по-разному, но обычно удобно передавать как параметр рекурсивной процедуры. Если устроить процедуру так:

procedure Recurse(l:integer);
begin
  if l<Depth then begin
    ... // тут цикл
      Recurse(l+1);  // вызываем с увеличением параметра
    ...
  end
  else ProcessIt;  // максимальная глубина достигнута, производим обработку
end; 

- то никакого зацикливания не получится. По достижении максимальной вложенности мы вместо очередного вызова процедуры (то есть вместо следующего вложения цикла) произведем обработку результата и выйдем.

Боюсь, меня сегодня уже не хватит на написание комментов к той проге, чтобы от теории перейти наконец к практике. Если это по-прежнему требуется (?), я сделаю потом .

[Unconnected]

Lapp, спасибо огромное!! Это редкий случай, когда в статье (тянет на неё) я понял всё, от начала до конца)) Только прочитал первый пример с циклами, и уже понял, для чего множество там и всё остальное)) У меня, кстати, была мысль, ещё в начале, что когда слагаемых так много, то будет явно больше одной комбинации..

Большой плюс тебе:)

Добавлено через 19 мин.
Я, кажется, подловил твою программу

Например, входные данные: 1111 11 111 111 1111 111 1111 1111 122 5000
Прога задумалась.

Слагаемых столько же. Но, как я понял, нужных комбинаций намного меньше, и они заключаются в последнем слагаемом, а до него ещё дойти надо_)

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

[Unconnected]

Я тут решил для закрепления решить сам задачку на рекурсию, тоже на перестановки (поэтому в этой же теме пишу), задача такая:

Неподвижные точки
(Время: 1 сек. Память: 16 Мб Сложность: 57%)

Перестановкой P[1..n] размера n называется набор чисел от 1 до n, расположенных в определенном порядке. При этом в нем должно присутствовать ровно один раз каждое из этих чисел. Примером перестановок являются 1,3,4,5,2 (для n=5) и 3,2,1 (для n=3), а, например, 1,2,3,4,5,1 перестановкой не является, так как число 1 встречается два раза.

Число i называется неподвижной точкой для перестановки P, если P[i] = i. Например, в перестановке 1,3,4,2,5 ровно две неподвижных точки: 1 и 5, а перестановка 4,3,2,1 не имеет неподвижных точек.

Даны два числа: n и k. Найдите количество перестановок размера n с ровно k неподвижными точками.
Входные данные

Входной файл INPUT.TXT содержит два целых числа n (1 ≤ n ≤ 9) и k (0 ≤ k ≤ n).
Выходные данные

В выходной файл OUTPUT.TXT выведите ответ на задачу.
Примеры
№ INPUT.TXT OUTPUT.TXT
1 5 2 20
2 9 6 168
3 2 1 0
4 9 0 133496

Получилось это:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var i,len,kol:byte;
    f:textfile;
    s:string;
    d:set of byte;
    rkol:integer;


procedure rekur(lk:byte);
var i1,b:byte;
    res:string;
begin
  res:='';
  if (lk=len) then begin
    b:=0;
    for i1:=1 to lk do if (res[i1]=inttostr(i1)) then inc(b);
    if (b=kol) then inc(rkol);
    res:='';
  end
  else for i1:=1 to lk do if not(i1 in d) then begin
         res:=res+s[i1];
         include(d,i1);
         rekur(lk+1);
         exclude(d,i1);
        end;
end;

begin
  rkol:=0;
  d:=[];
  assignfile(f,'input.txt');
  reset(f);
  read(f,len,kol);
  close(f);
  if (kol>0) then for i:=1 to kol do s:=s+inttostr(i);
  for i:=kol+1 to len do s:=s+inttostr(i-1);
  rekur(1);
  assignfile(f,'output.txt');
  rewrite(f);
  writeln(f,rkol);
  closefile(f);
end.

Вылетает с каким-то неизвестным исключением (an unhabled win32 exception) Подскажите, в чём ошибка?

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

[volvo]

Подскажите, в чём ошибка?

  res:='';
  if (lk=len) then begin
    b:=0;
    for i1:=1 to lk do if (res[i1]=inttostr(i1)) then inc(b); // <--- Вот в этом...

У тебя строка пустая (сам же ее опустошил ), значит обращение к любому ее элементу уже вызовет ошибку

[Unconnected]

Ага, теперь нормально, только на входных данных 5 2 ответ 1 выдаёт, мол только одна возможная перестановка, а их 20.

[volvo]

P.S.

Вылетает с каким-то неизвестным исключением (an unhabled win32 exception)

Не совсем так... Это не неизвестное исключение. Оно просто необработанное (unhandled). Если бы ты обернул это все в try/except - получил бы диагностику ошибки (т.е., обработал бы выброшенное исключение)

Добавлено через 48 сек.

Ага, теперь нормально

Хм... Ну, так покажи, как оно стало нормально Что исправил?

[Unconnected]

Нормально - в смысле ошибка не вылетает:) А результат неправильный даёт. Убрал res:=''; перед if (lk=len) then begin ..

[volvo]

А результат неправильный даёт.

Еще бы... У тебя переменная res описана локально, значит, хранит мусор. А ты содержимое этого мусора сравниваешь с какими-то значениями. Тебе еще повезло, что не вылетает. Окажется эта самая локальная строка короче чем lk символов - получишь опять вылет...

[volvo]

P.S. На самом деле, твоя задача может решаться вот так:

uses sysutils;
const
  len = 5;
  count = 2;

var
  s: string;
  res: integer;

procedure rec(s: string);
var
  ts: string;
  i, b: integer;
begin
  if length(s) = len then begin
    b := 0;
    for i := 1 to length(s) do
      if strtoint(s[i]) = i then inc(b);
    if b = count then inc(res);
  end
  else
    for i := 0 to length(s) do
    begin
      ts := s;
      insert(inttostr(length(s) + 1), ts, i + 1);
      rec(ts);
    end
end;

begin
  res := 0;
  rec('');

  writeln(res);
end.

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

Естественно, от IntToStr и StrToInt надо будет избавиться, они только замедляют выполнение, но чтобы разобраться что к чему, они подходят больше, чем непосредственное конвертирование. Да... Работу с файлами я не стал добавлять, задал значения константами. Для отладки - гораздо удобнее (по крайней мере мне).

[Unconnected]

Ого.. решение короче намного, без множества и заполнение строки происходит прямо в функции.. Только сейчас, кстати, я понял, что мог бы и не заполнять заранее строку так, чтобы там были две "неподвижные" точки - можно было просто перебирать всё - немного, 5! - и считать неподвижные точки. Примерно я этот алгоритм понял - потрассировав немного - те же перестановки, только основанные на длине строки-параметра. И всё же, можно услышать, что было неправильно в моей функции?

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

[volvo]

И всё же, можно услышать, что было неправильно в моей функции?

Смотри. Начинаем с генерации строки S. Что у тебя в результате получается, для kol = 5, расскажи? У тебя получается строка "12234". Это что значит? Вообще по твоей задумке, что должна содержать строка S? Все символы, которые потом будут во всех вариациях переставляться, или что?

[Unconnected]

Да, сначала я хотел заполнить строку с двумя неподвижными точками и чтобы нашлись все возможные вариации и посчиталось количество нужных мне вариантов. Только я не учёл, что там не только цифры от 1 до k-1 могут быть. Я имею в виду, на Подвижных позициях. Поздно что-то дошло..))

[Lapp]

редкий случай, когда в статье (тянет на неё) я понял всё, от начала до конца))

Это и была моя цель )).

Я, кажется, подловил твою программу
Например, входные данные: 1111 11 111 111 1111 111 1111 1111 122 5000
Прога задумалась.

Да подловить несложно. Можно просто написать в качестве суммы число, которое заведомо не получится (типа 2 или -5 )) и заставить ее написать NO (через пару годиков работы)).

Правильно я понимаю, что комменты уже не нужны?

[Unconnected]

Правильно я понимаю, что комменты уже не нужны?

Ага, правильно. Надеюсь, эта тема поможет ещё кому-то понять рекурсию:)

[Unconnected]

И снова я... Уж очень хочется что-то самому полностью решить, рекурсивно)

Задача про Дед-Мороза.

Ириска весит X грамм, мандарин – Y грамм, пряник – Z грамм.

Требуется написать программу, которая определит, сколько различных вариантов подарков весом ровно W грамм может сделать Дед Мороз.
Входные данные

В единственной строке входного файла INPUT.TXT содержится четыре целых числа X, Y, Z и W (1 ≤ X, Y, Z ≤ 100, 1 ≤ W ≤ 1000).
Выходные данные

Выходной файл OUTPUT.TXT должен содержать одно целое число – количество вариантов подарков.
Пример
№ INPUT.TXT OUTPUT.TXT
1 10 25 15 40 3

uses sysutils;
{$APPTYPE CONSOLE}
var f:textfile;
    s:string;
    r,w,res,rr:integer;
    m:array[1..3] of byte;

procedure rek(lk:byte);
var i:byte;
begin
  writeln(inttostr(res));
  if (lk=4)or(res=w) then begin
    if (res=w) then begin
      inc(rr);
    end; 
  end else for i:=1 to lk do begin
        res:=res+m[i];
        rek(lk+1);
        res:=res-m[i];
      end;
end;

begin
  assignfile(f,'input.txt');
  reset(f);
  read(f,m[1],m[2],m[3],w);
  closefile(f);
  res:=0;
  rek(1);
  assignfile(f,'output.txt');
  rewrite(f);
  writeln(f,rr);
  closefile(f);
end.

Короче идея в том, чтобы в переменную res суммировать вес сладостей, по очереди, чтобы получились все возможные комбинации, а потом проверять общий вес. Также учтено, что вес могут составлять не обязательно 3 подарка. Я долго мучил этот код, он, как я понял, не все варианты перебирает.. Подскажите пожалуйста на словах, что не так:)

[Unconnected]

Короче я вроде бы разобрался, уже несколько задач сам решил... А про Деда Мороза решение такое:

var f:textfile;
    s:string;
    r,w,res,rr:integer;
    m:array[1..3] of byte;

procedure rek(lk:byte);
var i:byte;
begin
  if (lk=4) then begin
    if (res=w) then begin
      inc(rr);
    end;
  end else for i:=1 to 3 do begin
        res:=res+m[i];
        rek(lk+1);
        res:=res-m[i];
      end;
end;

begin
  assignfile(f,'input.txt');
  reset(f);
  read(f,m[1],m[2],m[3],w);
  closefile(f);
  res:=0;
  rek(1);
  assignfile(f,'output.txt');
  rewrite(f);
  writeln(f,rr);
  closefile(f);
end.

Lapp и Volvo, еще раз спасибо за помощь:)

Сообщение отредактировано: Unconnected - 20.01.2010 22:29