// Generowanie podzbiorów zbioru n-elementowego za pomocą Kodu Grey’a.
// www.algorytm.org
// (c) 2006 Krzysztof Kwiatkowski

program kod_graya;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
    vector = array[1..10] of Integer;

  {
  ***************************************************************************
  *
  *    Prosta implementacja funkcji f(x)=a^x.
  *
  ***************************************************************************
  }
  function pow(pods: Integer; wyk: Integer): LongInt;
  var
    a: Integer;
  begin
  if ( pods = 0 ) then pods:=0
  else if ( pods = 1) then pods:=1
  else if ( wyk = 0) then pods:=1
  else begin
    if (wyk<0) then begin
      writeln('Wykladnik mniejszy od 0. Nie obsluguje');
      exit;
    end;
    a := pods;
    while ( wyk > 1 ) do begin
      dec(wyk);
      pods:=pods*a;
    end;
  end;
  pow:=pods;
  end;

  {
  ****************************************************
  *
  *  Funkcja przeksztalcajaca liczbe calkowita
  *  na zapis dwojkowy. Wynikiem jest wektor
  *
  *  Pierwsza liczba w zwracanym wektorze to ilosc elementow
  *  obliczonej liczby.
  *
  ****************************************************
  }

  function ZmianaPodstawy2Wektor(pods: Integer; liczba: Integer): vector;
  var
    v,w: vector;
    i,j: Integer;
  begin

    if (liczba<0) then begin
      writeln('Liczba mniejsza od 0. Nie obsluguje');
      exit;
    end;
    if (liczba=0) then begin
      v[1]:=1;
      v[2]:=0;
      ZmianaPodstawy2Wektor:=v;
    end;
    i:=1;
    while (liczba>0) do begin
      inc(i);
      v[i]:=liczba mod pods;
      liczba:=liczba div pods;
    end;
    for j:=2 to i do w[j]:=v[i-j+2];
    w[1]:=i-1;
    ZmianaPodstawy2Wektor:=w;
  end;

  {
  *****************************************************************************
  *
  *   Ta funkcja przeszktalca liczbe z systemu o podstawie pods zapisanej
  *   w wektorze, do liczby w systemie dziesietnym.
  *   Podana liczba w wektorze v, musi miec specyficzna postac, tzn.
  *   pierwszy element tablicy to liczba mowiaca ile cyfr ma liczba
  *   do przeksztalcenia.
  *
  *   np. v=[3,1,1,0]; (czyli w systemie dziesietnym jest to = 6)
  *
  *****************************************************************************
  }
  function ZmianaPodstwy2Liczba(pods: Integer; v: vector): Integer;
  var
    suma: Integer;
    i,j : Integer;
  begin
    suma:=0;
    j:=0;
    for i:=v[1]+1 downto 2 do begin
        suma:=suma+(v[i]*pow(pods,j));
        inc(j);
    end;
    ZmianaPodstwy2Liczba:=suma;
  end;


  {
  **********************************************************
  *
  *   Funkcja na podstawie indexu generuje slowo Grey'a
  *
  **********************************************************
  }

  function IndeksNaSlowoGreya(i: Integer; ile_m: Integer):vector;
  var
    g,h: vector;
    j,z: Integer;
  begin
    FillChar(h,sizeof(h),0);
    g:=ZmianaPodstawy2Wektor(2,i);
    if (ile_m<g[1]) then begin
      writeln('Za mala liczba miejsc na ktorych nalezy przedstawic liczbe.');
      writeln('Wychodze z funkcji.');
      exit;
    end;

    for i:=2 to g[1]+1 do h[ile_m-g[1]+i-1]:=g[i];
    for i:=1 to ile_m do begin
      z:=ile_m-i+1;
      g[ile_m-i+1]:=(h[z]+h[z-1]) mod 2;
    end;

    FillChar(h,sizeof(h),0);
    h[1]:=ile_m;
    for i:=2 to ile_m+1 do h[i]:=g[i-1];
    IndeksNaSlowoGreya:=h;
  end;

  { DORZUCIC GENEROWANIE G[n] ZA POMOCA ROZNICY SYMETRYCZNEJ }
  function IndeksNaSlowoGreyaXOR(i: Integer; ile_m: Integer):vector;
  var
    g,h: vector;
    j,z: Integer;
  begin
    FillChar(h,sizeof(h),0);
    g:=ZmianaPodstawy2Wektor(2,i);
    if (ile_m<g[1]) then begin
      writeln('Za mala liczba miejsc na ktorych nalezy przedstawic liczbe.');
      writeln('Wychodze z funkcji.');
      exit;
    end;

  end;

 {**************************************************************************
  *
  *   Ta funkcja zwraca numer indeksu dla pobranego slowa Graya.
  *
  *   Parametry
  *   v  [in] -  macierzy wyjsciowa zawierajaca w pierwszym elemencie
  *              warosc ile_m oraz w ile_m kolejnych elementow
  *              szukane slowo Grey'a
  *
  *   n [out] -  szukany indeks slowa Gray'a
  *
  **************************************************************************}
  function SlowoGrayaNaIndeks(v:vector):integer;
  var
    b   : vector;
    i,j : Integer;
    suma: Integer;
  begin
    b[1]:=v[1];
    for j:=v[1]+1 downto 2 do begin
      suma:=0;
      for i:=j downto 2 do
        suma:=suma+v[i];
      b[j]:=suma mod 2;
    end;
    SlowoGrayaNaIndeks:=ZmianaPodstwy2Liczba(2,b);
  end;

  {***************************************************************************
  *
  *   Funkcja ta generuje wektor przejsc korzystajac z tablic.
  *   Wektor przejsc zawiera numery bitow, ktore ulegaja zmianie w generowaniu
  *   kolejnych slow kodu Grey'a.
  *   Podawany argument n oraz dlugosc rozpatrywanych slow w kodzie Grey'a,
  *   maja taka sama wartosc.
  *
  *   n [in]     - dlugosc wektora wejsciowego
  *   Tout [out] - wygenerowany wektor przejsc
  *
  *   UWAGA:
  *   Pierwszy element w wektorze wyjsciowym zawiera dlugosc tego wygenerowanego
  *   wektora.
  ***************************************************************************}
  function GenerujWektorPrzejsc(n: Integer): vector;
  var
    i,k,Twsk,j: Integer;
    flag      : Boolean;
    v,Tout    : vector;
    warunekZak: Integer;
  begin
    // inicjowanie wartosci poczatkowych
    i:=1; Twsk:=2;
    flag:=True;
    warunekZak := pow(2,n)-1;

    for j:=1 to n do v[j]:=j;

    while flag do begin
      if v[i]>0 then begin
        Tout[Twsk]:=v[i];
        inc(Twsk);
        v[i]:=0;
        for k:=i-1 downto 1 do v[k]:=k;
        i:=1;
      end else
        inc(i);
      // obliczamy wartosci do polowy, poniewaz wartosci w ciagu sa takie same
      // jak wartosci w obliczonym ciagu ale od tylu.

      // TO DO: dla n= 2 ten program nie dziala. Powodem jest ten warunek ponizej.
      // Powoduje on wystepowanie petli nieskonczonej
      if Twsk=( (warunekZak+1) div 2 ) then flag:=False;
    end;
    // wartosc 2^(n-1) jest zawsze rowna n (jest to srodek ciagu, miejsce
    // w kodzie Grey'a gdzie pierwsza wartosc kodu zmienia sie z 0 na 1)
    Tout[Twsk+1]:=n;
    // TODO:  nie wiem czemu ale cos sie kopie na tym wskazniku wiec ustwie go na twrado
    Tout[Twsk]:=1;
    // reszta juz jest znana - wiec przepisujemy

    j:=0;
    for i:=Twsk+2 to warunekZak+1 do begin
      Tout[i]:=Tout[Twsk-j];
      inc(j);
    end;

    Tout[1]:=warunekZak;                     //w pierwszym elemencie jest liczba okreslajaca dlugosc wektora przejsc
    GenerujWektorPrzejsc:=Tout;
  end;


  // PONIZSZE PROCEDURY SA POTRZBNE DO GENEROWANIA PODZBIOROW I OGOLNIE DO
  // DZIALANIA PROGRAMU.
  // CALA TRUDNOSC ALGORYMU POLEGA NA WYZNACZENIU WEKTORA PRZEJSC.
  // OPIS ALGORYTMU:
  // 1. GENERUJEMY WEKTOR PRZEJSC
  // 2. WYKORZYSTUJEMY TEN WEKTOR DO GENEROWANIA SLOW KODU GREYA
  // 3. WYGENEROWANE SLOWO GREYA PODAJEMY DO PROCCEDURY PokazImiona(), KTORA
  //    WSTAWIA W MIEJSCE JEDYNEK ODPOWIEDNIE SLOWA (W TYM PRZYPADKU IMIONA)


