New(k);

         Чтобы освободить память, если указатель уже не будет нужен, используют

         Dispose(k);

         Операторы присваивания, арифметических операций и циклов похожи во многих языках, поэтому их описывать не стоит.

Реализация алгоритмов

Генерирование разбиений множества

         В табл.1 представлены разбиения для n=4, генерируемые следующим алгоритмом:

program razbienie_mnozhestwa(input,output);

var i,j,k,n:byte;wper:array[1..255]of boolean;

sled,pred,blok:array[1..255]of byte;

procedure write_razbienie; {процедура, выписывающая разбиение на экран}

var

 i,j:byte;

begin

 j:=1; {номер первого блока}

 repeat

  write('( ');

  for i:=j to n do if blok[i]=j then write(i, ' '); {если число і из блока j, то пишем это число}

  j:=sled[j]; {следующий по номеру блок}

  write(')');

 until j=0;

 WRITELN

end;

begin

 write('input n:');

 readln(n); {вводим количество элементов множества}

 for i:=1 to n do begin {строим разбиение {{1, …, n}}}

  blok[i]:=1;

  wper[i]:=true

 end;

 sled[1]:=0;

 write_razbienie; {выписать разбиение}

 j:=n; {активный элемент}

 while j>1 do begin {задача цикла – перемещение «активного» элемента j в соседний блок – в предыдущий или последующий (в последнем случае может возникнуть необходимость создания нового блока вида {j}, а затем определение активного элемента во вновь образованном разбиении}

  k:=blok[j]; {процесс переноса активного элемента; k – номер активного блока}

  if wper[j] then begin {j движется вперёд}

   if sled[k]=0 then begin {k – последний блок}

    sled[k]:=j; {j – одноэлементный блок}

    pred[j]:=k;

    sled[j]:=0

   end;

   if sled[k]>j then begin {j образует новый блок}

    pred[j]:=k; {все блоки справа от блока с номером k содержат элементы, большие j. Отсюда следует, что j образует новый одноэлементный блок}

    sled[j]:=sled[k];

    pred[sled[j]]:=j;

    sled[k]:=j

   end;

   blok[j]:=sled[k] {переносим наш элемент в активный блок с номером k}

  end

  else begin {j движется назад}

   blok[j]:=pred[k]; {помещаем j в предыдущий блок}

   if k=j then if sled[k]=0 then sled[pred[k]]:=0 else begin

    sled[pred[k]]:=sled[k];

    pred[sled[k]]:=pred[k]

   end

  end;

  write_razbienie;

  j:=n;

  while(j>1)and

   ((wper[j]and(blok[j]=j))or(not wper[j]and(blok[j]=1))) do begin

   wper[j]:=not wper[j];

   dec(j)

  end

 end

end.

         Количество всех разбиений можно посчитать используя числа Белла и рекуррентную формулу (5).

Генерирование всех понятий

         Для реализации данной задачи на Pascal’е вводим следующие типы данных и переменных:

         1) тип k – указатель на запись, поля которой: s – будет содержать понятие; p – количество элементов в понятии; next – ссылка на следующее понятие;

2)     переменные f,  pot типа k; f – указывает на первое понятие, то есть на простое понятие *; pot – текущее понятие;

3)     массив str1 типа k – будет содержать ссылки на каждое понятие в составном понятии;

program dyscretics_optimisation(input,output);

uses crt;

const

 max=12;

 r:byte=0;

type

 k=^el;

 El=record

  S: string;

  P: 1..Max-1;

  Next: k

 End;

Label met;

Var

 Pot, f, l: k;

 Str1: array[1..Max]of k;

 Pow: 2..Max;

 K1, i, j, ll: 1..Max;

 Sum: 0..Max;

 Fil: text;

 Ki: string[2];

