Problem 872: Ordering

Berikut ini adalah pemecahan dari soal 872 tentang Ordering (penyusunan). Silakan ditelaah dengan baik soalnya dan contoh input / output. Sebagai sesama programmer bahasa program tentu lebih mudah dimengerti ketimbang bahasa manusia. Saya sendiri sudah lupa dan malas mengingat bagaimana membaca program di bawah, meskipun buatan sendiri. Selamat membaca.

Sebagai catatan, directive $IFDEF VER150 di situ untuk keperluan debugging mengingat program ini dibuat menggunakan Delphi 7. File order.txt berisikan contoh input dan output yang ada di soal. Sangat disarankan melakukan pengerjaan dan pengujian program dengan Delphi 7 karena fasilitas yang ada sangat membantu. Setelah berjalan baik selanjutnya dapat dicompile dengan FreePascal sesuai compiler yang ada di Online Judge.

http://icpcres.ecs.baylor.edu/onlinejudge/index.php?option=com_onlinejudge&Itemid=8&category=10&page=show_problem&problem=813

{$APPTYPE CONSOLE}

program order_872;

const
  Awal = 'A';
  Akhir = Succ('T');

type
  TSet = set of Awal..Akhir;
  TRec = record
    RH: TSet;         // himpunan variabel
    RS: string[20];   // daftar variabel
  end;

var
  ArrRec: array[Awal..Akhir] of TRec;
  Kena: Integer;

function TambahRute(var R: TRec; Ch: Char): TSet;
var
  I: Integer;
  Z: ^TRec;
  Res: TSet;
begin
  Res := R.RH;
  if Akhir in R.RH then Exit;
  for I := 1 to Length(R.RS) do begin
    Z := @ArrRec[R.RS[I]];
    if (Z^.RS<>'') and not (Ch in Z^.RH) then begin
      if (not (Akhir in Z^.RH)) then
        Res := Res + TambahRute(Z^, R.RS[I])
      else
        Res := Res + Z^.RH;
    end;
  end;
  Include(Res, Akhir);
  R.RH := Res;
  TambahRute := Res;
end;

procedure Cetak(const S: ShortString);
var
  I, J: Integer;
begin
  for I := 1 to Length(S)-1 do
    for J := I+1 to Length(S) do
      if (S[J] in ArrRec[S[I]].RH) then Exit;
  Inc(Kena);
  for I := 1 to Length(S)-1 do
    Write(S[I], ' ');
  Writeln(S[Length(S)]);
end;

procedure Permutasi(var Str: ShortString);
var
  I, J, K: Integer;
  C: Char;
begin
  Cetak(Str);
  repeat
    K := Length(Str)-1;
    while (K > 0) and (Str[K] > Str[K+1]) do Dec(K);
    if K = 0 then Break
    else begin
      J := Length(Str);
      C := Str[K];
      while C > Str[J] do Dec(J);
      Str[K] := Str[J];
      Str[J] := C;
      J := Length(Str);
      I := K + 1;
      while J > I do begin
        C := Str[J];
        Str[J] := Str[I];
        Str[I] := C;
        Dec(J); Inc(I);
      end;
      Cetak(Str);
    end;
  until False;
end;

var
  Total, Cah: Integer;
  Str, SS: ShortString;
  C: Char;
{$IFDEF VER150}FT: Text;{$ENDIF}
begin
  {$IFDEF VER150}
  Assign(FT, 'order.txt');
  Reset(FT);
  {$ENDIF}
  Readln({$IFDEF VER150}FT,{$ENDIF} Total);
  Readln({$IFDEF VER150}FT{$ENDIF});
  while Total > 0 do begin
    Kena := 0;
    FillChar(ArrRec, SizeOf(ArrRec), 0);
    Readln({$IFDEF VER150}FT,{$ENDIF} Str);
    { buang spasi dari daftar variabel }
    SetLength(SS, (Length(Str)+1) div 2);
    for Cah := 1 to Length(SS) do
      SS[Cah] := Str[(Cah-1)*2+1];
    { isi himpunan dari daftar variabel }
    Readln({$IFDEF VER150}FT,{$ENDIF} Str);
    Cah := 1;
    while Cah < Length(Str) do begin
      with ArrRec[Str[Cah+2]] do begin
        Include(RH, Str[Cah]);
        SetLength(RS, Length(RS) + 1);
        RS[Length(RS)] := Str[Cah];
      end;
      Inc(Cah, 4);
    end;
    for Cah := 1 to Length(SS) do begin
      C := SS[Cah];
      if ArrRec[C].RS<>'' then
        TambahRute(ArrRec[C], C);
    end;
    Permutasi(SS);
    if Kena = 0 then Writeln('NO');
    Readln({$IFDEF VER150}FT{$ENDIF});
    Dec(Total);
    if Total > 0 then Writeln;
  end;
  {$IFDEF VER150}Readln;{$ENDIF}
end.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s