Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача про упругие соударения шаров
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Юзер
Подскажите алгоритм или исходник для задачи.Задача про упругие столкновения N-того количества шаров о друг друга и отенки сосудов.Или направте где эта тема уже рассматривалась.
Lapp
М
Тема нарушает Правила Форума (п.4) и правила раздела Задачи (п.1). Просьба исправить - или она будет закрыта.

Lapp
Спасибо.

Опиши задачу немного подробнее, плз. Какой уровень приближения? Задача двумерная или трехмерная? Сколько шаров? Одинакового они размера и у каждого свой? Массы тоже - разные или одинаковые? Как задан сосуд? Насколько он сложный?
Юзер
Сосуд это весь экран.Задача 2-ух мерная.Сначала шары по к штук в правой и влевой части экрана появляются в разных точках этих областей.Сосуд в начале разделён перегородкой.Шары одинакойвой массы и размера.Потом шары начинают своё движение,сталкиваясь друг с другом и со стенками сосуда.

Добавлено через 1 мин.
program Billiard;
{ Моделируем упругие столкновение шаров }
uses
Graph, Crt;
const
BgiPath = 'd:\pascal\bgi';
Nn = 40; { число шаров }
r = 12; { радиус шара }
d = 2*r; { диаметр шара }
d_2 = d*d; { квадрат диаметра }
doubled_2 = 4*d_2; { квадрат двойного диаметра }
Vmax = 0.2; { амплитуда скорости }
tau = r/3/Vmax; { шаг по времени }
TimeDelay = 0; { задержка по времени }
type
TData = Extended;
TBall = record
X, Y: TData;
Xold, Yold: TData;
Vx, Vy: TData;
dVx, dVy: TData;
Color : Integer;
end;
var
Balls : array [1..Nn] of TBall;
N : Integer; { реальное число шаров }
procedure GraphBegin;
var
Gd, Gm: Integer;
Begin;
Gd:= Detect;
InitGraph (Gd, Gm, BgiPath);
End; { GraphBegin }
procedure DrawBalls;
{ стираем/рисуем шары }
var
i : Integer;
Begin
Rectangle (0,0, GetMaxX, GetMaxY);
for i:= 1 to N do
with Balls[i] do begin
SetColor(Black);
Circle(Round(Xold),Round(Yold),r);
SetColor(Color); Circle(Round(X),Round(Y), r);
end;
End; { DrawBalls }
procedure Swap;
{ ротация координат для обеспечения движения }
var i : Integer;
Begin
for i:= 1 to N do
with Balls[i] do begin
Xold:= X; Yold:= Y;
end;
End; { Swap }
procedure InitBalls;
{ Определяем начальное положения и скорости шаров }
var
Nw, Nh, Num, H, k : Integer;
Begin
Randomize;
{ определяем максимальное количество шаров }
Nw:= GetMaxX div (2*d); { по горизонтали }
Nh:= GetMaxY div (2*d); { по вертикали }
{ корректируем заданное число шаров }
if Nn >= Nw*Nh then N:=Nw*Nh else N:= Nn;
Num:= 1; { количество размещенных шаров }
H:= 2*r; { начальная y-координата }
while Num <= N do begin
with Balls[Num] do begin
k:= Num mod Nw;
if k = 0 then Xold:= 2*r+4*r*(Nw-1)
else Xold:= 2*r+4*r*(k-1);
Yold:= H;
Vx:= -Vmax+Random*2*Vmax;
Vy:= -Vmax+Random*2*Vmax;
dVx:= 0;
dVy:= 0;
Color:= 1+Random (15);
end;
if k = 0 then Inc (H, 4*r);
Inc (Num);
end;
End; { InitBalls }
procedure BlowBetween;
{ отслеживаем удар }
var
i, j: Integer;
X0, Y0, Vx0, Vy0 : TData;
r0_2, V0_2, S, Discr, t : TData;
Begin
{ для каждой пары шаров }
for i:=1 to N do
for j:=i+1 to N do begin
{ Переходим в систему отсчета, связанную с i-ым
шаром }
X0:=Balls[j].X-Balls[i].X;
Y0:=Balls[j].Y-Balls[i].Y;
Vx0:=Balls[j].Vx-Balls[i].Vx;
Vy0:=Balls[j].Vy-Balls[i].Vy;
r0_2:=Sqr(X0)+Sqr(Y0);
if r0_2 <= doubled_2 then begin
{ проверяем направление движения }
S:=X0*Vx0+Y0*Vy0;
if S < 0 then begin
{ столкновение произойдет }
V0_2:=Sqr(Vx0)+Sqr(Vy0);
Discr:=Sqr(S)-(r0_2-d_2)*V0_2;
if Discr >= 0 then begin
{ две частицы находятся
недалеко друг от друга }
t:=(-S-sqrt(Discr))/V0_2;
if t < tau then begin
{ столкновение происходит }
S:=S/r0_2;
with Balls[i] do begin
dVx:=X0*S; dVy:=Y0*S;
end;
with Balls[j] do begin
dVx:=-Balls[i].dVx;
dVy:=-Balls[i].dVy;
end;
end;
end;
end;
end;
end;
End; { BlowBetween }
procedure BlowBounds;
{ соударения со стенками }
var i : Integer;
Begin
for i:= 1 to N do
with Balls [i] do begin
if X < r then begin
X:= r; Vx:=-Vx;
end
else if X > GetMaxX-r then begin
X:= GetMaxX-r; Vx:=-Vx;
end;
if Y < r then begin
Y:= r; Vy:=-Vy;
end
else if Y > GetMaxY-r then begin
Y:=GetMaxY-r; Vy:=-Vy;
end;
end;
End; { BlowBounds }
procedure Move;
{ собственно обсчет движения }
var
i : Integer;
Begin
for i:= 1 to N do
with Balls [i] do begin
Vx:= Vx+dVx; Vy:= Vy+dVy;
X:= Xold+Vx*tau; Y:= Yold+Vy*tau;
dVx:=0; dVy:=0;
end;
End; { Move }
BEGIN
GraphBegin;
InitBalls;
repeat
Move;
BlowBetween;
BlowBounds;
DrawBalls;
Swap;
Delay (TimeDelay);
until KeyPressed;
END.


