Quest F (December 2012)

//F
Var Q1, Q2, Q3:byte;
    N, K, temp1, temp2, i, j:integer;
    input, output:text;
    numbersOfQuestion:array [1..1000] of byte;
    temp:array [1..2,1..14] of byte;
BEGIN
Assign(input,'input.txt');
Assign(output,'output.txt');
Reset(input);
ReadLN(input, Q1, Q2, Q3);
ReadLN(input,N);
temp[1, Q1]:=temp[1, Q1] + 1;
temp[1, Q2]:=temp[1, Q2] + 1;
temp[1, Q3]:=temp[1, Q3] + 1;
for i:= 1 to N do
    Read(input, numbersOfQuestion[i]);
for i:= 1 to N do
    temp[2, numbersOfQuestion[i]]:= temp[2, numbersOfQuestion[i]] + 1;
for i:= 14 downto 1 do
if (temp[1, i] + temp[2, i]) >= 3 then
   Begin
        j:= i;
        break;
   End;
if (j = i) then
   Begin
        while temp[1, j] <> 3 do
        Begin
        for i:= 1 to 14 do
        if (i <> j) then temp[1, i]:= 0;
        temp[2, j]:= temp[2, j] - 1;
        temp[1, j]:= temp[1, j] +1 ;
        K:= K+1;
   End;
Close(input);
Rewrite(output);
WriteLN(output, K);
for i:= 1 to 14 do
    While temp[1, i] <> 0  Do
    Begin
         Write(output, i, ' ');
         temp[1, i]:= temp[1, i]-1;
    End;
    End
else
    Begin
         for i:= 1 to 14 do
             if (temp[1, i] <> 0) then
             Begin
                 temp1:= i;
                 break;
             End;
         for i:= 14 downto 1 do
             if (temp[2,i] <> 0) then begin; temp2:= i;
                break;
             end;
         temp[1, temp1]:= temp[1, temp1] - 1;
         temp[1, temp2]:= temp[1, temp2] + 1;
         K:= 1;
         Rewrite(output);
         WriteLN(output, K);
         for i:=14 downto 1 do
             if (temp[1,i] <> 0) then
                Begin
                     Write(output, i, ' ');
                     temp[1, i]:= temp[1, i]-1;
                     break;
                End;
         for i:= 1 to 14 do
         while temp[1, i] <> 0  do
         Begin
              Write(output, i, ' ');
              temp[1, i]:= temp[1, i] - 1;
         End;
    End;
Close(output);
END.