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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 03.12.2009, 17:24   #1
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию Небольшая игра

Ребят омогите пожалуйста, а то я не могу понять как делать задачу. Прошу помочь, времени почти не осталось. Зарание спасибо.
Необходимо имея входной файл типа
4
....
*...
f..*
...s

Первая строка это количество строк=количествву столбцов, тоесть размер поля
Далее идет матрица, изображающая поле.
*-припятствие
.-свободная клетка
f-клетка в которую нужно придти
s-клетка из которой наинаем движение

Необходимо написать программу которая найдет минимальный путь из s в f. При этом растояние записывается в отельную матрицу, изначально она хранит -1. Необходимо использовать метод поиска в ширину.
В выходном файле необходимо через пробел вывести кординаты клеток по которым осуществится переход.

Код:
program game;
var
   fi,fo:text;
   a:array[1..100,1..100] of char; //поле
   b:array[1..100,1..100] of integer;    //расстояние
   i,j,n:integer;
   //структура которая хранит очередь, какую взять не знаю

{------------------------------ввод данных---------------------------}
procedure InputData;
begin
     assign(fi,'input4.txt');
     reset(fi);
     assign(fo,'output4.txt');
     rewrite(fo);
     readln(fi,n);
     for i:=1 to n do
     begin
         for j:=1 to n do
             read(fi,a[i,j]);
         readln(fi);
     end;
     for i:=1 to n do
          for j:=1 to n do
              b[i,j]:=-1;
end;



{---------------------------основная программа-----------------------------------}
begin
     InputData;
     
     
     close(fi);
     close(fo);
end.
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 03.12.2009, 18:34   #2
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

Ребят, кто-нибудь помогите пожалуйста
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 03.12.2009, 19:04   #3
NSvirus
пропагандирую жизЪ
Форумчанин
 
Аватар для NSvirus
 
Регистрация: 19.03.2007
Сообщений: 950
По умолчанию

К какому времени нужна программа?

Цитата:
Необходимо написать программу которая найдет минимальный путь из s в f
Цитата:
Необходимо использовать метод поиска в ширину.
Допустим матрица:

....
*.*.
F.*.
..*S

Как будет по вашему проходить в "ширину"?
Посторонним В.

Последний раз редактировалось NSvirus; 03.12.2009 в 19:08.
NSvirus вне форума Ответить с цитированием
Старый 03.12.2009, 19:15   #4
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

нужно, к завтра, поиск в ширину, это что-то наподобии волны, типо берем первую точку находим смежные клетки записываем их в очередь. Что-то в этом роде
Единственное, что ограничивает полет мысли программиста-компилятор
Sparky вне форума Ответить с цитированием
Старый 03.12.2009, 19:43   #5
ОДИНОЧЕСТВО В СЕТИ
Любопытная Вредина
Участник клуба
 
Аватар для ОДИНОЧЕСТВО В СЕТИ
 
Регистрация: 19.06.2009
Сообщений: 1,285
По умолчанию

Цитата:
Реализация на Паскале.
Основа: процедура Solve. Требуется массив a, где true — наличие преграды, и четыре целых числа S 1-2 x-y — координаты двух точек, между которыми мы ищем путь. Результат: массив path.
Код:
Код:
program lab;
uses Crt;
const max=3;
type range=1..max;
type TPoint=record x,y:range end;
var a:array[range,range] of boolean;
var n,S1x,S1y,S2x,S2y:range;
var path:array[1..max*max] of TPoint;
var steps:integer;
procedure Reading(filename:string);
          var F:Text; i,j:range; m:array[range,range]of byte absolute a;
          begin
               writeln('loading...');
               Assign(F,filename);
               Reset(F);
               readln(F,n);
               for i:=1 to n do
                 for j:=1 to n do
                   read(F,m[i,j]);
               read(F,S1x,S1y,S2x,S2y);
               Close(F);
               writeln('wait a moment...');
          end;
procedure Solve;
          var p:array[1..max*max] of TPoint;
          var m:array[range,range] of boolean; {marks}
          var head,tail:1..max*max;
          var EHBF:boolean; {Exit Has Been Found}
          var Cur:TPoint;
          procedure Add(x,y:range);
                    begin
                         if not m[x,y]
                            then begin
                                 m[x,y]:=true;
                                 inc(head);
                                 p[head].x:=x;
                                 p[head].y:=y;
                            end;
                         if (x=S2x) and (y=S2y) then EHBF:=true;
                    end;
          function Assigned(P1,P2:TPoint):boolean;
                    begin
                         Assigned:=(abs(P1.x-P2.x)=1) or (abs(P1.y-P2.y)=1);
                    end;
          procedure AddPart(po:tpoint);
                    begin
                         inc(steps);
                         path[steps]:=po;
                    end;
          begin
               fillchar(p,sizeof(p),0);
               steps:=0;
               head:=1;
               tail:=1;
               p[1].x:=S1x;
               p[1].y:=S1y;
               EHBF:=false;
               fillchar(m,sizeof(m),false);
               Repeat
                     Cur:=p[tail];
                     if (Cur.x<n) and not a[Cur.x+1,Cur.y] then Add(cur.x+1,cur.y);
                     if (Cur.y<n) and not a[Cur.x,Cur.y+1] then Add(cur.x,cur.y+1);
                     if (Cur.x>1) and not a[Cur.x-1,Cur.y] then Add(cur.x-1,cur.y);
                     if (Cur.y>1) and not a[Cur.x,Cur.y-1] then Add(cur.x,cur.y-1);
                     inc(tail);
               Until (tail>head) or EHBF;
               {searching for the path}
               if EHBF
                  then begin
                       while (p[head].x<>S2x) and (p[head].y<>S2y) do dec(head);
                       Cur:=p[head]; {=S2;}
                       AddPart(Cur);
                       while head>1 do
                             begin
                                  tail:=head;
                                  repeat
                                        if tail>1 then
                                           begin
                                                dec(tail);
                                                EHBF:=Assigned(p[head],p[tail]);
                                                if EHBF then AddPart(p[tail]);
                                           end;
                                  until EHBF or (tail=1);
                                  head:=tail;
                             end;
                  end;
          end;
