Bojenje

Evo otvorio sam

a,p,q,c,s:array [1..300] of integer;
poz:array [0..300,1..300] of integer;
queue:array [1..2,0..300] of integer;
u,i,n,k:integer;

procedure Paint;
var
i,j,z,r,x,y,l,h,dx,dy:integer;
begin
l:=0; h:=1;
queue[1,0]:=1;
queue[2,0]:=n;
while (l < h) do begin
dx:=queue[1,l]; dy:=queue[2,l]; l:=l+1;
for i:=1 to k do poz[0,i]:=0;
r:=0;
for i:=dx to dy do begin
if (poz[0,a[i]] = 0) then begin
r:=r+1;
s[r]:=a[i];
end;
inc(poz[0,a[i]]);
poz[a[i],poz[0,a[i]]]:=i;
end;
if (r > 1) then begin
z:=0;
for i:=1 to r do begin
if (poz[0,s[i]] > z) then begin
z:=poz[0,s[i]];
j:=i;
end;
end;
u:=u+1;
p[u]:=poz[s[j],1];
q[u]:=poz[s[j],poz[0,s[j]]];
c[u]:=s[j];
for i:=1 to poz[0,s[j]]-1 do begin
x:=poz[s[j],i]+1;
y:=poz[s[j],i+1]-1;
if (x < y) then begin
queue[1,h]:=x;
queue[2,h]:=y;
h:=h+1;
end;
if (x = y) then begin
u:=u+1;
p[u]:=x;
q[u]:=y;
c[u]:=a[x];
end;
end;
end else begin
u:=u+1;
p[u]:=dx;
q[u]:=dy;
c[u]:=a[dx];
end;
end;
end;

begin

readln(n,k);
for i:=1 to n do readln(a[i]);
Paint;
writeln(u);
for i:=1 to u do writeln(p[i],' ',q[i],' ',c[i]);
evo kako sam ja probo