Живые и Твёрдые Издательский Дом Коммерсантъ

Координатный метод вычисления площади произвольной фигуры

Координатный метод вычисления площади произвольной фигуры был разработан мной в 1985 году и использован в спецчасти дипломного проекта:
"Разработка космического аппарата для исследования планеты Юпитер"
(МАИ, факультет космонавтики).

Проблема: по заданным точкам, определяющим контур фигуры в декартовой системе координат, вычислить площадь фигуры.
Суть метода: пройти по контуру фигуры от точки к точке, вычисляя площадь под каждым отрезком и суммируя её. Суммирование выполняется в соответсвии со знаком приращения абсциссы (x), получающимся при переходе от точки Ai к точке Ai+1.

Пример:

при обходе фигуры (рис. 1) от точки A0 до А9 положительные приращения по оси X существуют между точками:
  • 0, A1} ⇒ A1(x) - A0(x) = 12.7-2 = 10.7
  • 1, A2} ⇒ A2(x) - A1(x) = 16 - 12.7 = 3.3
  • 2, A3} ⇒ A3(x) - A2(x) = 19.2 - 16 = 3.2
  • 3, A4} ⇒ A4(x) - A3(x) = 30 - 19.2 = 10.8
  • 5, A6} ⇒ A6(x) - A5(x) = 26 - 21.5 = 4.5
  • 8, A9} ⇒ A9(x) - A8(x) = 10.25 - 6 = 4.25
отрицательные приращения по оси X существуют между точкам:
  • 4, A5} ⇒ A5(x) - A4(x) = 21.5-30 = -8.5
  • 6, A7} ⇒ A7(x) - A6(x) = 26 - 16 = -10
  • 7, A8} ⇒ A8(x) - A7(x) = 6 - 16 = -10
  • 9, A0} ⇒ A0(x) - A9(x) = 2 - 10.25 = -8.25
pict. 1 / рис. 1 .. area of the polygon / площадь многоугольника
Функция, вычисляющая площадь под отрезком, заданным двумя точками, в приведённом примере выглядит следующим образом 1:
ƒi, Ai+1) = (Ai+1(y) + Ai(y) ) / 2 * ( ( Ai+1(x) - Ai(x) ) / 2 )
В итоге площадь фигуры, заданной n координатами точек, определяется простым суммированием частных площадей:
  n-1
Sn = ƒi, Ai+1) + ƒn, A0)
  i=0

Реализация метода

В то далёкое время реализация метода была выполнена на языке FORTRAN. Текст вошёл в состав дипломной работы, которая пылится в архиве или уничтожена согласно правилам хранения такого рода материалов.

Для простоты изложения воспользуемся скриптовым вариантом языка Visual Basic ( Windows Scripting Host - WSH ). Он поддерживает классы, с ним можно работать в любом текстовом редакторе и запускать непосредственно в Windows. Придерживаясь объектно-ориентированной модели реализуем координатный метод в виде класса.

Класс должен уметь:
  • добавлять координаты
  • вычислять площадь.
Замечания к исходному тексту:
  • Наименование основного класса - CPolyhedron (многогранник)
  • Вспомогательные классы - CLine (линия / отрезок) и CCoord (координата)
  • Проверочный класс - CTriangle (треугольник)

Класс Координата - CCoord

' Класс Координата (точки в декартовой системе координат)
Class CCoord
	Public X
	Public Y
	' инициализация нулевыми значениями
	SUB Class_Initialize
		X = 0
		Y = 0
	End Sub
	' установка новых значений координаты (точки)
	Sub SetCoord(xx, yy)
		X = xx
		Y = yy
	End Sub
End Class

Класс Линия (Отрезок) - CLine

