Олимпиадная задача

[kim]

Всем доброго времени суток. Прошу помощи при решении задачи. Копаюсь с ней месяц, но не знаю с чего начать. Уже и олимпиада как 2 месяца прошла, а я всё не могу её решить. Мне подсказали что решить можно с помощью ДДП или графов, но мы такое ещё не изучали.
Условие следующее:
Дана матрица размером N×M клеток, где 0 — клетка воды, 1 — клетка суши. Черепашка находится в клетке с координатами A, B. Найти такую клетку C, D на южном побережье так, чтобы время T перемещения было минимальным. Если таких клеток несколько, достаточно указать одну из них. Движется черепашка по соседним клеткам через общие стороны и тратит: 1 час в клетке суши, и 3 часа в клетку с водой (время, затраченное на первую и последнюю клетки маршрута, тоже учитывается). Клетка южного побережья — последняя 1 в каждом столбце матрицы.
Начальные данные:
N, M, A, B — натуральные, не больше 100. В N следующих строках по M цифр 0 или 1 в каждой.
Исходные данные:
В первой строке T — минимальное время движения между клетками. Во втором координаты C, D новой клетки на южном побережье.
Пример для входных данных:
4 5 1 3
0 1 1 0 0
0 1 0 1 0
1 0 0 0 1
1 1 1 1 1
Нужно получить:
7
4 2
Буду очень всем благодарен, кто сможет мне помочь.

[Лекс Айрин]

Могу лишь частично помочь по алгоритму.
Смотри, у тебя путь либо вниз, либо в бок. Право или лево.
Если это суша, то добавляешь один. Если это вода, то три.
Если тебе не дают лимит на время, то штраф за боковое движение не нужен, все равно их потом все придется отнимать. И да, придется рассчитывать несколько путей, так как все равно всего не учтешь. В результате ты построишь троичное дерево и, в конце каждой ветки, обычно говорят листа, ты проверяешь весовой коэффициент.
Узлом дерева будет запись содержащая список потомков, весовой коэффициент ну и строку пути в виде, допустим, символов: н, л, р.
Конечно, это грубо, да и не совсем понятно условие задачи, возможно придётся вводить особые проверки на окончание пути или заранее рассчитывать точки в которые нужно попасть для каждого столбца.
Кстати, с точки зрения биологии задача звучит странновато. Черепахи двигаются намного быстрее находясь в воде.

[Vadim]

kim
Можно поискать в интернете какую-нибудь готовую программку по работе с графом. В графах обычно предполагается, что переход между ячейками (или, называя их официально, вершинами) графа имеют какую-то стоимость - большую или меньшую. Таким оьразом, прокладывая несколько возможных путей суммируется стоимость всех переходов. В Вашем случае эта стоимость - время (1 или 3 часа). Нужно модифицировать программу указав Ваши конкретные значения.

[Лекс Айрин]

Vadim, это не спортивно)))

[runewalsh]

Я не очень уловил условие (подсветил бы хоть, какие клетки соответствуют решению), но по-моему, здесь нужно просто запустить алгоритм Дейкстры из положения черепахи и всё. (Можно поиск в ширину, но его нужно будет выполнить до конца, а Дейкстру можно остановить, как только извлечена из очереди любая целевая клетка, т. к. она заведомо ближайшая по времени.)

[Vadim]

это не спортивно

Почему?
Товарищ ведь совершенно ясно написал:

Уже и олимпиада как 2 месяца прошла, а я всё не могу её решить.

Ему ведь надо разобраться, как такие задачи решаются, а вовсе не олимпиаду выиграть. И в этом случае нет ничего лучше исходного кода. Конечно, хорошо бы ещё и алгоритм в графическом виде, но что-то я давно уже не замечаю, чтобы кто-то алгоритмы по ГОСТу расписывал...

Добавлено спустя 1 минуту 58 секунд:

подсветил бы хоть, какие клетки соответствуют решению

Нету у него решения. Он как раз и хочет понять, как такие задачи решают.

[Лекс Айрин]

Vadim, потому и не спортивно. Это все равно что стометровку проехать на велосипеде, вместо того чтобы бежать. Да и лучше всего усваивается если делаешь сам.
Я когда-то пытался, думаю как и большинство при обучении. Но потом заметил, что в этом просто нет необходимости. Хотя иногда приходится зарисовывать, но скорее чтобы окинуть все одном взглядом.
Вообще-то, как раз решение у него есть . Его он указал. Нет алгоритма.
runewalsh, в данном конкретном случае любая из нижнего ряда. В общем случае, если в последнем ряду есть 0, то в соответствующем ряду предыдущая ячейка. И так,пока не достигнет единицы.