М
Тэпи!! Правила Форума, п.5, и правила раздела Задачи, п.2
Исправлено.
Lapp



Добавлено через 11 мин.
Из задачи Billiard,я беру процедуры,но чёта толком ничего не получается.Мне нужно написать под борланд паскаль,а не под турбо.
Lapp
Цитата(Юзер @ 25.03.2010 4:11) *
Из задачи Billiard,я беру процедуры,но чёта толком ничего не получается.Мне нужно написать под борланд паскаль,а не под турбо.
Не вижу особой разницы между Borland и Turbo, если делается для Graph. Должно получаться, если делать правильно. Только в таком "программировании" - курочить чужую прогу - я тебе не помощник. Захочешь сделать сам - помогу..

P.S.
Что-то там не в порядке в отражением от стенок - на глаз видно.
Lapp
Цитата(Lapp @ 25.03.2010 4:43) *
P.S.
Что-то там не в порядке в отражением от стенок - на глаз видно.
Обвинение снято. Померещилось... smile.gif
Юзер
Да знаю я что разницы особо нет,но всё же возведение в сепень в турбо не надо прописывать.И задачу я сам пытаюсь написать вот тока пока ничего хорошего ток начало.А ту проста нашёл думал как исходник использовать,там ведь процедуры нужные smile.gif
program ball;
uses crt, graph;
const N=9;
r=40;
var
gd,gm,i,d,x1,x2,y1,y2:integer;
begin
gd:=detect;
initgraph(gd,gm,'C:\BP\bgi');
Randomize;

rectangle(0,0,GetMaxX,GetMaxY);
setcolor(white);
Line(320,0,320,480);
for i:=1 to N do
begin

x1:=random(238);
y1:=random(398);
x2:=random(238);
y2:=random(398);
SetColor(red);
circle(41+x1,41+y1,r);
setcolor(cyan);
circle(361+x2,41+y2,r);

end;
end.

как задать чтоб они все сразу рисовались?
volvo
Что значит "сразу"? Сразу ничего не бывает - рисоваться в любом случае будет по очереди. Тебе нужно будет потом шары перемещать, так что надо хранить текущие координаты каждого шара, а для этого нужен массив. Вот ты не просто так получай X и Y, а сначала заноси их в массив, а потом пробегай по всему массиву, и рисуй все шары...

То же самое касается и перерисовки - опять же идешь оп всему массиву, окружность по старым координатам "гасишь", вычисляешь новые координаты, и перерисовываешь окружность в новом месте.

