Олимпиадная задача "Карточки" (Pascal)

[rustkill]

Здравствуйте, помогите, пожалуйста, решить задачу:


На день рождения Вася подарил своему брату Пете набор из N карточек. Затем Вася и Петя написали по одному числу на каждой из карточек, Вася с одной стороны, а Петя — с другой. После этого братья разбросали карточки по комнате и убежали. Все это безобразие увидела их бабушка Людмила Петровна. Она много лет работала бухгалтером, поэтому она решила вспомнить молодость и придумала себе игру: нужно некоторые карточки перевернуть "васиной" стороной, а некоторые "петиной", причем так, чтобы сумма была максимально возможной. Но, так как она любит обоих братьев одинаково сильно, она добавила дополнительное условие, что количество карточек, перевернутых "петиной" стороной, должно отличаться от количества карточек, перевернутых "васиной" стороной, не более, чем на K.
Людмила Петровна легко справилась с задачей, а Вы сможете?

Технические условия
Входные данные

В первой строке содержатся числа N и K (1 ≤ N ≤ 100000, 1 ≤ K ≤ N) — количество карточек. Далее в N строках содержится описание карточек — два целых числа: первое число написано Васей на одной стороне карточки, второе написано Петей на другой стороне. Вася и Петя не знают чисел, которые по модулю превосходят 109.

Выходные данные

В первой строке выходного файла должно содержатся одно число — максимально возможная сумма. Далее выведите N чисел — для каждой карточки выведите 1, если она Петиной стороной, и 0, если Васиной.

Если ответов несколько, выведите любой.

Пример
Пример входных данных
5 1
1 2
1 2
1 2
1 2
1 2
Пример выходных данных
8
1 1 1 0 0


Код ниже "встаёт" на 2ом тесте с ошибками:
Ошибка исполнения
Превышен предел времени
Неверный ответ

Сам своей ошибки найти не могу, раза 3 переписывал программу с 0, всё также фейлю на 2ом тесте.

[rustkill]

Код:

type mas=array[1..101000] of longint;
var n,k,i,x,y,m,s,n1:longint; min,max,nomer,a,b:mas;

procedure swap(var a,b:longint);
var x:longint;
begin
x:=a;
a:=b;
b:=x;
end;

Procedure qs(l, r: integer);
Var i, j, x: integer;
begin
  i := l;
  j := r;
  x := max[l + random(r - l)];
  While i < j do
  begin
    While max[i] < x do inc(i);
    While max[j] > x do dec(j);
    if i <= j then
    begin
      swap(max[i], max[j]);
      swap(nomer[i], nomer[j]);
      inc(i); dec(j);
    end;
  end;
  if i < r then qs(i, r);
  if l < j then qs(l, j);
end;

procedure del(var a:mas; i,n1:longint);
var j:longint;
begin
for j:=i to n1-1 do
                 a[i]:=a[i+1];
end;

begin
assign(input,'input.txt'); reset(input);
assign(output,'output.txt'); rewrite(output);
read(n,k);
m:=(n + k) div 2; s:=0;
for i:=1 to n do begin
    read(x,y);
  if x > y then begin
    max[i]:=x;
    min[i]:=y;
    a[i]:=0;
    nomer[i]:=i;
    end
  else if y > x then begin
    max[i]:=y;
    min[i]:=x;
    a[i]:=1;
    nomer[i]:=i;
    end
  else begin
    max[i]:=x;
    min[i]:=y;
    a[i]:=2;
    nomer[i]:=i;
    end;
end;
qs(1,n);
i:=n; x:=0; y:=0; n1:=n;
while (i >= 1)and((x < n-m)or(y < n-m)) do begin
  if (a[nomer[i]] = 0)and(x < n-m) then begin
    inc(s,max[i]);
    inc(x);
    b[nomer[i]]:=0;
    del(max,i,n1);
    del(nomer,i,n1);
    dec(n1);
    end
  else if (a[nomer[i]] = 1)and(y < n-m) then begin
    inc(s,max[i]);
    inc(y);
    b[nomer[i]]:=1;
    del(max,i,n1);
    del(nomer,i,n1);
    dec(n1);
    end;
  dec(i);
end;
if (x = y)and(x = n-m) then                                                
for i:=1 to n1 do
  if a[nomer[i]] = 0 then begin
    inc(s,max[i]);
    b[nomer[i]]:=0;
    end
  else if a[nomer[i]] = 1 then begin
    inc(s,max[i]);
    b[nomer[i]]:=1;
    end
  else begin
    inc(s,max[i]);
    b[nomer[i]]:=1;
    end                       
else if x = n - m then begin
i:=n1;
while (x < m)and(i >= 1) do begin
  if a[nomer[i]] = 0 then begin
    inc(s,max[i]);
    inc(x);
    b[nomer[i]]:=0;
    del(max,i,n1);
    del(nomer,i,n1);
    dec(n1);
    end;
  dec(i);
end;
for i:=1 to n1 do
  if a[nomer[i]] = 0 then begin
    inc(s,min[nomer[i]]);
    b[nomer[i]]:=1;
    end
  else begin
    inc(s,max[i]);
    b[nomer[i]]:=1;
    end;
end
else if y = n - m then begin
i:=n1;
while (y < m)and(i >= 1) do begin
  if a[nomer[i]] = 1 then begin
    inc(s,max[i]);
    inc(y);
    b[nomer[i]]:=1;
    del(max,i,n1);
    del(nomer,i,n1);
    dec(n1);
    end;
dec(i);
end;
for i:=1 to n1 do
  if a[nomer[i]] = 1 then begin
    inc(s,min[nomer[i]]);
    b[nomer[i]]:=0;
    end
  else begin
    inc(s,max[i]);
    b[nomer[i]]:=0;
    end;
end
else
  for i:=1 to n1 do
    if x < y then begin
      inc(s,max[i]);
      inc(x);
      b[nomer[i]]:=0;
      end
    else begin
      inc(s,max[i]);
      inc(y);
      b[nomer[i]]:=1;
      end;                              
writeln(s);
for i:=1 to n do write(b[i],' ');                                                                            
end.