[runewalsh]

Ой, я хотел сказать
>какие клетки соответствуют условию
т. е. какая система координат, с 0 или с 1 они считаются. Но уже сам соизволил подумать дольше 2 секунд: координаты с единицы, A — строка, B — столбец.
Как я уже сказал, задача решается банально Дейкстрой или шириной из стартовых координат черепашки.

[Дож]

kim, какие ограничения по времени и памяти?

[xdsl]

Идея решения - от дейкстры.
Вот половинка решения - нахождение кратчайшего пути от одной точки до всех остальных. Оставшаяся часть тривиальна - прошагать назад до исходной точки, приводить ее не буду.
Вводом размера массива, начальной ячейки - не заморачивался, здесь только суть.

Итак, есть массив весов src (суша=1, вода=3), есть массив шагов dst (изначально в каждой ячейке - формальная бесконечность).
В ячейку массива шагов вносим вес первого шага из соответствующей ячейки массива весов.
Затем пробегаемся по массиву шагов и при нахождении шага черепашки пытаемся заполнить ячейки вокруг этого шага, пользуясь массивом весов.
Заполняем только те ячейки, значение которых сейчас больше того, которое хотим туда поместить, что и минимизирует путь.
Если при пробеге хоть одна ячейка поменялась, повторяем процесс.

Код: Выделить всё

{$mode objfpc}
const max=high(word);

type tarr=array[1..4,1..5]of word;

var last:boolean=false;

src:tarr=
(
 (3,1,1,3,3),
 (3,1,3,1,3),
 (1,3,3,3,1),
 (1,1,1,1,1)
);

dst:tarr=
(
 (max,max,max,max,max),
 (max,max,max,max,max),
 (max,max,max,max,max),
 (max,max,max,max,max)
);



 procedure near(i1,j1,i2,j2:integer);
  begin
    if dst[i1,j1]=max then exit;
    if (dst[i2,j2]<max)and(dst[i1,j1]+src[i2,j2]>=dst[i2,j2]) then exit;
    dst[i2,j2]:=dst[i1,j1]+src[i2,j2];
    last:=false;
  end;

 var i,j:word;

begin

 dst[1,3]:=src[1,3];
 while not last do begin
  last:=true;
  for i:=1 to 4 do begin
   for j:=1 to 5 do begin
    if (i<4) then near(i,j,i+1,j);
    if (i>1) then near(i,j,i-1,j);
    if (j<5) then near(i,j,i,j+1);
    if (j>1) then near(i,j,i,j-1);
   end;
  end;
 end;
 
 for i:=1 to 4 do begin
  for j:=1 to 5 do write(dst[i,j]:4); 
  writeln;
 end;
 
end.

Добавлено спустя 2 минуты 8 секунд:
Собственно, это основа для прохождения любых лабиринтов.

[kim]

Спасибо всем, кто мне помогает.
Вношу некоторую ясность: Лимит времени - 1 секунда, память - 64MiB. Последний ряд - всегда все 1.
Мне как бы намекнули, что задачу можно решить двумерным динамическим программированием.
Нужно взять последнюю единицу в первом столбце матрицы и заполнять матрицу числами.
Т.е., если черепашка находится в точке 1,3, то заполненая матрица будет иметь следующий вид:
8 7 8 11 14
5 6 9 8 11
2 5 6 7 8
1 2 3 4 7
Потом найти кратчайший путь. Запомнить его (Запомнили что будет '8'). Обнулить матрицу. Взять следующую единицу и проделать операции те, что и с первой. И так до конца всех единиц в последнем ряду. При этом ели мин.время будет меньше предыдущего, то перезаписать его. Как-бы это самый простой способ сделать эту задачу. Просьба: как это описать? Хотелось бы узнать ваше мнение и возможно и решение. Спасибо

[xdsl]

Ну и чепуху намекнули, учета воды-суши нет.
Бери мой код за основу, делай обратную трассировку и все у тебя получится

[iskander]

С графом переходов:
- добавляем фиктивную ячейку(нулевой стоимости), в нее ведут пути из всех ячеек последней строки.
- находим кратчайший путь в нее, его стоимость и предыдущая ячейка на этом пути - то что нам и нужно.
Получилось, впрочем, изрядно громоздко.

Код: Выделить всё

program turtle;

{$MODE OBJFPC}

uses
  SysUtils;

const
  DELAY_ZERO = 3;
  DELAY_UNIT = 1;

