Ось с прямоугольниками, найти общую площадь

[sp.caster]

не вариант.

[Mad_Cat]

тогда вот начало)

type Tpoint = record // тип Точка
  x:real;// координата x
  y:real;// координата y
 end;
Type TRect = record // тип Прямоугольник
 lh:tpoint;// левый верхний угол 
 pl:Tpoint;// правый нижний угол
end;
Type masR = array[1..100] of Trect; // тип Массив Прямоугольников

var R:masR;// массив исходных прямоугольников

procedure obmen(R1:Trect;R2:TRect);
var Tmp:Trect;// Вспомогательная переменная
begin
Tmp:=R1;
R1:=R2;
R2:=Tmp;
end;
// сортировка массива прямоугольников по алгоритму Сержа
procedure SortMas(mr:masR;k:integer);
var i,j:integer;
f:boolean;
begin
f:=true;
while f do begin
f:=false;
for i:=1 to k-1 do
if mr[i].lh.x>mr[i+1].lh.x then begin obmen(mr[i],mr[i+1]);f:=true;end;
end;
end;

[sp.caster]

спасибо и на этом. огромное.

А можно узнать, что кроется под Tpoint, lh, pl, masR, tmp, R1, R2, ,mr?

[sp.caster]

а что делает процедура обмен?
Что делает данная часть кода?

begin
f:=true;
while f do begin
f:=false;
for i:=1 to k-1 do

Извиняюсь за большое количество вопросов, просто для меня сильно сложно, а разобраться очень нужно!

[Serge_Bliznykov]

а что делает процедура обмен?

обменивает две переданные координаты (кстати, имхо там в описании параметоров var пропущен)

Что делает данная часть кода?

сортирует массив (модификация обычной сортировки "пузырьком")

[Serge_Bliznykov]

радуйтесь тому, что Ваша задачка заинтересовала меня...
деньги высылайте почтовым переводом!

А вот решение:

{
Дана ось, на которой множество прямоугольников, 
найти площадь фигуры образованной ими.

http://www.programmersforum.ru/showthread.php?t=147511

}

type Tpoint = record { тип Точка }
    x: double; { координата x }
    y: double; { координата y }
  end;
type TRect = record { тип Прямоугольник }
    lh: Tpoint; { левый верхний угол  }
    pl: Tpoint; { правый нижний угол }
  end;

type masR = array[1..100] of Trect; { тип Массив Прямоугольников }


procedure obmen(var R1,R2: TRect);
var Tmp: Trect; { Вспомогательная переменная }
begin
  Tmp := R1;
  R1 := R2;
  R2 := Tmp;
end;

{ сортировка массива прямоугольников по алгоритму Сержа }
procedure SortMas(var mr: masR; N: integer);
var i, j: integer;
  f: boolean;
begin
  f := true;
  while f do begin
    f := false;
    for i := 1 to N - 1 do
      if (mr[i].lh.x > mr[i + 1].lh.x) or
           ( (mr[i].lh.x = mr[i + 1].lh.x)  {если левые границы совпадают, тогда сортируем по правым границам}
               and (mr[i].pl.x = mr[i + 1].pl.x))  then
      begin
        obmen(mr[i], mr[i + 1]);
        f := true;
      end;
  end;
end;


{ найти координату ближайщей к LeftX справа границы }
function Find_Right(mr: masR;  N : integer; LeftX, MaxRightX : double) : double;
var i  : integer;
    RX    : double;
begin
  RX := MaxRightX;

  for i:=1 to N do 
    if (mr[i].lh.X > LeftX) and (mr[i].lh.X < RX) then 
      RX := mr[i].lh.X; 

  {теперь проверим, может какой-то из прямоугольников расположенных левее
      имеет правую границу ближе справа... :) }
  for i:=1 to N do 
    if (mr[i].pl.X > LeftX) and (mr[i].pl.X < RX) then 
      RX := mr[i].pl.X; 

  Find_Right := RX;
