IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача про жуков))
сообщение
Сообщение #1


Гость






Помогите плиз решить задачку с использованием динамических списков:

Файл содержит информацию о местах на плоскости некоторого количества жуков. Продемонстрировать (К примеру в матрице - считая в ней 1-жук, 0 - нету жука) поведение колонии жуков на K шагах(каждый шаг матрица меняется). В течение одного шага каждый жук преследует следующего за ним жука. Последний жук преследует первого жука. Если в конце шага жук приблизился к преследуемому жуку ближе, чем на E(задаваемое пользователем число), он поедает преследуемого жука.

Очень надеюсь на вашу помощь и заранее благодарен)))
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Вот написал - почти всё работает - жучки бегают но некоторые время от времени размножаются)))) появляется 2 одинаковых)) немогу найти ошибку - Помогите плиз
Заранее благодарен

Код

program Zuki;
type
Dzuk=^Zuk;
Zuk=record
    num:   integer;
    x,y:   integer;
    pnext:     Dzuk
    end;
tmas=array [1..12] of array [1..12] of integer;

var pBeg,pnex,ppr,p1,p2,pd:Dzuk;
    input,output:text;
    n,m,i,j,k,l:integer;
    e:real;
    mas:tmas;

procedure obnul(var as:tmas);
var c,d:integer;
begin
for c:=1 to 12 do begin
   for d:=1 to 12 do as[c,d]:=0;
                  end;
end;

procedure vivod(var as:tmas);
var c,d:integer;
begin
for c:=1 to 12 do begin
   for d:=1 to 12 do if as[c,d]=0 then write(output,'_  ')
                        else write(output,as[c,d],'  ');
   writeln(output);
                  end;
end;


procedure shag(var d1,d2:Dzuk);
var a1,b1,a2,b2:integer;  h:real; r:Dzuk;
begin
a1:=d1^.x;
b1:=d1^.y;
a2:=d2^.x;
b2:=d2^.y;
if a1<a2 then a1:=a1+1;
if b1<b2 then b1:=b1+1;
if a1>a2 then a1:=a1-1;
if a1>a2 then b1:=b1-1;
d1^.x:=a1;
d1^.y:=b1;
h:=sqrt(sqr(a2-a1)+sqr(b2-b1));
if h<e then begin
            r:=d1^.pnext;
            d1^.pnext:=d1^.pnext^.pnext;
            if r=pBeg then pBeg:=d1^.pnext;
            r^.pnext:=nil; k:=k-1;
            end;

end;


begin
assign(input,'input.txt');  reset(input);
assign(output,'output.txt'); rewrite(output);
read(input,n);
writeln(output,'kol-vo zukov =',n);
read(input,m);
writeln(output,'kol-vo wagov =',m);
read(input,e);
writeln(output,'rassto9nie poedani9 =',e);
k:=n;
{____sozdaem___spisok__________________________}
new(p1);
p2:=p1;
pBeg:=p1;
p1^.num:=1;
read(input,p1^.x);
read(input,p1^.y);
for i:=2 to n do
   begin
        new(p2^.pnext);
        p2:=p2^.pnext;
        p2^.num:=i;
        read(input,p2^.x);
        read(input,p2^.y);
   end;
p2^.pnext:=p1;
{_______________________________________________}
ppr:=pBeg;
pnex:=pBeg;
for i:=1 to n do begin
mas[pnex^.x,pnex^.y]:=pnex^.num;
pnex:=pnex^.pnext;
end;
vivod(mas);
writeln(output,'************************');


for j:=1 to m do begin
    obnul(mas);
    ppr:=pBeg;
    for i:=1 to k do begin
ppr:=ppr^.pnext;
end;
     for l:=1 to k do begin
     shag(ppr,ppr^.pnext);
     mas[ppr^.x,ppr^.y]:=ppr^.num;
     ppr:=ppr^.pnext;
     end;

        vivod(mas);
        writeln(output,'************************');

end;

close(output);
end.


Сообщение отредактировано: Shook Its On -


Прикрепленные файлы
Прикрепленный файл  zuki.rar ( 2.19 килобайт ) Кол-во скачиваний: 163
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.04.2024 10:05
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name