type
  TArc = record
    Target: Integer;
  end;

  TAdjList = array[1..3] of TArc;

  TVertex = record
    Delay,
    AdjCount: Integer;
    AdjList: TAdjList;
  end;

  TGraph     = array of TVertex;
  TBoolArray = array of Boolean;
  TIntArray  = array of Integer;

function CreateBoolArray(aSize: Integer): TBoolArray;
begin
  SetLength(Result, aSize);
  FillChar(Pointer(Result)^, aSize, 0);
end;

function CreateIntArray(aSize, aValue: Integer): TIntArray;
begin
  SetLength(Result, aSize);
  FillDWord(Pointer(Result)^, aSize, DWord(aValue));
end;

//Bellman-Ford-Moore single source shortest paths algorithm
procedure Bfm(const g: TGraph; aSrc: Integer; out aPaths, aTimes: TIntArray);
var
  Queue: TIntArray;
  InQueue: TBoolArray;
  I, Relaxed, Curr, Next, vCount, QueueHead, QueueTail: Integer;
begin
  vCount := Length(g);
  aTimes := CreateIntArray(vCount, High(Integer));
  aPaths := CreateIntArray(vCount, -1);
  Queue := CreateIntArray(vCount, -1);
  InQueue := CreateBoolArray(vCount);
  QueueHead := 0;
  QueueTail := 0;
  aTimes[aSrc] := g[aSrc].Delay;
  Queue[QueueTail] := aSrc;
  Inc(QueueTail);
  while QueueTail <> QueueHead do
    begin
      Curr := Queue[QueueHead];
      Inc(QueueHead);
      if QueueHead = vCount then
        QueueHead := 0;
      InQueue[Curr] := False;
      if (aPaths[Curr] <> -1) and InQueue[aPaths[Curr]] then
        continue;
      with g[Curr] do
        for I := 1 to AdjCount do
          begin
            Next := AdjList[I].Target;
            Relaxed := aTimes[Curr] + g[Next].Delay;
            if Relaxed < aTimes[Next] then
              begin
                aTimes[Next] := Relaxed;
                aPaths[Next] := Curr;
                if not InQueue[Next] then
                  begin
                    InQueue[Next] := True;
                    Queue[QueueTail] := Next;
                    Inc(QueueTail);
                    if QueueTail = vCount then
                      QueueTail := 0;
                  end;
              end;
          end;
    end;
end;

var
  CellGraph: TGraph = nil;
  Paths: TIntArray = nil;
  Times: TIntArray = nil;
  RowCount: Integer = 0;
  ColCount: Integer = 0;
  VertexCount: Integer = 0;
  SrcIndex: Integer = -1;
  DstIndex: Integer = -1;
  DummyIndex: Integer = 0;

procedure CreateVertex(aCellInput: Byte; aRow, aCol: Integer);
var
  vIndex: Integer;
begin
  vIndex := aRow * ColCount + aCol;
  if aCellInput = 0 then
    CellGraph[vIndex].Delay := DELAY_ZERO
  else
    CellGraph[vIndex].Delay := DELAY_UNIT;
  with CellGraph[vIndex] do
    if aRow < RowCount - 1 then
      begin
        if (aCol > 0) and (aCol < ColCount - 1) then
          begin
            AdjCount := 3;
            AdjList[1].Target := vIndex - 1;
            AdjList[2].Target := vIndex + 1;
            AdjList[3].Target := vIndex + ColCount;
          end
        else
          if aCol > 0 then //here aCol = ColCount - 1
            begin
              AdjCount := 2;
              AdjList[1].Target := vIndex - 1;
              AdjList[2].Target := vIndex + ColCount;
            end
          else             //here aCol = 0
            begin
              AdjCount := 2;
              AdjList[1].Target := vIndex + 1;
              AdjList[2].Target := vIndex + ColCount;
            end;
      end
    else  //here aRow = RowCount - 1
      begin
        AdjCount := 1;
        AdjList[1].Target := DummyIndex;
      end;
end;

function ReadInput: Boolean;
var
  I, J: Integer;
  Cell: Byte;
begin
  ReadLn(RowCount, ColCount, I, J);
  if(RowCount<1)or(ColCount<1)or(I<1)or(I>RowCount)or(J<1)or(J>ColCount)then
    exit(False);
  VertexCount := RowCount * ColCount + 1;
  DummyIndex := VertexCount - 1;
  SrcIndex := (I - 1) * ColCount + J - 1;
  SetLength(CellGraph, VertexCount);
  //read matrix
  for I := 0 to RowCount - 1 do
    for J := 0 to ColCount - 1 do
      begin
        Read(Cell);
        if not (Cell in [0..1]) then
          exit(False);
        CreateVertex(Cell, I, J);
      end;
  //add dummy vertex
  CellGraph[DummyIndex].Delay := 0;
  CellGraph[DummyIndex].AdjCount := 0;
  Result := True;