procedure WritePath;
          var i:integer;
          begin
               for i:=1 to steps do
                   writeln(path[i].x,' ',path[i].y);
               readln;
          end;
begin
clrscr;
Reading('lab.txt');
Solve;
WritePath;
end.
кстати это из единственной темы,которая находится в поиске по форуму с ключевыми словами " поиск пути лабиринт ширину"
Дурь - это особая форма материи, которая не возникает ниоткуда и не исчезает никуда, а лишь переходит из одной головы в другую.

Последний раз редактировалось ОДИНОЧЕСТВО В СЕТИ; 03.12.2009 в 19:48.
ОДИНОЧЕСТВО В СЕТИ вне форума Ответить с цитированием
Старый 04.12.2009, 08:22   #6
Sparky
Участник клуба
 
Аватар для Sparky
 
Регистрация: 15.05.2009
Сообщений: 1,222
По умолчанию

Ребят помогите, доделать эту прогу:
Код:
program game;
type
    ocher=^Tocher;
    Tocher=record
                 x:integer;
                 y:integer;
                 next:ocher;
    end;

var
   fi,fo:text;
   a:array[1..100,1..100] of char; //ïîëå
   b:array[1..100,1..100] of integer;    //ðàñòîÿíèå îò ñòàðòîâîé êëåòêè äî òåêóùåé
   i,j,n:integer;
   head:ocher;
   inac,jnac:integer;
   ikon,jkon:integer;
   itec,jtec:integer;
   temp:ocher;
   
{------------------------------процедура ввода  данных---------------------------}
procedure InputData;
begin
     assign(fi,'input4.txt');
     reset(fi);
     assign(fo,'output4.txt');
     rewrite(fo);
     readln(fi,n);
     for i:=1 to n do
     begin
         for j:=1 to n do
         begin
             read(fi,a[i,j]);
             if a[i,j]='s' then
             begin
                  inac:=i;
                  jnac:=j;

             end;
             if a[i,j]='f' then
             begin
                  ikon:=i;
                  jkon:=j;
             end;
         end;
         readln(fi);
     end;
     for i:=1 to n do
          for j:=1 to n do
              if (i=inac) and (j=jnac) then b[i,j]:=0
              else b[i,j]:=-1;
end;

{---------------------------положить элемент в очередь----------------}
procedure push(var head:ocher;i,j:integer);
var
   p,q:ocher;
begin
     if head<>nil then
     begin
          new(q);
          q^.x:=i;
          q^.y:=j;
          q^.next:=nil;
          p:=head;
          while(p^.next<>nil) do
                              p:=p^.next;
          p^.next:=q;
     end
     else
     begin
          new(q);
          q^.x:=i;
          q^.y:=j;
          q^.next:=nil;
          head:=q;
     end;
end;
{процедура взятия значения из очереди}
procedure pop(var head:ocher);
var
   q:ocher;
begin
     q:=head;
     itec:=q^.x;
     jtec:=q^.y;
     head:=head^.next;
     dispose(q);
end;

{---------------------------ãëàâíàÿ ïðîãðàììà-----------------------------------}
begin
     InputData;
     push(head,inac,jnac);
     //ïîêà î÷åðåäü íå ïóòàÿ
     while head<>nil do
     begin
          pop(head);
     
{2.	Пока очередь не пуста: while Q<>empty(last=yk) do 
P=Q.pop(); // берем элемент из очереди
	For t принадлежит смежным точкам для P do 
		If является ли рассматриваемая точка препятствием then 
			Пытаемся улучшить путь до этой точки (D[D.x][D.y]= D[D.x][D.y]+1)
Q.Push(t);

}
     end;
end.
Нужно как то сделать поиск(то что в комментах)
Единственное, что ограничивает полет мысли программиста-компилятор

Последний раз редактировалось Sparky; 04.12.2009 в 08:28.
Sparky вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Небольшая проблемка DirtyBASS Помощь студентам 2 05.10.2009 22:17
Небольшая проблемка Игорь777 Помощь студентам 1 02.05.2009 14:53
Задачка небольшая. Игорь777 Помощь студентам 5 18.04.2009 13:34
Небольшая задачка по СИ Wadroz Помощь студентам 1 29.10.2008 21:01
Игра озеро на Delphi, нужна небольшая помощь Serega123 Помощь студентам 11 03.06.2008 16:00