Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Решение задач на Pascal. Форум 2
Отметить все сообщения как прочитанные   [ Помощь ]
» Добро пожаловать на форум "Информационные технологии" «

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 ]
Модераторы: paradise, KMA
  

Dale



Участник

MzSpider  
Попробовал вникнуть в суть задачи нарисовть схемку
схемка
http://a-463.narod.ru/Untitled-1.swf
Задача на вычисление кратчайшего пути.
У нас есть К вселенных; на вселенной, от которой начинается отсчет, располагается N планет. На планетах бывают порталы на другие планеты.
Чтобы переместится на другую планету с помощью портала, нужна таблетка. Чтобы переместится между двумя порталми внутри планеты (на дирижабле), нудно love. Причем стоимость между любой парой порталов может быть разная.


(Сообщение отредактировал Dale 21 сен. 2009 9:11)

-----
Прикольная песня :-)

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 21 сен. 2009 9:10 | IP
zhumadilov


Новичок


Цитата: Dale написал 21 сен. 2009 8:30

    спс

Всего сообщений: 2 | Присоединился: сентябрь 2009 | Отправлено: 22 сен. 2009 9:37 | IP
MzSpider



Новичок

Я на олимпиаде вот эту задачу не решил , здесь походу процедура вызывает саму себя и ищет оптимальный вариант

Всего сообщений: 19 | Присоединился: июль 2009 | Отправлено: 23 сен. 2009 14:08 | IP
Dale



Участник

можно через и через рекурсию, но можно ее и обойти.. Как нибудь попробую решить ее на досуге

Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 24 сен. 2009 15:47 | IP
lolth


Новичок

Все решения тут:
http://magegame.ru/?rf=e3e0e7eeedeeeaeef1e8ebeae0

Всего сообщений: 24 | Присоединился: сентябрь 2009 | Отправлено: 25 сен. 2009 18:59 | IP
MzSpider



Новичок

Памагите дорешать , надо в ламберинте искать выход (комп сам ишет), я написал только на кнопках передвигаться вот код :
uses crt;
label m0, m1, m2;
var
mas    : array [1..80, 1..25] of char;
f      : text;
x, y   : byte;
mx, my : byte;
px, py : byte;
ky     : char;
map    : byte;
IsLast : byte;
systemtimer:longint absolute $0040:$006C;

procedure delau(t:longint);
var
 n,p:longint;
begin
 x:=0;
 n:=systemtimer;
 while ((p-n)/18.2)*1000<p do
   p:=systemtimer;
end;

function IsMovPosible (dir : byte) : boolean;
begin
  IsMovPosible := false;
  if (dir = 1) and (mas[px, py - 1] <> '1') then IsMovPosible := true;
  if (dir = 2) and (mas[px, py + 1] <> '1') then IsMovPosible := true;
  if (dir = 3) and (mas[px - 1, py] <> '1') then IsMovPosible := true;
  if (dir = 4) and (mas[px + 1, py] <> '1') then IsMovPosible := true;
end;

procedure LoadMap(MapNum : byte);
var
mn : string;
begin
str(MapNum, mn);
assign(f , 'c:\game\stage' + mn + '.bag');
reset(f);
readln(f, mx);
readln(f, my);
readln(f, IsLast);
for y := 1 to my do
   begin
        for x := 1 to mx - 1 do
            begin
                 read(f, mas[x, y]);
                 if mas[x,y] = '2' then
                    begin
                         px := x;
                         py := y;
                    end;
             end;
        readln(f, mas[x + 1, y]);
   end;
close(f);
end;

begin
map := 1;

m0:
clrscr;
LoadMap(map);

for y := 1 to my do
begin
   for x := 1 to mx do
   begin
        gotoxy(x, y);
        if mas[x, y] = '1' then write ('Ы');
        if mas[x, y] = '2' then write ('M');
        if mas[x, y] = '3' then write ('‹');
   end;
end;

m1:
  ky := readkey;
  gotoxy(px, py);
  write(' ');
  if (ky = '8') and (py > 1) and IsMovPosible(1) then py := py - 1;
  if (ky = '2') and (py < 25) and IsMovPosible(2) then py := py + 1;
  if (ky = '4') and (px > 1) and IsMovPosible(3) then px := px - 1;
  if (ky = '6') and (px < 79) and IsMovPosible(4) then px := px + 1;
  gotoxy(px,py);
  write('M');
   if mas[px,py] = '3' then
     begin
         clrscr;
         writeln('Minotavr zashel v JIogovo');
                   readln;
         if IsLast = 1 then goto m2;
         map := map + 1;
         goto m0;
     end;
  if (ky = 'q') or (ky = 'Q')  then goto m2;