end;

{найти максимальную высоту между высотами LeftX и RightX }
function Find_Height(mr: masR;  N : integer; LeftX, RightX : double) : double;
var i  : integer;
    Ht : double;
begin
  Ht := 0;
  {WriteLn('---------------------');}
  for i:=1 to N do 
    if (mr[i].lh.X <= LeftX ) and (mr[i].lh.X < RightX)
             and (mr[i].pl.X >= RightX)  then begin
      {WriteLn('в промежуток: ',LeftX:1:0,' ', RightX:1:0,' попал ',i,' прямоугольник с высотой ',mr[i].lh.Y:1:0);}
    if mr[i].lh.Y > Ht then Ht := mr[i].lh.Y;
  end;
  Find_Height := Ht;

end;


var 
  R : masR; { массив исходных прямоугольников }
  N : integer; {количество прямоугольников}
  i, j : integer;
  S : double; { переменная для площади}
  H, LeftX, RightX, MaxRightX : double;  


begin
  WriteLn;
  Write('Введите, сколько прямоугольников Вы хотите ввести [1..100] : '); 
  Readln(N);
  if (N<1) or (N>100) then begin WriteLn('Стопэ! Неверное число. Программа прощается с Вами...'); halt(1) end;
  for i:=1 to N do begin
    {WriteLn('Введите левую границу, правую границу и высоту прямоугольника:'); }
    Readln( R[i].lh.X, R[i].pl.X, R[i].lh.Y );
    R[i].pl.Y := 0; {все прямоугольники нижней стороной расположены на оси, поэтому координа у них 0}
    if R[i].lh.X >= R[i].pl.X then begin
      WriteLn('Правая граница не может быть левее левой...');
      Halt(2);
    end;
    if (R[i].lh.Y<0) then begin
      WriteLn('Прямоугольники должны быть над осью (координата Y должна быть больше нуля)');
      Halt(2);
    end;

  end;

  SortMas(R, N);

  WriteLn;
  WriteLn('Выведем прямоугольники (координаты в формате (X,Y) )...');
  for i:=1 to N do
    WriteLn(i,' Лев.верхний: (',R[i].lh.X:8:2,',',R[i].lh.Y:8:2,
                ') правый нижний: (',R[i].pl.X:8:2,',',R[i].pl.Y:8:2,')');

  {найдём максимальную правую границу}
  MaxRightX := R[1].pl.X;
  for i:=1 to N do 
    if MaxRightX < R[i].pl.X then MaxRightX := R[i].pl.X;

  {основной цикл перебора прямоугольников}
  S := 0;
  LeftX := R[1].lh.X;
  repeat
     RightX := Find_Right(R, N, LeftX, MaxRightX );

     H := Find_Height(R, N, LeftX, RightX);

     S := S + H * (RightX - LeftX) ;

     LeftX := RightX;

  until abs(RightX-MaxRightX)<0.00001; {проверка на то, что RightX достигла самого крайнего значения}

  WriteLn('Площадь равна: ',S:12:2);

end.

p.s. теоретически должно работать, если между прямоугольниками есть пустоты..
но этот случай я не проверял...

[sp.caster]

о боже, Вы не представляете как мне помогли!!! Спасибо огромное!

у меня еще будут интересные задачки=) но я буду стараться сам, ну а если что не так, то буду знать где помогут=)

[sp.caster]

а если чудь подправить код и написать что число треугольников допустим от 1 до 1000? или более? ничего страшного?

[Serge_Bliznykov]

а если чудь подправить код и написать что число треугольников допустим от 1 до 1000? или более? ничего страшного?

Да хоть 2000! никаких проблем.
Алгоритм там линейный..
Лишь бы в один сегмент 64 кб размер структуры входил (ограничение TurboPascal (MS DOS) )

[sp.caster]

если разрыв между прямоугольниками, то считает только площадь первого