Пример решения задачи на Delphi

Задача

Президент объявил развитие трамвайного движения приоритетным национальным проектом. Бюджетных средств, выделенных Екатеринбургу в рамках этого проекта, должно хватить на полную реконструкцию трамвайной сети города.

В Екатеринбурге 2n трамвайных остановок. В ходе реконструкции решено оставить все остановки на своих местах и не строить новых. Пути же должны быть проложены так, чтобы от любой остановки до любой другой можно было доехать на трамвае без промежуточных остановок.

После изучения сообщений, оставленных на трамвайном форуме, выяснилось, что горожане будут довольны лишь в том случае, если после окончания реконструкции для любой пары остановок будет существовать трамвайный маршрут, на котором можно добраться от одной из этих остановок до другой, не останавливаясь на промежуточных остановках. Понятно, что этому требованию удовлетворяет сеть из n(2n − 1) маршрутов, состоящих всего из двух остановок каждый. Но мэр Екатеринбурга заинтересован в том, чтобы после реконструкции осталось ровно n трамвайных маршрутов, совершающих по пути следования ровно 2n остановок каждый (включая конечные). Трамваи должны двигаться по этим маршрутам в обоих направлениях. Как провести реконструкцию так, чтобы и мэр города, и жители остались довольны?

Исходные данные

В единственной строке дано целое число n, 1 ≤ n ≤ 100.

Результат

Выведите n строк, содержащих описание трамвайных маршрутов. Каждый маршрут — последовательность целых чисел от 1 до 2n, записанных через пробел. Маршрут может проходить несколько раз через одну остановку. Если задача имеет несколько решений, можно вывести любое из них. Если задача не имеет решения, выведите в единственной строке число −1.

Решение



program Sample1;



{$APPTYPE CONSOLE}



uses

  SysUtils;



var

  n: integer;

  i, j:integer;

  currstan:integer;

  stancount:integer;



  a: array [1..200, 1..200] of boolean;

  ab: array [1..200] of boolean;



function findfirstan:integer;

var

  i:integer;

begin

  i:=1;

  while ab[i] <> false do

    inc(i);

  ab[i]:=true;

  Result:=i;

end;



function findlasttan(stan:integer):integer;

var

  i:integer;

begin

  i:=1;

  while ((ab[i] = true) or (a[i, stan]=true) or (a[stan, i]=true) or (i=stan)) do

    inc(i);

  ab[i]:=true;

  if i<stan then

    a[i, stan]:=true

  else

    a[stan, i]:=true;

  Result:=i;

end;



function findnextstan(stan:integer):integer;

var

  i: integer;

begin

  for i:=1 to (stan - 1) do

    if a[i, stan] = false then

    begin

      a[i, stan]:= true;

      Result:=i;

      Exit;

    end;



  for i:=(stan + 1) to 2*n do

    if a[stan, i] = false then

    begin

      a[stan, i]:= true;

      Result:=i;

      Exit;

    end;



  Result:=0;

end;



begin

  assign(input, 'input.txt');

  reset(input);

  assign(output, 'output.txt');

  rewrite(output);



  Readln(n);



  for i:=1 to 2*n do

    for j:=1 to 2*n do

      a[i,j]:=false;



  for i:=1 to 2*n do

    ab[i]:=false;



  for i:=1 to n do

  begin

    currstan:=findfirstan;

    stancount:=1;

    write(currstan,' ');

    while stancount <= (2*n - 2) do

    begin

      currstan:=findnextstan(currstan);

      write(currstan, ' ');

      inc(stancount);

    end;

    currstan:=findlasttan(currstan);

    writeln(currstan);

  end;



   close(input);

   close(output);



end.