Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.12.2009, 19:27   #1
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию Игра на Pascal (обход в ширину)

Дана такая задача, заданы размеры поля, дана начальная точка и дана конечная точка, необходимо за минимальное количество ходов дойти до конечной точки, причем на поле встречаются препятствия.
s-старт
f-финиш
.-свододная летка
#-припятсвие

вот мой код:
Код:
program kolobok;
Const
     nmax=20;
     mmax=20;
Type
    tp=record
             x:integer;
             y:integer;
    end;
Var
    i,j,n,m,hod:integer;
    zzx,zzy:integer;    //êîîðäèíàòû òî÷êè ñòàðòà
    pole:array [0..nmax-1,0..mmax-1] of char; //ìàññèâ â êîòîðûé çàïèñûâàåòñÿ ïîëå
    l,r,tx,ty,zx,zy,k:Integer;
    q:array [0..100] of tp;   //õðàíèò î÷åðåäü
    d:array [0..nmax,0..mmax] of integer;        //õðàíèò ðàññòîÿíèÿ îò òî÷êè äî òî÷êè
    p:tp;
    dx,dy:array [0..3] of Integer; //ìàññèâû õðàíÿùèå êîîðäèíàòû âîçìîæíûõ çíà÷åíèé
    b,b2:boolean;
    input,output:text;
    
{------------------------------------ôóíêöèÿ ïîèñêà ìèíèìóìà--------------------}
function min(a,b:integer):integer;
begin
     if a<b then min:=a
     else min:=b;
end;

{------------------------------------ôóíêöèÿ ïîèñêà ìàêñèìóìà-------------------}
function max(a,b:integer):integer;
begin
     if a>b then max:=a
     else max:=b;
end;

{----------------------------ïðîöåäóðà ïîëîæåíèÿ çíà÷åíèÿ â î÷åðåäü-------------}
procedure push(xx,yy:Integer);
begin
     q[r].x:=xx;
     q[r].y:=yy;
     r:=(r+1)mod (nmax*mmax);
end;

{----------------------------ïðîöåäóðà èçúÿòèÿ çíà÷åíèÿ èç î÷åðåäè--------------}
procedure pop(var pp:tp);
begin
     pp.x:=q[l].x;
     pp.y:=q[l].y;
     q[l].x:=0;
     q[l].y:=0;
     l:=(l+1)  mod (nmax*mmax);;
end;

{------------------------------ïðîöåäóðà ââîäà äàííûõ---------------------------}
procedure InputData;
begin
     assign(input,'input4.txt');
     assign(output,'output4.txt');
     reset(input);
     rewrite(output);
     b:=true;
     l:=0;
     r:=0;
     dx[0]:=1;dx[1]:=-1;dx[2]:=0;dx[3]:=0;
     dy[0]:=0;dy[1]:=0;dy[2]:=1;dy[3]:=-1;
     read(input,n);
     read(input,m);
     For i:=0 to n-1 do
     begin
          for j:=0 to m-1 do
              read(input,pole[i,j]);
          readln(input);
     end;
end;

{------------------------------ïðîöåäóðà ââûâîäà äàííûõ-------------------------}
procedure OutputData;
begin
     For i:=0 to n-1 do
     begin
         For j:=0 to m-1 do
         begin
             Write(output,pole[i,j]);
             write(pole[i,j]);
         end;
         Writeln(output);
        // writeln;
     end;
     close(input);
     close(output);
end;
         
{------------------------------ãëàâíàÿ ïðîãðàììà--------------------------------}
 begin
      InputData;
      For i:=0 to n-1 do
          For j:=0 to m-1 do
             If pole[i,j]='S' then
             begin
                  d[i,j]:=0;
                  push(i,j);
                  zzx:=i;
                  zzy:=j;
             end
             else
                 if pole[i,j]='F' then
                 begin
                      zx:=i;
                      zy:=j;
                      d[i,j]:=1000;
                 end
                 else d[i,j]:=1000;
      while l<>r do
      begin
           pop(p);
           for i:=0 to 3 do
           begin
                tx:=p.x+dx[i];
                ty:=p.y+dy[i];
                if (tx>=0)and(tx<n)and(ty>=0)and(ty<m) then
                   If(pole[tx,ty]<>'#')and(d[tx,ty]=1000) then
                                                          if (pole[tx,ty]='F') then
                                                             d[tx,ty]:=min(d[tx,ty],d[p.x,p.y]+1)
                                                          else
                                                          begin
                                                               push(tx,ty);
                                                               d[tx,ty]:=d[p.x,p.y]+1;
                                                          end;
           end;
      end;
      If d[zx,zy]=1000 then
      begin
           writeln(output,'no');
           close(input);
           close(output);
      end
      else
      begin
           writeln(output,d[zx,zy]);
           While d[zx,zy]<>0 do
                 For i:=0 to 3 do
                 begin
                      tx:=zx+dx[i];
                      ty:=zy+dy[i];
                      if (tx>=0)and(tx<n)and(ty>=0)and(ty<m) then
                         if d[tx,ty]=d[zx,zy]-1 then
                            begin
                                 pole[tx,ty]:='*';
                                 zx:=tx;
                                 zy:=ty;
                            end;
                 end;
                 pole[zx,zy]:='F';
                 pole[zzx,zzy]:='S';
                 OutputData;
      end;

end.
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 17.12.2009, 19:29   #2
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

Пример входного файла
8 8
########
.......#
.#####.#
.#..S#.#
.#.###.#
.#.....#
.#######
.......F
Выходной файл:
31
########
*******#
*#####*#
*#**S#*#
*#*###*#
*#*****#
*#######
*******F

