Реализация перетекания массы в графике - Turbo Pascal

  1. Привет всем!) Помогите с задачкой)) Собственно формулировка задачи такова: На плоскости заданы n материальных точек. С некоторого момента точка с наименьшей массой исчезает, передавая свою массу ближайшей к ней точке. Так продолжается до тех пор, пока не останется одна точка. Реализовать этот процесс и найти оставшуюся точку. буду очень благодарен!)


textual

Код:

uses crt,graph;
const nmax=100;
type point=record
           x,y:integer;
           m:real
           end;
var a:array[1..nmax] of point;
    n,m,i,j,k,imn1,imn2:integer;
begin
clrscr;
repeat
write('Kol. tochek ot 3 do ',nmax,' n=');
readln(n);
until n in [2..nmax];
randomize;
initgraph(i,j,'');
setcolor(12);
setfillstyle(1,12);
for i:=1 to n do
 begin
  a[i].x:=20+random(getmaxX-40);
  a[i].y:=20+random(getmaxY-40);
  a[i].m:=10+10*random;
  circle(a[i].x,a[i].y,round(a[i].m));
  floodfill(a[i].x,a[i].y,12)
 end;
while n>1 do
 begin
  if a[1].m<a[2].m then
   begin
    imn1:=1;
    imn2:=2;
   end
  else
   begin
    imn1:=2;
    imn2:=1;
   end;
  for j:=3 to n do
   begin
    if a[j].m<a[imn1].m then
     begin
      imn2:=imn1;
      imn1:=j
     end
    else if a[j].m<a[imn2].m then imn2:=j;
   end;
  {вычислим радиус новой точки по формуле r3=exp(ln(r1^3+r2^3)/3)}
  a[imn2].m:=exp(ln(exp(ln(a[imn2].m)*3)+exp(ln(a[imn1].m)*3))/3);
  if imn1=n then n:=n-1
  else
   begin
    for k:=imn1 to n-1 do
    a[k]:=a[k+1];
    n:=n-1
   end;
  delay(1000);
  cleardevice;
  setcolor(12);
  setfillstyle(1,12);
  for i:=1 to n do
   begin
    circle(a[i].x,a[i].y,round(a[i].m));
    floodfill(a[i].x,a[i].y,12)
   end;
 end;
readln
end.


Похожие ответы
  1. Добрый День, помогите пожалуйста. В одномерном массиве, заполняемом целыми числами, найти участок между двумя отрицательными элементами с максимальной суммой элементов. Например, для массива 8 -9 10 -3 5 6 7 -1 3 5 0 1, ответ «5 6 7».

  1. Здравствуйте! В работе понадобилась программка для вычисления суммы, ради этого решил окунуться в мир TurboPascal, сложновато честно говоря. В общем, как должно работать: Вводишь начальную сумму + вводишь шаг(сумма, которая должна всегда плюсоваться к полученному результату), нужна возможность ввода количества шагов, например количество шагов 50 и программа сразу на экране показывает нам результаты 50 действий сложения. Что сделал: пока только плюсует шаг к полученному результату. Найдутся добрые люди, которые помогут отредактировать код так, чтобы можно было вводить количество шагов, а не тыкать каждый раз на Enter чтобы увидеть следующий шаг? П.С.: Заранее извиняюсь, если не понятно изъясняюсь.

  1. Срочно помогите пожалуйста!!! Очень срочно нужно сделать прогу Тема: Реализация алгоритма построения минимального остовного дерева для графа. Если можно исправить эту прогу

  1. Нужна реализация именно на Turbo Pascal аналога Си-шной функции strtok. Помогите. Документация: Кликните здесь для просмотра всего текста function strtok char * strtok ( char * str, const char * delimiters ); Split string into tokens A sequence of calls to this function split str into tokens, which are sequences of contiguous characters separated by any of the characters that are part of delimiters. On a first call, the function expects a C string as argument for str, whose first character is used as the starting location to scan for tokens. In subsequent calls, the function expects a null pointer and uses the position right after the end of the last token as the new starting location for scanning. To determine the beginning and the end of a token, the function first scans from the starting location for the first character not contained in delimiters (which becomes the beginning of the token). And then scans starting from this beginning of the token for the first character contained in delimiters, which becomes the end of the token. The scan also stops if the terminating null character is found. This end of the token is automatically replaced by a null-character, and the beginning of the token is returned by the function. Once the terminating null character of str is found in a call to strtok, all subsequent calls to this function (with a null pointer as the first argument) return a null pointer. The point where the last token was found is kept internally by the function to be used on the next call (particular library implementations are not required to avoid data races). Parameters str C string to truncate. Notice that this string is modified by being broken into smaller strings (tokens). Alternativelly, a null pointer may be specified, in which case the function continues scanning where a previous successful call to the function ended. delimiters C string containing the delimiter characters. These can be different from one call to another. Return Value If a token is found, a pointer to the beginning of the token. Otherwise, a null pointer. A null pointer is always returned when the end of the string (i.e., a null character) is reached in the string being scanned.C1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 /* strtok example */ #include #include   int main () {   char str[] ="- This, a sample string.";   char * pch;   printf ("Splitting string \"%s\" into tokens:\n",str);   pch = strtok (str," ,.-");   while (pch != NULL)   {     printf ("%s\n",pch);     pch = strtok (NULL, " ,.-");   }   return 0; }Output: Splitting string "- This, a sample string." into tokens: This a sample string

  1. Помогите пожалуйста. Я не изучал только делфи, а надо сделать в паскале вставку на ассемблере. Задача: Как сделать ассемблерную вставку с помощью логических операций заданного значения (0 или 1) в любой бит байта со сдвигом влево и потерей крайнего бита ???

  1. Здравствуйте. Прошу помочь, есть программа на ABC паскале, но необходимо чтобы было написано в Turbo паскале. Нужно ее исправить. Если возможно, сделать проще и понятнее. Ниже прикреплена программа. И так же фотография как это все должно выводится на экране.

  1. Подскажите, если есть предложения, как Паскалем можно описать "Реализация метода Гаусса", это нам дали тему курсового проекта???

  1. Pascal1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 program chet; uses crt; var n,s:real;i:integer; begin    clrscr    write('Введите n   ');    readln(n);    S:=0;    i:=0;    repeat     i:=i+1;       begin         if i mod 2=0         then s:=s-1/(2*i)         else s:=s+1/(2*i);       end; until i=n; if s>0 then write('Четное') else write('Нечетное'); end.Что-то не получается никак( Что неправильно?

  1. помогите пожалуйста написать программу на тему:реализация процедуры поиска в ширину в графах