i:=1 to N do Gr[i]:=Color(i,0);{первая правильная раскраска}
MaxC:=0;MinNum:=0;
repeat
<найти вершину с минимальным номером(MinNum), имеющую максимальный цвет раскраски(MaxC) - процедура MaxMin(MaxC,MinNum) >;
<изменить цвет раскраски в соответствии с описанной идеей - процедура Change(MinNum)>;
until MaxC=Gr[MinNum];
<вывод минимальной раскраски>;
end.
Если работа процедуры MaxMin достаточно очевидна, то Change требует дальнейшего уточнения.
procedure Change(t:V);
var r,q:V;
Ws:Ss;
function MaxCon(l:V;Rs:Ss):V;{находим смежную с l вершину с наибольшим номером и не принадлежащую множеству Rs}
var i:V;
begin
for i:=l-1 downto 1 do
if (A[l,i]=1) and( not(i in Rs) then begin MaxCon:=i;
exit
end
MaxCon:=0;
end;
begin
Ws:=[];
q:=MaxCon(t,Ws);
while q<>0 do begin
r:=Color(q,Gr[q]);
if r<MaxC then <изменить цвет у вершин с