' Класс Линия (прямой заданной начальной и конечной точками
' в декартовой системе координат)
Class CLine
	Private changed  ' флаг для пересчёта длины линии
	Private coordBeg ' начальная координата
	Private coordEnd ' конечная координата
	Private lenght   ' длина линии
	Private SquareUnderLine ' площадь "под" линией (до оси координат X)
	Private dx			' dx задаёт знак (+ или -) для площади под линией)
	Sub Class_Initialize
		' создание координат линии
		Set coordBeg = New CCoord
		Set coordEnd = New CCoord
		lenght = 0      	' нулевая длина
		SquareUnderLine = 0 ' нулевая площадь
		changed = False ' изменений нет... ничего пересчитывать не надо
	End Sub
	Sub setBegCoord(X,Y)
		coordBeg.X = X ' установка новой
		coordBeg.Y = Y ' начальной координаты линии
		changed = True ' взводим флаг для пересчёта длины и площади
	End Sub
	Sub setEndCoord(X,Y)
		coordEnd.X = X ' установка новой
		coordEnd.Y = Y ' конечной координаты линии
		changed = True ' взводим флаг для пересчёта длины и площади
	End Sub
	' Процедура пересчёта длины и площади
	' выполняется если изменялась какая-либо координата линии
	Sub ReCalc
		If changed Then ' если флаг взведён - выполняем пересчёт длины и площади
			lenght = Sqr( (coordEnd.X - coordBeg.X)^2 + (coordEnd.Y - coordBeg.Y)^2)
			''
			dx = coordEnd.X - coordBeg.X '' dx задаёт знак для площади под линией
			SquareUnderLine = (coordEnd.Y + coordBeg.Y)/2 * dx
			changed = False ' пересчитали - сбросим флаг
		End If
	End Sub

	Property Get getLen
		ReCalc ' пересчёт длины и площади
		getLen = lenght ' возвращаем длину
	End Property
	
	Function getSquareUnderLine
		ReCalc ' пересчёт длины и площади
		getSquareUnderLine = SquareUnderLine ' возвращаем площадь под линией
	End Function
End Class

Класс Треугольник - CTriangle

' Класс Треугольник
Class CTriangle
	Private coords ' массив координат треугольника
	Private lines ' массив сторон треугольника
	Private changed ' флаг для пересчёта
	Private P ' полупериметр треугольника 
	Private Square ' площадь треугольника
	SUB Class_Initialize
		' создаём массив координат треугольника
		coords = Array( New CCoord, New CCoord, New CCoord )
		' массив сторон треугольника
		lines = Array( New CLine, New CLine, New CLine )
		Square = 0 ' нулевая площадь
		P = 0 ' нулевой периметр
		changed = False
	End Sub
	Public Function SetCoord(index, X, Y)
		SetCoord = False
		If (index >= 0) And (index < 3) Then
			' установим координаты точки (index)
			coords(index).X = X
			coords(index).Y = Y
			'' установить начальные и конечные координаты сторон треугольника
			'' начальная координата точки 0 - есть конечная координата точки 2 .. и т.д.
			Select Case index
				Case 0 : lines(0).setBegCoord X, Y
				         lines(2).setEndCoord X, Y
				Case 1 : lines(1).setBegCoord X, Y
				         lines(0).setEndCoord X, Y
				Case 2 : lines(2).setBegCoord X, Y
				         lines(1).setEndCoord X, Y
			End Select
			changed = True
			SetCoord = True
		End If
	End Function
    ' список координат треугольника
	Sub List
		Dim s_, i
		For i = 0 To 2
			s_ = s_ & "i=" & i & " (" & coords(i).X & ", " & coords(i).Y & ")" & vbCrLf
		Next
		WScript.Echo s_
	End Sub
	' вычисление площади треугольника по формуле Герона
	Function getSquare
		If changed Then
			P = ( lines(0).getLen + lines(1).getLen + lines(2).getLen ) / 2
			Square = Sqr(P *(P-lines(0).getLen)*(P-lines(1).getLen)*(P-lines(2).getLen))
			changed = False
		End if
		getSquare = Square
	End Function
	' получить координату X точки index
	Function getCoordX(index)
		getCoordX = coords(index).X
	End Function
	' получить координату Y точки index
	Function getCoordY(index)
		getCoordY = coords(index).Y
	End Function
	' получить длину стороны index треугольника
	Function getSideLen(index)
		getSideLen = lines(index).getLen
	End Function
	' получить площадь под стороной index треугольника
	Function getSquareUnderLine(index)
		getSquareUnderLine = lines(index).getSquareUnderLine
	End Function
	' получить полупериметр треугольника
	Property Get getP
		getP = P
	End Property