goto m1;
m2:
readln;
end.

Всего сообщений: 19 | Присоединился: июль 2009 | Отправлено: 26 сен. 2009 13:58 | IP
MzSpider



Новичок

Пример Фаила :
5
5
0
11111
12001
11101
13001
11111


Всего сообщений: 19 | Присоединился: июль 2009 | Отправлено: 26 сен. 2009 14:00 | IP
MzSpider



Новичок

1 - стенка
2 - минотавр(чел)
3 - выход

Всего сообщений: 19 | Присоединился: июль 2009 | Отправлено: 26 сен. 2009 14:02 | IP
Dale



Участник

 MzSpider  
Мой совет: никогда.... Никогда! не используй метки.
От них ничего, кроме проблем...
И их всегда можно обойти.

Предлагаю такой код к вашей задаче:
Code Sample:
 
uses crt;
var
mas    : array [1..80, 1..25] of char;
f      : text;
x, y   : byte;
mx, my : byte;
px, py : byte;
ky     : char;
c:char;
map    : byte;
IsLast : byte;
i,j,k,k2:integer;


function IsMovPosible (dir : byte) : boolean;
var b:boolean;
begin
 b:=false;
 case dir of
  1: {up}   b:=mas[px, py - 1] <> '1';
  2: {down} b:=mas[px, py + 1] <> '1';
  3: {JIEBO}b:=mas[px-1,py]<>'1';
  4: {npaBo}b:=mas[px+1,py]<>'1';
 end;
 IsMovPosible:=b;
end;

function IsNextLevel:boolean;
begin
 IsNextLevel:= mas[px,py]='3'
end;

procedure LoadMap(MapNum : byte);
var
mn : string;
begin
str(MapNum, mn);
assign(f , 'c:\game\stage' + mn + '.bag');
reset(f);
readln(f, mx);
readln(f, my);
readln(f, IsLast);
i:=1;
j:=1;

while i<=mx do begin
while j<=my do begin
 read(f,c);
 if (ord(c)<>13) and (ord(c)<>10) then begin
  mas[j,i]:=c;
  if (c='2') then begin
    px:=i;
    py:=j;
    mas[i,j]:='0';
  end;
  j:=j+1;
 end;
end;
i:=i+1;
j:=1;
end;
close(f);
end;

procedure write_map;
begin
for j:=1 to mx do begin
for i:=1 to my do
case (mas[i,j]) of
'1':write(#219);
'2':write(#2);
'3':write(#31);
'0':write(' ');
end;{case}
writeln;
end;
end;


function getXY:integer;
var b:integer;
begin
{пол. куда двигаться: вверх, низ, лево или прво}
while not IsMovPosible(b) do  b:=random(4)+1;
getXY:=b;
end;

begin
map := 1;
clrscr;
randomize;
LoadMap(map);
while true do begin
 clrscr;
 write_map;
 gotoxy(px,py);
 write(#2);
 if IsNextLevel then begin
    clrscr;
    writeln('Минотавр зашел в логово');
        if IsLast = 1 then
        begin
          readkey;
          halt;
        end;
    map:=map+1;
    LoadMap(map);
 end;
 {Это если клавиши}
 {c:=readkey;
 case c of
 #27:halt;
 #72:if IsMovPosible(1) then py:=py-1;
 #80:if IsMovPosible(2) then py:=py+1;
 #75:if IsMovPosible(3) then px:=px-1;
 #77:if IsMovPosible(4) then px:=px+1;
 end;}
 {а это если случайное направление}
k:=getXY;
 case k of
 1:if IsMovPosible(1) then py:=py-1;
 2:if IsMovPosible(2) then py:=py+1;
 3:if IsMovPosible(3) then px:=px-1;
 4:if IsMovPosible(4) then px:=px+1;
 end;

 sound(5000);
 delay(500);
 nosound;
 delay(30000);
end;
end.


Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 26 сен. 2009 20:57 | IP
Dale



Участник

Тут я реализовал пока что движение минотавра в случайном направлении.

комментарии

IsNextLevel определяет, зашел минотавр в логово или нет
write_map выводит массив с картой
getXY выдает направление (пока случайное) от 1 до 4

в самой программе бесконечный цикл
В нем действия развиваются по следующему алгоритму:
1) очистка экрана
2) вывод карты
3) вывод человечка
4) определение следующих координат человечка.

Выход из цикла осуществляется с помощью процедуры halt.



Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 26 сен. 2009 21:08 | IP

Эта тема закрыта, новые ответы не принимаются

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 ]

Форум работает на скрипте © Ikonboard.com