end;

begin
  if not ReadInput then
    begin
      WriteLn('Wrong input');
      exit;
    end;
  Bfm(CellGraph, SrcIndex, Paths, Times);
  WriteLn(Times[VertexCount - 1]);
  DstIndex := Paths[VertexCount - 1];
  WriteLn(DstIndex div ColCount + 1, ' ', DstIndex mod ColCount + 1);
end.

UPD: получается, что путь из ячейки на предыдущую строку и любой путь из ячейки последней строки,
кроме пути в фиктивную, смысла добавлять не имеет.
UPD2: динамический массив для списков смежности в данном случае перебор, обновил код.

[runewalsh]

iskander
Громоздко, но красиво.
Проверки на aSize > 0 не нужны: SetLength(a, 0) эквивалентно a := nil, а FillDWord(LiterallyAnyPointer^, 0, ...) — это no-op.

[iskander]

Проверки на aSize > 0 не нужны

Да, конечно, спасибо. Обновил код.

Добавлено спустя 19 часов 45 минут 30 секунд:

Мне как бы намекнули, что задачу можно решить двумерным динамическим программированием

Это оно?

Код: Выделить всё

program turtle2;
{$MODE OBJFPC}

uses
  SysUtils;

const
  DELAY_ZERO = 3;
  DELAY_UNIT = 1;

type
  TMatrix = array of array of Integer;

var
  SrcMatr: TMatrix = nil;
  RowCount: Integer = 0;
  ColCount: Integer = 0;
  SrcRow: Integer = 0;
  SrcCol: Integer = 0;
  DstCol: Integer = -1;
  BestTime: Integer = High(Integer);

function ReadInput: Boolean;
var
  I, J: Integer;
  Cell: Byte;
begin
  ReadLn(RowCount, ColCount, SrcRow, SrcCol);
  if(RowCount<1)or(ColCount<1)or(SrcRow<1)or(SrcRow>RowCount)or(SrcCol<1)or(SrcCol>ColCount)then
    exit(False);
  SetLength(SrcMatr, RowCount, ColCount);
  for I := 0 to RowCount - 1 do
    for J := 0 to ColCount - 1 do
      begin
        Read(Cell);
        if not (Cell in [0..1]) then
          exit(False);
        if Cell = 0 then
          SrcMatr[I, J] := DELAY_ZERO
        else
          SrcMatr[I, J] := DELAY_UNIT;
      end;
  Result := True;
end;

function Min(a, b: Integer): Integer;
begin
  if a > b then
    Result := b
  else
    Result := a;
end;

procedure Solve;
var
  PathMatr: TMatrix;
  I, J: Integer;
begin
  SetLength(PathMatr, RowCount, ColCount);
  PathMatr[SrcRow - 1, SrcCol - 1] := SrcMatr[SrcRow - 1, SrcCol - 1];

  for J := SrcCol - 2 downto 0 do
    PathMatr[SrcRow - 1, J] := PathMatr[SrcRow - 1, J + 1] + SrcMatr[SrcRow - 1, J];
  for J := SrcCol to ColCount - 1 do
    PathMatr[SrcRow - 1, J] := PathMatr[SrcRow - 1, J - 1] + SrcMatr[SrcRow - 1, J];
  for I := SrcRow to RowCount - 1 do
    PathMatr[I, SrcCol - 1] := PathMatr[I - 1, SrcCol - 1] + SrcMatr[I, SrcCol - 1];

  for I := SrcRow to RowCount - 1 do
    for J := SrcCol - 2 downto 0 do
      PathMatr[I, J] := Min(PathMatr[I - 1, J], PathMatr[I, J + 1]) + SrcMatr[I, J];
  for I := SrcRow to RowCount - 1 do
    for J := SrcCol to ColCount - 1 do
      PathMatr[I, J] := Min(PathMatr[I - 1, J], PathMatr[I, J - 1]) + SrcMatr[I, J];

  for J := 0 to SrcCol - 1 do
    if PathMatr[RowCount - 1, J] < BestTime then
      begin
        BestTime := PathMatr[RowCount - 1, J];
        DstCol := J + 1;
      end;
end;

begin
  if not ReadInput then
    begin
      WriteLn('Wrong input');
      exit;
    end;
  Solve;
  WriteLn(BestTime);
  WriteLn(RowCount, ' ', DstCol);
end.