Но, собственно, это все есть в вышеприведенной программе. Что именно тебя там не устраивает - я так и не понял. В чем разница BP/TP? Борланд - это который под Windows что-ли? Что надо изменить в поведении "бильярда", чтоб получилось то, что тебе нужно?
Юзер
Разница BP и TP в различном компиляторе вроде.Мне нужно не просто движения шаров,а чтобы вначале они были отгорожены перегородкой посредине,слева красные справа синие.Потом она убирается иони перемешиваются типо,т.е. летают по всему экрану.И ещё та прога что Billiard она не хочет на BP запускатся ошибка 116.Поэтому пытаюсь сам с исп процедур из Billiard сделать под BP прогу.
volvo
Цитата
она не хочет на BP запускатся ошибка 116.
Ошибка 116 - это "Должен быть в режиме 8087". Зайди в опции компилятора и включи использование сопроцессора...

P.S.
Цитата
Мне нужно не просто движения шаров,а чтобы вначале они были отгорожены перегородкой посредине,слева красные справа синие.Потом она убирается иони перемешиваются типо,т.е. летают по всему экрану
Программа Billiard абсолютно точно решает эту задачу... Все, что тебе нужно - правильно инициализировать шары, то есть подкорректировать процедуру InitBalls, чтобы изначально расположить шары именно там, где нужно. И чуть-чуть подправить BlowBounds, чтоб сначала (до убирания перегородки) проверялось столкновение с этой перегородкой, а потом, когда ее уберешь - чтоб процедура BlowBounds работала так, как она работает сейчас. Все, больше ничего править не надо.

Тут делов-то (если разберешься в программе, что именно она делает, и как, а не будешь переписывать по образу и подобию, не понимая о чем речь) на полчаса максимум...
Юзер
Стоит галочка на Emulation в Numeric Processing.Ставлю галочку на 8087/80287.Но после этого запускаю прогу и вылетает.В чём проблема?Это то что нада было поставить?
volvo
Запускаешь - вылетает, или компилируешь - Не компилируется, выдавая ошибку №116? Если первое - то я написал, что делать - все галки связанные с сопроцессором должны быть установлены, программа - пересобрана (Compile -> Build)

Если второе - то вообще непонятно, что у тебя происходит: ошибки времени выполнения под номером 116 нет ни в ДОСе, ни под Windows. Повторяю вопрос: ЧТО ТАКОЕ БОРЛАНД ПАСКАЛЬ? Ты хотя бы скриншот приведи, а то из тебя все клещами вытягивать приходится. Не знаю я Борланд-Паскаля. Борланд - это название фирмы, которая производила компилятор "Турбо-Паскаль". Есть пункт меню Help -> About. Что он говорит? Версия у языка есть, или как?
Юзер
Ctrl+9 запускаю и вылетает из паскаля сразу.До того как не стояла вторая галочка на сопроцессорах в настройках при запуске выдавал ошибку 116.
Я лично сторонник турбо паскаля smile.gif ,но в универе по програмированию либо free pascal,либо Borland Pascal.

Borland Pascal
Реализация языка программирования Pascal

Borland Pascal — это более полная версия Turbo Pascal. В целом, у этих двух продуктов очень много общего:

Язык программирования в них один и тот же, а скомпилированные TPU модули реального режима можно использовать в любой из этих реализаций. У этих реализаций даже общий файл справки. Borland Pascal при отображении справочной системы автоматически заменяет Turbo Pascal на Borland Pascal. Поэтому, когда говорят о Turbo Pascal, обычно имеют в виду и Borland Pascal тоже.

Несмотря на то, что Turbo Pascal — дешёвая урезанная версия Borland Pascal, Turbo Pascal — более устоявшееся название в русскоязычном сообществе. Поэтому бОльшая часть информации находится на странице Turbo Pascal, а здесь будут описаны только отличия этих двух реализаций:

Turbo Pascal имеет две версии: для DOS (самая последняя 7.1) и для Windows (самая последняя 1.5) Borland Pascal. Это разные продукты.

Borland Pascal имеет две версии: для защищённого режима DOS и для Win16. Обе версии поставляются одновременно в одном продукте (самая последняя версия Borland Pascal with Objects 7.01)

Turbo Pascal умеет компилировать в оперативную память или на диск

Borland Pascal всегда компилирует на диск

Turbo Pascal умеет создавать приложения только той среды, в которой выполняется сам.

Borland Pascal умеет создавать приложения для реального и защищённого режимов DOS, а также для Win16. Причём, можно из досовского Паскаля компилировать для Win16 и наоборот.

Turbo Pascal Compiler находится в файле TPC.EXE

Borland Pascal Compiler находится в файле BPC.EXE

Turbo Pascal IDE находится в файле TURBO.EXE или TPW.EXE

Borland Pascal IDE находится в файлах BP.EXE (для DOS) и BPW.EXE (для Win16)