End Class

Класс Многогранник - CPolyhedron

'' Класс Многогранник
Class CPolyhedron
	Private coords ' массив координат Многогранника
	Private changed ' 
	Private P ' периметр фигуры
	Private Sq ' площадь
	Sub Class_Initialize
		' массив координат Многогранника
		coords = Array( )
		Sq = 0 ' нулевая площадь
		P = 0 ' нулевой периметр
		changed = False
	End Sub
	'' количество точек (координат)
	Property Get Count
		Count = UBound(coords)
	End Property
	'' добавление координаты (в конец списка)
	Function Add(X, Y)
		lastindex = AddArrayItem4Coords()
		Set coords(lastindex) = New CCoord
		coords(lastindex).SetCoord X, Y
		Add = lastindex
	End Function
	'' добавление координаты перед index
	Function AddBefore(index, X, Y)
		lastindex = AddArrayItem4Coords()
		For i=lastindex-1 To index Step -1 
			Set coords(i+1) = coords(i)
		Next
		Set coords(index) = New CCoord
		coords(index).SetCoord X, Y
		AddBefore = lasteindex 
	End Function
	'' добавление координаты после index
	Function AddAfter(index, X, Y)
		lastindex = AddArrayItem4Coords()
		For i=lastindex-1 To index+1 Step -1 
			Set coords(i+1) = coords(i)
		Next
		Set coords(index+1) = New CCoord
		coords(index+1).SetCoord X, Y
		AddAfter = lastindex
	End Function
	'' добавление записи в конец массива координат
	Private Function AddArrayItem4Coords
		changed = True
		index = UBound(coords)
		lastindex = index+1
		ReDim Preserve coords(lastindex)
		AddArrayItem4Coords = lastindex
	End Function
	'' изменение координаты index
	Sub Upd(index, X, Y)
		If index >=0 And index <= UBound(coords) Then
			changed = True
			coords(index).SetCoord X, Y
		End if
	End Sub
	' получить значение X, координаты index
	Function getX(index)
		getX = Null
		If index >=0 And index <= UBound(coords) Then
			getX = coords(index).x
		End If
	End Function
	' получить значение Y, координаты index
	Function getY(index)
		getY = Null
		If index >=0 And index <= UBound(coords) Then
			getY = coords(index).Y
		End If
	End Function

	Sub ReCalc
		Dim i, l, c
		' если флаг взведён - выполняем пересчёт длины и площади
		If changed Then
			Set l = New CLine
			Sq = 0 : P = 0
			c = UBound(coords)
			For i=0 To c
				l.setBegCoord coords(i).X, coords(i).Y
				If i = c Then
				  l.setEndCoord coords(0).X, coords(0).Y
				Else
				  l.setEndCoord coords(i+1).X, coords(i+1).Y
				End If
				'' суммируем значения площадей под отрезками
				Sq = Sq + l.getSquareUnderLine
				'' суммируем длинны отрезков
				P = P + l.getLen
			Next
			changed = False ' пересчитали - сбросим флаг
			Set l = Nothing
		End If
	End Sub

	Public Property Get Square
		'' пересчёт длины и площади
		ReCalc
		'' Площадь не должна зависить от направления обхода фигуры
		'' поэтому возвращаем абсолютное значение площади
		Square = Abs(Sq)
	End Property
	
	Public Property Get Perimetr
		'' пересчёт длины и площади
		ReCalc
		Perimetr = P
	End Property
	'' для отладки
	Public Sub List
		Dim c, i, s_
		c = Count
		For i = 0 To Count
			 s_ = s_ & "i=" & i & " (" & getX(i) & ", " & getY(i) & ")" & vbCrLf
		Next
		WScript.Echo s_
	End Sub
	'' очистить массив координат
	Public Sub Clear
		Set coords = Nothing
		coords = Array( )
		changed = True
	End Sub
