ROCKS - Rocks Game

Tác giả: ll931110

Ngôn ngữ: Pascal

{
ID: ll9311102
PROB: rocks
LANG: PASCAL
}

program rocks;
const
  input  = '';
  output = '';
  maxn = 16;
  maxk = 100000;
type
  pnode = ^tnode;
  tnode = record
    val: longint;
    link: pnode;
  end;
var
  a: array[0..maxk] of pnode;
  fin,list: array[0..maxk] of longint;
  free: array[0..maxk] of boolean;
  flag: boolean;
  n: longint;
  fi,fo: text;

procedure openfile;
begin
  assign(fi, input);  reset(fi);
  assign(fo, output);  rewrite(fo);
end;

procedure closefile;
begin
  close(fo);  close(fi);
end;

procedure add(x,y: longint);
var
  p: pnode;
begin
  new(p);
  p^.val := y;
  p^.link := a[x];
  a[x] := p;
end;

procedure load;
var
  i,j,v: longint;
begin
  readln(fi, n);
  for i := 0 to 1 shl n do a[i] := nil;
  for i := 0 to 1 shl n - 1 do
      for j := 0 to n - 1 do
        begin
          if i and (1 shl j) = 0 then v := i + (1 shl j) else v := i - (1 shl j);
          add(i,v);
        end;
end;

procedure Ham(i: longint);
var
  p: pnode;
  u,v: longint;
begin
  if flag then exit;
  u := list[i - 1];
  free[u] := false;
  p := a[u];

  while p <> nil do
    begin
      v := p^.val;
      if (v = 0) and (i = 1 shl n) then
        begin
          flag := true;
          fin := list;
          exit;
        end;

      if free[v] then
        begin
          list[i] := v;
          if i < 1 shl n then Ham(i + 1);
        end;

      p := p^.link;
    end;
end;

procedure solve;
begin
  flag := false;
  fillchar(free, sizeof(free), true);
  Ham(1);
end;

procedure printresult;
var
  i,j: longint;
  u: longint;
begin
  for i := 0 to 1 shl n do
    begin
      u := list[i];
      for j := n - 1 downto 0 do
        if u and (1 shl j) = 0 then write(fo, 'O') else write(fo, 'X');
      writeln(fo);
    end;
end;

begin
  openfile;
  load;
  solve;
  printresult;
  closefile;
end.

Download