begin

 Readln(POW); {вводим количество простых понятий}

 Str(POW, ki);

 Assign(fil, ki+'.mvp'); {получившиеся понятия будем                                записывать в файл, содержащий в своём имени количество элементов множества и с расширением «.mvp»}

 Rewrite(fil);

 New(f); {выделяем память под первое понятие}

 Pot:=f;

 F^. S:='*'; {и инициализируем его}

 F^. P:=1;

 New(f^.next); {выделяем память под второе понятие}

 Pot:=f^.next;

 Pot^.s:='(*)'; {и также его инициализируем}

 Pot^.p:=1;

 Pot^.next:=nil;

 for i:=2 to POW do begin {основной цикл программы}

  For j:=1 to i do str1[j]:=f; {устанавливаем начальные указатели понятия, размерности і, на первое понятие}

  If i=POW then str1[1]:=f^.next; {если і равно количеству элементов множества, то необходимо изменить указатель на первое подпонятие нашего понятия, так как уже отмечалось выше, понятие, состоящее только из простых подпонятий выводить не надо. Но, такие понятия оставляем для подзадач меньшей размерности, так как в комбинации с решениями других подзадач, получим уже понятие, содержащее не только простые понятия}

  While str1[1]<>nil do begin {пока указатель первого подпонятия не достигнет конца списка подпонятий выполнять}

   New(pot^.next); { выделить память под очередное понятие}

   Sum:=0; {эта переменная служит в качестве счётчика, который после следующего цикла будет содержать количество элементов в новом понятии}

   K1:=1; {номер первого подпонятия. Первое подпонятие имеет всегда, если можно так выразиться, «более поздний адрес», или, точнее, все подпонятия, следующее за первым, получены раньше или одновременно с ним. Это также касается второго подпонятие относительно третьего, четвёртого и т. д., третьего относительно четвёртого, пятого и т. д., и т. д.}

   If i=pow then pot^.next^.s:='' else pot^.next^.s:='('; { если і равно количеству элементов множества, то нам не нужны скобки в начале (их договорились опустить)}

   While sum<i do begin {пока количество элементов в новом понятии меньше размерности подзадачи, выполнить}

    Pot^.next^.s:=pot^.next^.s+str1[k1]^.s; {добавить в понятие подпонятие с номером k1}

    Sum:=sum+str1[k1]^.p; {добавить размерность, добавленного подпонятия}

    Inc(k1); {увеличить k1 на 1}

   End;

   If(sum>i)or(k1=2) then begin {если количество элементов полученного понятия больше размерности задачи или k1=2, то есть добавлено только одно понятие в подпонятие, то, чтобы избежать лишних скобок и неправильных решений выполнить}

    Dispose(pot^.next); {освободить память, занимаемую этим «неправильным» понятием}

    Pot^.next:=nil;{указать, что предыдущее понятие было последним}

    If k1=2 then break {если k1=2, то выйти из основного цикла программы}

   End

   Else begin

    If i=POW then begin   {если размерность текущей подзадачи равна размерности основной задачи, то}

     Writeln(fil, pot^.next^.s); {записать понятие в файл}

     Writeln(pot^.next^.s); {и вывести на экран}

     Dispose(pot^.next); {освободить память, занимаемую понятием, так как понятия размерности задачи нам більше не понадобятся}

     Pot^.next:=nil

    End

    Else begin {иначе инициализируем понятие до конца}

     Pot:=pot^.next;

     Pot^.s:=pot^.s+')'; {закрываем скобку}

     Pot^.next:=nil; {указываем, что это понятие последнее в списке}

     Pot^.p:=I {указываем количество элементов, содержащихся в понятии}

    End

   End;

   For j:=k1-1 downto 2 do begin {k1 сейчас показывает количество подпонятий последнего понятия плюс 1. Поэтому в этом цикле, который попытается определить следующую комбинацию понятий и используется переменная k1. Эта часть программы рассматривает случай, когда подпонятия будут ставать не следующими по списку подпонятиями (по крайней мере не все), а будут происходить другие переходы. То есть этот цикл рассчитан на то, чтобы не позволить подпонятию с большим номером по списку в понятии быть большим по абсолютному адресу (по времени создания)}

    If (str1[j]^.next=str1[j-1]) and                      (str1[j+1]=str1[j]) or ((j=k1-1) and (str1[j]<>

Str1[j-1])) then begin {если за подпонятием с номером j по списку следует подпонятие с номером j-1 и подпонятия с номером j и j+1 совпадают, или j равно количеству подпонятий и последние два понятия совпадают (сравнение идет по абсолютным адресам расположения понятий в памяти), то}

      str1[j]:=str1[j]^.next; {подпонятие с номером j переходит на следующее за списком подпонятие}

      For j:=J+1 to k1-1 do str1[j]:=f; {а все следующие подпонятия, становятся равными первому (элементарному) подпонятию}

      goto met {хотя применение оператора безусловного перехода считается плохим стилем программирования, но здесь он оправдан, дабы не запутывать программу новыми циклами}

     End;

   End;

   For j:=k1-1 downto 2 do begin { новый цикл, который переключит соответствующие подпонятия. Мы выделяем это в новый цикл, так как нужно было проверить на наличие “граничных” переходов (см. предыдущий цикл)}

    If str1[j]<>str1[j-1]then begin { если подпонятия с номерами j и (j-1) не совпадают, то}

     Str1[j]:=str1[j]^.next; {подпонятие с номером j становится следующим по списку (времени создания подпонятием)}

     For j:=j+1 to k1 do str1[j]:=f; {а все идущие за ним подпонятия в списке подпонятий, составляющих понятие становятся элементарными}

     goto met {выходим из цикла}

    End

   End;

   Str1[1]:=str1[1]^.next; {если не выполнились условия предыдущих двух циклов, то пора переключать первое подпонятие}

 for j:=2 to i do str1[j]:=f; {и, соответствено, следующие подпонятия сделать элементарными}

Met: end

 End;

 Close(fil);{закрыть файл}

 Repeat {и}

  Pot:=f^.next;

  Dispose(f); {освободить память, занимаемую списком всех возможных подпонятий}

  F:=pot

 Until f<>nil

end.

Литература

        1. В. Липский, Комбинаторика для программистов, пер. с польского, М. – Мир,1988

Страницы: 1, 2