Помогите пожалуйста почему-то в выходном файле в первой стоке не выводятся 2 последних значения. Плиз сегодя нужно доделать. Зарание спасибо
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 17.12.2009, 20:15   #3
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

Че никто не знает как?
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 17.12.2009, 22:10   #4
Alex_FF
Удален
Форумчанин
 
Регистрация: 02.12.2009
Сообщений: 309
Смех

вот 100% правильное решение методом поиска в ширину:
Код:
program Project11;

const
  Source = 'input.txt';
  Target = 'output.txt';
  mapSize = 20;

type
  TMap = Array[1..mapSize, 1..mapSize] of Char;
  TMap2 = Array[1..mapSize, 1..mapSize] of Integer;

procedure DataInput(var Map: TMap; var N, M, xStart, yStart, xEnd, yEnd: Byte);
var
  X, Y: Byte;
begin
  Assign(Input, Source);
  Reset(Input);
  ReadLn(N, M);
  for Y := 1 to N do
  begin
    for X := 1 to M do
    begin
      Read(map[X, Y]);
      if map[X, Y] = 'S' then
      begin
        xStart := X;
        yStart := Y;
      end
      else if map[X, Y] = 'F' then
      begin
        xEnd := X;
        yEnd := Y;
      end;
    end;
    ReadLn;
  end;
end;

procedure Next(var X, Y: Byte; const N, M: Byte; const map2: TMap2);
begin
  if (X < M) and (map2[X, Y] - map2[X + 1, Y] = 1) then
  begin
    X := X + 1;
    Exit;
  end;
  if (X > 1) and (map2[X, Y] - map2[X - 1, Y] = 1) then
  begin
    X := X - 1;
    Exit;
  end;
  if (Y < N) and (map2[X, Y] - map2[X, Y + 1] = 1) then
  begin
    Y := Y + 1;
    Exit;
  end;
  if (Y > 1) and (map2[X, Y] - map2[X, Y - 1] = 1) then
  begin
    Y := Y - 1;
    Exit;
  end;
end;


var
  xStart, yStart, xEnd, yEnd, X, Y, N, M, Moves: Byte;
  map: TMap;
  map2: TMap2;
  I: Integer;
  F: Boolean;
begin
  Assign(Output, Target);
  Rewrite(Output);
  DataInput(map, N, M, xStart, yStart, xEnd, yEnd);
  FillChar(map2, SizeOf(map2), 0);
  map2[xStart, yStart] := 1;
  I := 1;
  repeat
    Inc(I);
    F := False;
    for Y := 1 to N do
      for X := 1 to M do
        if map2[X, Y] = I - 1 then
        begin
          if (Y < N) and (map2[X, Y + 1] = 0) and (map[X, Y + 1] <> '#') then
          begin
            F := True;
            map2[X, Y + 1] := I;
          end;
          if (Y > 1) and (map2[X, Y - 1] = 0) and (map[X, Y - 1] <> '#') then
          begin
            F := True;
            map2[X, Y - 1] := I;
          end;
          if (X < M) and (map2[X + 1, Y] = 0) and (map[X + 1, Y] <> '#') then
          begin
            F := True;
            map2[X + 1, Y] := I;
          end;
          if (X > 1) and (map2[X - 1, Y] = 0) and (map[X - 1, Y] <> '#') then
          begin
            F := True;
            map2[X - 1, Y] := I;
          end;
        end;
    if not F then
    begin
      Write('-1');
      Halt;
    end;
  until map2[xEnd, yEnd] > 0;
  Moves := I - 1;
  X := xEnd;
  Y := yEnd;
  I := Moves;
  repeat
    if (map[X, Y] <> 'F') and (map[X, Y] <> 'S') then
      map[X, Y] := '*';
    Next(X, Y, N, M, map2);
    Dec(I);
  until (X = xStart) and (Y = yStart);
  WriteLn(Moves);
  for Y := 1 to N do
  begin
    for X := 1 to M do
      Write(map[X, Y]);
    WriteLn;
  end;
end.
Пример входа:

20 15
#F...#..#####..
#.......#####..
......######...
......#####....
.....######....
#......###.....
#........#.....
#..............
##.......###...
############...
############...
#######..###.##
####.........##
####...#..#####
####.....######
####......#####
##..........###
##............#
##............S
###..##..###...

Пример выхода:

39
#F***#..#####..
#...*...#####..
....*.######...
....*.#####....
....*######....
#...***###.....
#.....***#.....
#.......*****..
##.......###*..
############*..
############*..
#######..###*##
####....*****##
####...#*.#####
####....*######
####....**#####
##.......***###
##.........***#
##...........*S
###..##..###...

Последний раз редактировалось Alex_FF; 17.12.2009 в 23:40.
Alex_FF вне форума Ответить с цитированием
Старый 18.12.2009, 05:09   #5
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

спасибо, но исправила свою, там соовсем небольшой косяк был.
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 18.12.2009, 18:30   #6
Alex_FF
Удален
Форумчанин
 
Регистрация: 02.12.2009
Сообщений: 309
По умолчанию

всё-таки я рекомендую использовать моё решение, оно более соответствует теме поиска в ширину, и выглядит лучше...
К тому же я его тестировал на лабиринтах размером 200x200 (на delphi компилировал - в pascal стек переполнится) и оно работает абсолютно правильно.
Alex_FF вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Обход бинарного дерева в ширину. Delphi 7. ZhooZhik Помощь студентам 4 01.12.2011 02:48
обход графа в ширину! КсенияСергеевна Общие вопросы C/C++ 0 12.12.2009 23:25
обход графа в ширину anemy Помощь студентам 0 20.11.2009 01:02
Обход графа в ширину. ZhooZhik Помощь студентам 1 06.04.2009 08:35