var
  i,n: Integer;
  v,w: vector;
  imie: array[1..10] of String;

procedure PodajImiona(n: integer);
var
  i: Integer;
begin
  for i:=1 to n do begin
    write('Podaj imie ',i,': ');
    Readln(imie[i]);
  end;
end;

procedure PokazImiona(v: vector; n: Integer);
var
  j: Integer;
begin
  for j:=1 to n do
    if (v[j]=1) then
      write(imie[j],',');
  writeln;
end;

procedure GenerujPodzbiory;
begin
// nmax dla tablicy w typie vector jest ustawione na 1025
// wiec maxymalna liczba elementow w slowie Gray'a nie moze byc wieksza niz 10

  w:=GenerujWektorPrzejsc(n);
  for i:=1 to n do
    v[i]:=0;
  // wystarczy tak bo tylko jedna liczba sie zmienia w jednym przejsciu
  for i:=1 to w[1] do begin
    if (v[w[i+1]] = 0) then
      v[w[i+1]]:=1
    else
      v[w[i+1]]:=0;
    write(i:2,': ');
    PokazImiona(v,n);
end;
end;

begin
Write('Ilosc elementow (wartosc od 2 do 10): '); Readln(n);
PodajImiona(n);
GenerujPodzbiory;
readln;
end.