Задача про упругие соударения шаров Опции

[Юзер]

Подскажите алгоритм или исходник для задачи.Задача про упругие столкновения N-того количества шаров о друг друга и отенки сосудов.Или направте где эта тема уже рассматривалась.

Сообщение отредактировано: Юзер - 24.03.2010 18:39

[Юзер]

Сосуд это весь экран.Задача 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,я беру процедуры,но чёта толком ничего не получается.Мне нужно написать под борланд паскаль,а не под турбо.