Для неискушённого человека Borland Pascal является каким–то не тем Паскалём. Вроде как нужен Turbo, a это какой–то Borland. На самом деле, Borland Pascal без проблем заменяет Turbo Pascal. Смело используйте BP.EXE вместо TURBO.EXE.

А вот к Win16 версиям как раз стоит относиться с осторожностью.

Список отличий, не претендующий на полноту:

Вместо модулей DOS и Crt нужно использовать WinDOS и WinCRT. Они предоставляют аналогичный функционал. При компиляции для DOS нужно заменять обратно.

Некоторые имена типов в Win16 версии начинаются на T. Например, в модуле DOS есть тип Registers. Этот же тип в модуле WinDOS называется TRegisters.

Некоторые модули отсутствуют, а их аналоги сильно отличаются. Вместо Graph нужно использовать GDI, вместо Turbo Vision — Object Windows Library.

Номера версий представляют интерес только для истории. Гоняться за единичкой после семёрки не стоит. На практике, при выборе версии лучшей следует считать ту, в которой исправлено больше известных ошибок (если об исправленной ошибке не сказано в описании, скорее всего, она не исправлена). Например, частый источник проблем — Crt.Delay. Для него есть всяческие исправления. При этом, чаще всего это исправление всего лишь устраняет ошибку 200, а длительность Delay становится в несколько раз меньше заданного интервала, что нежелательно.
Lapp
Цитата(Юзер @ 26.03.2010 4:06) *
Номера версий представляют интерес только для истории.
Не только номера версий, но и сам Turbo/Borland Pascal. Если у вас можно использовать FPC - значит, его НУЖНО использовать. Ты можешь быть сторонником хоть Римской Империи или неандертальцев, но если ты учишься на программера - ты должен использовать современные средства (в своем классе и по доступности).
Юзер
Error 207: Invalid floating point operation в проге Billiard после запуска пишет ,то выкидывает как бы через раз.
П.С.Началось после того как в настройках вроде бы как нашёл и поставил в опциях компилятора использование сопроцессора.Подскажите из-зи чего ошибка???
Lapp
Цитата(Юзер @ 29.03.2010 15:59) *
Подскажите из-зи чего ошибка???
Это было бы намного проще сделать, если бы ты не поленился написать, в какой строке сбой.. У меня все работало все "на ура". Я вижу, например, пару делений, которые могли бы вызвать такую ошибку, но все же хотелось бы поточнее информацию об ошибке.
Юзер
Всё нашел сам,теперь всё пашет.Lapp или volvo подскажите как лучше сделать в программе бильярд чтобы в начале шары были в одной стороне красные в другой синие,м/у сторонами перегородка они об неё ударяются,а потом она исчезает и они летают по всему сосуду.Я пробывал как volvo написал сделать но увы не выходит,не получается одними только изменениями в InitBalls даже добится чтобы шары появлялись в разных часях экрана.Сумел только сделать половину шаров красными и половину синими.
Т.е. как round(xold) задать в промежутке от 20 до 320 и в 340 до 620.И вообще Round это округление?Как задать на эту переменную данные условия?
volvo
Цитата
Я пробывал как volvo написал сделать но увы не выходит,не получается одними только изменениями в InitBalls даже добится чтобы шары появлялись в разных часях экрана
Ну как же не получается? Все получается. Вот так, например, у тебя будут только красные шары и только в левой части экрана (скорости Vx и Vy сброшены в 0, чтобы ты увидел, что это именно так)

procedure InitBalls;
var
i, j: integer;
isIntersect: boolean;
TX, TY: TData;
Begin
Randomize;

n := Nn div 2;
for i := 1 to n do
with Balls[ i ] do
begin
repeat
TX := random((GetMaxX div 2) - D) + r;
TY := random(GetMaxY - D + r);

isIntersect := False;
for j := 1 to i - 1 do
if sqrt(sqr(TX - Balls[j].X) + sqr(TY - Balls[j].Y)) < D then
begin
isIntersect := True; break;
end;
until not isIntersect;

XOld := TX; YOld := TY;

Color := Red;
Vx := 0; { -Vmax+Random*2*Vmax; }
Vy := 0; { -Vmax+Random*2*Vmax; }
dVx := 0;
dVy := 0;
end;
End; { InitBalls }


Добавь сюда же еще один такой же цикл, в котором координаты X генерируются в правой части (TX := random((GetMaxX div 2) - D) + r + (GetMaxX div 2)), и замени цвет шаров на синий - вот и будут у тебя слева - все красные, а справа - все синие шары.

А ты говоришь "не получается".
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.