Код:

Program alg_greedy;
Uses Crt{*, Graph*};
Type Graph  = Array[1..100,1..100] Of Integer;
     List   = Array[1..100] Of Integer;
Const Bukwy : Array[1..16] Of String = ('AB','DE','BD','CD','AC','','','','','','','','','','','');
Var  g      : Graph;    {matriza Grapha}
     newclr : List;     {mnogestvo zakrashenyx vershin Grapha}
     ver_g  : List;     {mnogestvo vershin Grapha}
     n, temp: Integer;  {kolichestvo vershin Grapha}
     i, j, k: Integer;
     otvet  : Integer;
     flag   : Boolean;
{**********************************************}
Procedure greedy(Var ver_g:List; Var newclr:List);
Label 1;
Var found:Boolean;
    v, w :Integer;      {v - vershiny ver_g, w - versiny newclr}
    ch_v, ch_w:Integer; {chetchik v, chetchik w}
begin
  for i:=1 to n do
    newclr[i]:=0;
  ch_v:=1;
  v:=ver_g[ch_v];
  while (v<>0) do
    begin
      found:=false;
      ch_w:=1;
      w:=newclr[ch_w];
      while(w<>0) do
        begin
          if (g[v,w] = 1) then
            begin
              found:=true;
              ch_w := n;
            end;
          ch_w:=ch_w+1;
          w:=newclr[ch_w];
        end;
      if (found = false) then
        for ch_w:=1 to n do
          if (newclr[ch_w]=0) then
            begin
              newclr[ch_w]:=v;
              goto 1;
            end;
     1:ch_v:=ch_v+1;
      v:=ver_g[ch_v];
    end;
  for i:=1 to n do
    if (newclr[i]<>0) then
      for j:=1 to n do
        if (newclr[i] = ver_g[j]) then
          for k:=j to n do
            ver_g[k]:=ver_g[k+1];
End;
{**********************************************}
Begin
  ClrScr;
  Writeln('');
  Writeln('');
  Writeln('');
  Writeln('     Osnovnaj programma');
  Write('     Vvedite kolichestvo vershin Grapha -> ');
  Read(n);

  g[1,5] := 1;
  g[2,3] := 1; g[2,4] := 1;
  g[3,5] := 1;
  g[4,5] := 1;

  For i:=1 To n Do
  For j:=1 To n Do
    If (g[i,j] = 1) Then
      g[j,i] := 1;

  Write('     Ispolzuem greedy  !!!  1 or 0  !!! -> ');
  Read(otvet);
  If (otvet = 1) Then
    For i:=1 To n Do
      ver_g[i] := i
  Else
    Begin
      Writeln('');
      Writeln('     No greedy !!!');
      For i:=1 To n Do
        Begin
          g[i,n+2] := i;
          For j:=1 To n Do
            If (g[i,j] = 1) Then
              g[i,n+1] := g[i,n+1] + 1;
        End;

      flag := true;
      i := 1;
      While (flag) Do
        Begin
          flag := false;
          For j:=n Downto (i+1) Do
            If (g[j-1,n+1] < g[j,n+1]) Then
              Begin
                temp       := g[j-1,n+1];
                g[j-1,n+1] := g[j,n+1];
                g[j,n+1]   := temp;

                temp       := g[j-1,n+2];
                g[j-1,n+2] := g[j,n+2];
                g[j,n+2]   := temp;
                flag := true;
              End;
          i := i + 1;
        End;

      For i:=1 To n Do
        ver_g[i] := g[i,n+2];
    End;

  Writeln('');
  While (ver_g[1] <> 0) Do
    Begin
      Write('     newclr = ');
      greedy(ver_g,newclr);
      For i:=1 To n Do
        If (newclr[i] <> 0) Then
          Write(' ',Bukwy[newclr[i]]:2);
      Writeln('');
      Write('     ver_g  = ');
      For i:=1 To n Do
        If (ver_g[i] <> 0) Then
          Write(' ',Bukwy[ver_g[i]]:2);
      Writeln('');
      Writeln('');
      Readkey;
    End;
  Writeln('     ** Enter **');
  Readkey;
End.