CTREE - Tô màu nhỏ nhất

Tác giả: ll931110

Ngôn ngữ: Pascal

program CTREE;
const
  input  = '';
  output = '';
  maxn = 10000;
  maxv = 1000000000;
  maxk = 4;
type
  pnode = ^tnode;
  tnode = record
    val: longint;
    link: pnode;
  end;
var
  a: array[1..maxn] of pnode;
  F: array[1..maxn,1..maxk] of longint;
  pre,list,nchi: array[1..maxn] of longint;
  n,res: longint;

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

procedure init;
var
  fi: text;
  i,u,v: longint;
begin
  assign(fi, input);
    reset(fi);

  readln(fi, n);
  for i := 1 to n do a[i] := nil;
  for i := 1 to n - 1 do
    begin
      readln(fi, u, v);
      add(u,v);
      add(v,u);
    end;

  close(fi);

  fillchar(nchi, sizeof(nchi), 0);
  fillchar(pre, sizeof(pre), 0);
end;

procedure DFS(u: longint);
var
  p: pnode;
begin
  p := a[u];
  while p <> nil do
    begin
      if p^.val <> pre[u] then
        begin
          pre[p^.val] := u;
          inc(nchi[u]);
          DFS(p^.val);
        end;
      p := p^.link;
    end;
end;

procedure dp(x: longint);
var
  p: pnode;
  i,j,v,min: longint;
begin
  if nchi[x] = 0 then
    begin
      for i := 1 to maxk do F[x,i] := i;
      exit;
    end;

  p := a[x];
  while p <> nil do
    begin
      if p^.val <> pre[x] then dp(p^.val);
      p := p^.link;
    end;

  for i := 1 to maxk do
    begin
      F[x,i] := i;

      p := a[x];
      while p <> nil do
        begin
          v := p^.val;
          if v <> pre[x] then
            begin
              min := maxv;

              for j := 1 to maxk do
                if (i <> j) and (min > F[v,j]) then min := F[v,j];

              F[x,i] := F[x,i] + min;
            end;
          p := p^.link;
        end;
    end;
end;

procedure trace(x,k: longint);
var
  u,i,min: longint;
  p: pnode;
begin
  min := maxv;
  for i := 1 to maxk do
    if (i <> k) and (min > F[x,i]) then
      begin
        u := i;
        min := F[x,i];
      end;
  list[x] := u;

  p := a[x];
  while p <> nil do
    begin
      if p^.val <> pre[x] then trace(p^.val,list[x]);
      p := p^.link;
    end;
end;

procedure solve;
var
  i: longint;
begin
  DFS(1);
  dp(1);
  trace(1,0);

  res := 0;
  for i := 1 to n do res := res + list[i];
end;

procedure printresult;
var
  fo: text;
  i: longint;
begin
  assign(fo, output);
    rewrite(fo);

  writeln(fo, res);
  for i := 1 to n do writeln(fo, list[i]);

  close(fo);
end;

begin
  init;
  solve;
  printresult;
end.

Download