End Class

Тестирование координатного метода

''============================================ Testing
Dim PP '' многогранник
Dim t, t1, t2, t3, t4, t5, t6, t7 '' треугольники состовляющие многогранник
'' создаём многогранник
Set PP = New CPolyhedron
'' задаём координаты см. значения координат на рисунке выше
PP.Add 6, 4
PP.Add 10.25, 14.5
PP.Add 2, 20
PP.Add 12.7, 20
PP.Add 16, 28
PP.Add 19.2, 20
PP.Add 30, 20
PP.Add 21.5, 14.5
PP.Add 26, 4
PP.Add 16, 10.5
'' готово! все координаты введены. 
'' Достаточно вызвать метод PP.Square 
'' чтобы получить значение площади многогранника. 
WScript.Echo "Площадъ = " & PP.Square
'' Но правильно ли работает метод? 
'' Исключительно в целях тестирования создаём треугольники, из которых состоит наш многогранник, 
'' просуммируем их площади и сравним со значением выдаваемым методом PP.Square 
Set t  = New CTriangle
Set t1 = New CTriangle
Set t2 = New CTriangle
Set t3 = New CTriangle
Set t4 = New CTriangle
Set t5 = New CTriangle
Set t6 = New CTriangle
Set t7 = New CTriangle
'' задаём координаты треугольников
'' для 3-х точек ( i = {0, 1, 2} )
'' t.SetCoord i, X, Y
t.SetCoord 0, 6, 4
t.SetCoord 1, 10.25, 14.5
t.SetCoord 2, 16, 10.5

t1.SetCoord 0, 10.25, 14.5
t1.SetCoord 1, 2, 20
t1.SetCoord 2, 12.7, 20

t2.SetCoord 0, 12.7, 20
t2.SetCoord 1, 16, 28
t2.SetCoord 2, 19.2, 20

t3.SetCoord 0, 19.2, 20
t3.SetCoord 1, 30, 20
t3.SetCoord 2, 21.5, 14.5

t4.SetCoord 0, 21.5, 14.5
t4.SetCoord 1, 26, 4
t4.SetCoord 2, 16, 10.5

t5.SetCoord 0, 16, 10.5
t5.SetCoord 1, 10.25, 14.5
t5.SetCoord 2, 12.7, 20

t6.SetCoord 0, 16, 10.5
t6.SetCoord 1, 12.7, 20
t6.SetCoord 2, 19.2, 20

t7.SetCoord 0, 16, 10.5
t7.SetCoord 1, 19.2, 20
t7.SetCoord 2, 21.5, 14.5
'' Суммируем площади треугольников, входящих в многогранник
sTriangles = t.getSquare + t1.getSquare + t2.getSquare + t3.getSquare_
           + t4.getSquare + t5.getSquare + t6.getSquare + t7.getSquare
'' если значения площадей вычисленных координатным методом
'' и методом разбиения ( многогранника ) на треугольники совпадают,
'' выдаём значение "pass" - тест пройден.
'' Координатный метод работает правильно и
'' его можно использовать для вычисления площадей.
If sTriangles = PP.Square Then
	res = "pass"
Else
	'' в случае несовпадения результатов - выдаём значение "fail" - тест не пройден.
	'' Координатный метод работает не правильно...
	res = "fail"
End If
WScript.Echo res

Set PP = Nothing
Set t  = Nothing
Set t1 = Nothing
Set t2 = Nothing
Set t3 = Nothing
Set t4 = Nothing
Set t5 = Nothing
Set t6 = Nothing
Set t7 = Nothing
Рейтинг@Mail.ru Photo & Фото