КУРСОВОЙ ПРОЕКТ
по дисциплине
«Программированиена языке высокого уровня»
на тему:
«Созданиепрограммы для определения вершин пирамиды с выпуклым основанием по даннымточкам»
Введение
Целью данного проекта –является закрепление материала, изложенного в курсе «Программирование на языкевысокого уровня» на основе какой-либо обобщающей задачи. В качестве таковойбыла выбрана задача определения пирамиды с выпуклым основанием по данным N точкам.
Данная задачапредполагает укрепление знаний в линейной алгебре и закрепление их в видерешения поставленной задачи на языке высокого уровня(Pascal)
Постановка Задачи
Разработать подпрограммудля определения вершин пирамиды с выпуклым основанием по данным точкам.
Создание демонстрационнойпрограммы для показа найденного решения. А так же создание библиотеки дляработы с векторами в пространстве.
Теоретические сведения
Векторы
Вектором называетсянаправленный отрезок.
/>
У вектора есть начало иесть конец. Обозначается вектор строчными латинскими буквами a, b, c,… илиуказанием его начала и конца, на первом месте всегда указывается начало. Начертежах вектор отмечается стрелкой. Иногда слово «вектор» не пишут, а ставятстрелочку над буквенным обозначением.
Вектор AB, AB, a
/>
Вектор AB и вектор CDназываются одинаково направленными, если полупрямые AB и CD одинаковонаправлены
Вектор AB и вектор CDназываются противоположно направленными, если полупрямые AB и CD противоположнонаправлены.
a и b одинаковонаправленные.
a и c противоположнонаправленные.
Абсолютной величинойвектора называется длина отрезка, изображающего вектор. Обозначается как |a| .
Вектором в пространстве называется направленный отрезок.
Координатами вектора сначалом в точке A1(x1; y1; z1) и концом в точке A2(x2; y2; z2) называются числаx2-x1, y2-y1, z2-z1. Вектор обозначается в пространстве так:
/>
/>
Есть вектора a. Пусть A(x; y) – начло вектора, а A` (x`; y`) – конец вектора. Координатами вектора aназываются числа a1=x-x`, a2=y-y`. Для обозначения того, что вектор a имееткоординаты a1 и a2, используют запись a (a1; a2) или (a1; a2).
Абсолютная величинавектора a (a1; a2) равна
/>
Если начало векторасовпадает с его концом, то это нулевой вектор, обозначается (0).
Сложение векторов
Суммой векторов a(a1; a2) и b(b1; b2) называетсявектор c(a1+b1; a2+b2).
Для любых векторов a(a1;a2), b(b1; b2), c(с1; с2) справедливы равенства:
/>
/>
Теорема Каковы бы ни были три точки A, B иC, имеет место векторное равенство
/>
Доказательство.
Пусть A(x1; y1), B(x2;y2), C(x3; y3) – данные три точки.
Вектор AB имееткоординаты (x2 – x1; y2 – y1), вектор BC имеет координаты (x3 – x2; y3 – y2).Следовательно, вектор AB + BCимеет координаты (x3 – x1;y3 – y1). А вектор ACимеет координаты (x3 – x1;y3 – y1). Значит, AC = AB+ BC. Теорема доказана.
Сложение векторов.Правило параллелограмма
/>
Правилом параллелограмма сложения векторов называетсяследующий способ:
Пусть есть векторы AB иAC у которых начало вектора совпадает, а концы не совпадают
/>
Достроим данный угол допараллелограмма, так что AC = BD и AB = CD.
/>
Тогда AB + BD = AD, а таккак BD = AC, то AB + AC = AD
/>
Сложение векторов.Правило треугольника
/>
Правилом треугольника сложения векторов называетсяследующий способ:
Пусть есть произвольныевекторы a и b. Надо от конца вектора a отложить вектор b`, равный вектору b.Тогда вектор, начало которого совпадает с началом вектора a, а конец совпадет сконцом вектора b`, будет суммой a + b.
Свойство умножениявектора на число
Теорема
Абсолютная величинавектора λa равна |λ| |a|. Направление вектора λa при a≠ 0совпадает с направлением вектора a, если λ>0, и противоположнонаправлению вектора a, если λ
/>
Доказательство.
Построим векторы OA и OBравные a и λa соответственно (O – начало координат). Пусть a1 и a2 –координаты вектора a. Тогда координатами точки A будут числа a1 и a2координатами точки B – числа λa1 и λa2. Уравнение прямой OA имеетвид: αx + βy = 0.
Так как уравнениюудовлетворяют координаты точки A (a1; a2), то ему удовлетворяют и координатыточки B (λa1; λa2). Отсюда следует, что точка B лежит на прямой OA.Координаты c1 и c2 любой точки C, лежащей на луче OA, имеют те же знаки, что икоординаты a1 и a2 точки A, и координаты любой точки, которая лежит на луче,дополнительном к OA, имеют противоположные знаки.
Поэтому, если λ >0, то точка B лежит на луче OA, а следовательно, векторы a и λa одинаковонаправлены. Если λ
Абсолютная величинавектора λa равна:
/>
Теорема доказана.
Теорема
Равные векторы имеютравные соответствующие координаты.
Доказательство
Рассмотрим два случая: 1)векторы не лежат на одной прямой.
/>
Пусть есть вектор a сначалом в точке A (x; y) и концом в точке A` (x`; y`). При параллельномпереносе получаем вектор b, у которого тогда начало будет в точке B(x+c; y+d),а конец в точке B`(x`+c; y`+d). Отсюда видно, что оба вектора будут иметь однии тебе координаты (x-x`; y-y`).
2) векторы лежат на однойпрямой.
/>
Пусть есть прямая l накоторой лежат равные векторы AA` и BB`. A(x; y), A`(x`; y`), B(x1;y1) и B(x1`;y1`). Проведем прямую l1 параллельную l и отложим на ней вектор CD равный AA` иBB`, C (x0; y0) и D (x0`; y0`). Так как AA` = CD, из предыдущего пунктаx-x`=x0-x0` и y-y`=y0-y0`. С другой стороны BB` = CD и x1-x1`=x0-x0`,y1-y1`=y0-y0`. Сравнивая равенства получаем x-x`=x1-x1` и y-y`=y1-y1`. Теоремадоказана.
Произведение вектораa(a1; a2) на число λназывается вектор (λa1; λa2), т.е. (a1; a2) λ = (λa1;λa2).
Для любого вектора a ичисел λ, μ
/>
Для любого вектора a и bи числа λ
/>
Коллинеарный вектор
/>
Два ненулевых вектораназываются коллинеарными, если они лежат на одной прямой или на параллельныхпрямых. Коллинеарные векторы либо одинаково направлены, либо противоположнонаправлены.
Коллинеарный вектор.Свойства
Теорема
Если есть два отличных отнуля коллинеарных вектора, то существует число λ такое, что
/>
Доказательство.
Пусть a и b одинаковонаправлены.
/>
— это векторы, которыеодинаково направлены и имеют одну и ту же абсолютную величину |b|. Значит, ониравны:
/>
Когда векторы a и bпротивоположно направлены аналогично заключаем, что
/>
Теорема доказана.
Теорема
Любой вектор с можнопредставить в виде
/>
Скалярным произведением векторов a (a1; a2) и a (b1; b2)называется число a1b1+a2b2.
/>
Для любых векторов a (a1;a2), b (b1; b2), c (с1; с2)
/>
Углом между ненулевымивекторами AB и ACназывается угол ABC. Углом между любыми двумя ненулевыми векторами a и bназывается угол между равными им векторами с общим началом.
Скалярное произведение.Свойство
Теорема
Скалярное произведениевекторов равно произведению их абсолютных величин на косинус угла между ними.
/>
Доказательство.
Пусть a и b – данныевекторы и φ – угол между ними. Имеем:
/>
или
/>
Скалярное произведение abтаким образом, выражается через длины векторов a, b и a + b т. е. системукоординат можно выбрать любую, а величина скалярного произведения не изменится.Выберем систему координат xy так, чтобы начало координат совпало с началомвектора a, а сам вектор лежал на положительной полуоси оси Ox. Тогдакоординатами вектора a будут числа |a| и 0, а координатами вектора a – |a| cosφ и |a| sin φ. По определению
/>
Теорема доказана.
Из теоремы следует, чтоесли векторы перпендикулярны, то их скалярное произведение равно нулю.
Плоскость, многоугольники
Плоскость
Теорема
Через прямую и не лежащуюна ней точку можно провести плоскость, и при том только одну.
/>
Доказательство
Пусть AB – данная прямаяи С – не лежащая на ней точка. Проведем через точки A и С прямую. Прямые AB иAC различны, так как точка С не лежит на прямой AB. Проведем через прямые AB иAC плоскость α. Она проходит через прямую AB и точку С.
Докажем, что плоскостьα, проходящая через прямую AB и точку С, единственна.
Допустим, существуетдругая, плоскость α.`, проходящая через прямую AB и точку С. По аксиоме отом, что если две различные плоскости имеют общую точку, то они пересекаются попрямой, проходящей через эту точку, плоскости α и α` пересекаются попрямой. Эта прямая должна содержать точки A, B, C. Но они не лежат на однойпрямой. Что противоречит предположению. Теорема доказана.
Выпуклый многоугольник
/>
Ломаная называется замкнутой,если ее концы соединены отрезком.
Если все звенья простойзамкнутой ломаной не лежат на одной прямой, то это многоугольник. Тогда точкиломанной называются вершинами многоугольника, а звенья – сторонамимногоугольника.
Многоугольник с nвершинами, называется n-угольником.
/>
Многоугольник называется выпуклым,если он лежит в одной полуплоскости относительно любой прямой, содержащей егосторону.A1A2A3A4A5A6A7 – выпуклый многоугольник.
/>
B1B2B3B4B5 – невыпуклыймногоугольник.
Выпуклые многоугольники.Свойство
Теорема.
Сумма углов выпуклогоn-угольника равна 180°*(n-2).
/>
Доказательство.
Нужно заметить, n ≥3.
Для n = 3 многоугольникпревращается в треугольник и теорема справедлива.
Для n > 3 проведем n-3 диагонали: A2An, A3An, …, An-1An. Получим n-2 треугольника: ΔA1A2An, Δ A2A3An, …, An-2An-1An. Сумма углов всех треугольников равнасумме углов многоугольника. Так как сумма углов треугольнике равна 180 ° ичисло треугольников равно n – 2, то сумма всех углов многоугольника равна 180°* (n — 2). Теорема доказана.
ОПИСАНИЕ ОБЩЕГО АЛГОРИТМА
Пункт1.Пользовательвводит N точек.
Пункт2.Программапроверяет, лежат ли все данные точки в одной плоскости, если лежат-то решениянет, вершины пирамиды не будут найдены, а на дисплей выведется сообщение «точкилежат в одной плоскости».(переход к пункту 6)
Пункт3. Если все данныеточки не лежат в одной плоскости, то программа берет N-1 точек (исключаемую точку принимая за возможную вершинупирамиды) и выполняет построение уравнения плоскости по 3-м точкам ,
Пункт4.Выполним проверку напринадлежность к данной плоскости оставшихся точек.В случае, если хотя бы однаточка из оставшихся точек не принадлежит к плоскости, то переходим к пункту 6.
Пунтк5.Выполним проверкувыпуклости многоугольника из полученной поверхности.( Проверка на выпуклостьпроверяется, как условие сохранения знака векторного произведение смежныхвекторов). Если же проверка N-1точек не даст того, что эти точки образуют плоскость, то из N точек будет взята другая точка ипроведена еще проверка на выпуклость многоугольника. И так пока не будутперебраны все возможные точки.
В случае удачной проверкина выпуклость программа выдаст сообщение о том, что были определены вершиныпирамиды с выпуклым основанием
Пункт6.вывод ответаОписание структур данных
Для храненияточек был использован динамическая структура данных- односвязанный список.Элемент списка представляет собой запись с 2 полями:
-полем данных
-полемуказателя на следующий элемент
В своюочередь поле данных представляет собой запись Coordinates с 3-я полями:x,y,z
Так же дляработы со списком использовались дескрипторы, которые представляли собой записис 3-я полями
-start(указатель на начальный(фиктивный )элемент)
-ptr(указатель на текущий элемент)
-Number(число элементов в записи)
Type
Coordinates=record{коориднаты}
x,y,z:real;
end;
P_Points=^point; {Описание типа Points}
point=record
data:Coordinates;
Next:P_Points;
end;
P_Descriptor=record {Дескриптор для работы со списком точек}
Start,Ptr:P_Points;
Number:Word;
end;
P_Vectors=^Vector;{Описание типа Vector}
Vector=record
data:Coordinates;
Next:P_Vectors;
end;
V_Descriptor=record {Дескриптор для работы со списком векторов}
V_Start,V_Ptr:P_Vectors;
V_Number:Word;
end;
Описание модуля
Спецификация подпрограммдля работы со списком
1.Спецификация процедуры InitListOfPoint;
1) ProcedureInitListOfPoint(var P:P_Descriptor);;
2) Назначение:инициализирует фикивный элемент списка;
3) Входныепараметры: P
4) Выходныепараметры: P.
2.Спецификация процедуры PutPoint;
1) ProcedurePutPoint(var P:P_Descriptor);
2) Назначение:создает элемент Buf и помещает егов список;
3) Входныепараметры: P;
4) Выходныепараметры: P;
3.Спецификация процедуры WritePoints;
1 Procedure WritePoints(var P:P_Descriptor);
2) Назначение:выводит весь список точек P на дисплей;
3) Входныепараметры: P;
4) Выходныепараметры: P.
4.Спецификация процедуры ReadPoint;
1) ProcedureReadPoint(var P:P_Descriptor;var a:Coordinates);
2) Назначение: cчитывает из списка P координаты точки в переменную а;
3) Входныепараметры: P;
4) Выходныепараметры: P,a.
5.Спецификация процедуры ClearMem;
1) ProcedureClearMem(var P:P_Descriptor;var V:V_Descriptor);
2) Назначение: освобождаетвыделенную память под списки P u V;
3) Входные параметры:P,V;
4) Выходныепараметры: P,V.
Спецификация подпрограммдля работы с векторами
1.Спецификация процедуры CreateVector;
1) procedureCreateVector (a,b:Coordinates;var c:Coordinates);;
2) Назначение: создаетвектор с вычитая соответствующие координаты точки b из точки a;
3)Входные параметры: a,b,c
4)Выходные параметры: c.
2.Спецификация процедуры MultOnNumber;
1) ProcedureMultOnNumber (Number:real; a:Coordinates;var c:Coordinates)
2)Назначение: умножаетвектор a на число real и полученное значение заносится в c вектор ;
3)Входные параметры: Number,a,c;
4)Выходные параметры: ,c;
3.Спецификация процедуры lengthOfVector;
1 FunctionlengthOfVector(a:Coordinates):real;
2Назначение: возвращаетдлину вектора а ;
3Входные параметры: а;
4Выходные параметры: -.
4.Спецификация процедуры Scalar;
1) Function Scalar(a,b:Coordinates):real;
2Назначение: возвращаетрезультат скалярного перемножение векторов а и b ;
3Входные параметры: a,b;
4Выходные параметры: -.
5.Спецификация процедуры angle;
1) Function angle(a,b:coordinates):real
2Назначение: возвращаетзначение косинуса угла(в радианах)
между векторами а и b
3Входные параметры: a,b;
4Выходные параметры: -.
6.Спецификация процедуры VECTMult;
1 ProcedureVECTMult(a,b:Coordinates;var c:Coordinates);
2Назначение: производитвекторное перемножение вектора а и b и заносит результат в вектор с ;
3Входные параметры: а,b,c ;
4Выходные параметры: c.
7.Спецификация процедуры collinearity;
1) Function collinearity(a,b:Coordinates):boolean;
2Назначение: возвращает collinearity:=истина, если векторы а и b коллинеарные, иначе- collinearity:=ложь ;
3Входные параметры: a,b;
4Выходные параметры: -.
5 возврат: collinearity
9.Спецификация процедуры MixeMult;
1) Function MixeMult(a,b,c:Coordinates):real
2Назначение: возвращает MixeMult:= значение смешанного произведениявекторов а и b
3Входные параметры: a,b;
4Выходные параметры: -.
5Возврат: MixeMult
10.Спецификация процедурыcoplanarity;
1) Function coplanarity(a,b,c:Coordinates):boolean
2Назначение: возвращает coplanarity :=истина, если векторы а,b и c компланарны, иначе- coplanarity :=ложь .
3Входные параметры: a,b,c;
4Выходные параметры: -.
Спецификация подпрограммдля определения вершин пирамиды
1.Спецификация процедуры ploskost
1) Procedureploskost(a,b,c:coordinates;var ax,bx,cx,dx:real);;
2) Назначение: Строитпо 3-м точкам уравнение плоскости вида Ax+By+Cz+D=0 и заносит в ax,bx,cx,dx соответствующиекоэффициенты
3) Входныепараметры:a,b,c,ax,bx,cx,dx;
4) Выходныепараметры: ax,bx,cx,dx.
2.Спецификация функции proverka_na_ploskost;
1) function proverka_na_ploskost(varP:P_descriptor;var mno:mnoj; n:byte):boolean;;
2) Назначение: проверяетусловие принадлежности n точек(указатели которыххранятся в множестве mno) кплоскости, построенной с помощью процедуры ploskost, возращает значение истины в случаеудачной проверки, иначе-ложь;
3) Входныепараметры: P,mno,n;
4) Выходныепараметры: P,mno.
5) Возврат: f
3.Спецификация функции Vypuklost;
1) Function Vypuklost(varP:P_descriptor;mno:mnoj;n:byte):boolean;;
2) Назначение: Проверяет многоугольникна выпуклость, путем перебора n точек измножества mno, формированием их в векторы и последующимвекторным перемножением. Возвращает значение истины, если при все N точках знак векторного умножения сохраняется,иначе -ложь;
3) Входныепараметры: P,mno,n;
4) Выходныепараметры: P.
5) Возврат: Q
4.Спецификация функции FinDaPyramid;
1) ProcedureFinDaPyramid(var P:P_descriptor;mno:mnoj);
2) Назначение: определяет вершиныпирамиды с выпуклым основанием и выводит на дисплей, если же нет решений -выводитсоотсветсвующее сообщение ;
3) Входныепараметры: P,mno,n;
4) Выходныепараметры: P,mno.
Блок-схема
/>
/> /> /> /> /> /> /> /> />
ТестовыеДанные
-Введем 5точек
Точка1(2,-1,-1)
Точка 2(1, 2,3)
Точка 3(4, 1 1)
Точка 4(0, 1,2)
Точка 5(7, 1,1)
-Построим по3-м точкам уравнение плоскости
Уравнение каждой плоскости имеет вид: Ax + By+ Cz + D = 0. Так что наша задача по заданным координатам 3-ех точекплоскости найти коэффициенты A,B, C и D. Эти коэффициенты находятся по формулам:
/>
где x, y, z — координаты наших точек, а 1-2-3 это номера точек A-B-C.
Соответственно находим эти коэффициенты и подставляем их в формулу
--В итоге,получаем уравнение вида Ax + By+ Cz + D = 0.
A = -2
B = 10
C = -8
— D = -6
Подставимкоэффициенты. Уравнение плоскости:
-2 x + 10 y — 8 z + 6 = 0
Далее,проверим 4 и 5 точку на принадлежность к этой плоскости:
Берем точку 4(0, 1, 2) и подставляем вуравнение -2 x + 10 y — 8z + 6 = 0
-2(0)+10(1)-8(2)+6=0
0=0
Точка 4 принадлежитплоскости.
Берем точку 5(7, 1, 1) и подставляем вуравнение -2 x + 10 y — 8z + 6 = 0
-2(7)+10(1)-8(1)+6=0
-60
Точка 5 нележит в плоскости.
-Далеепроверим многоугольник на выпуклость.
Одним изкритериев выпуклости является следующее. Многоугольник будет выпуклым, если длявекторов, составляющих его периметр, выполняется условие: векторныепроизведение соседних векторов должны иметь одинаковый знак.
/>
Послепоследовательного выполнения векторного произведения, видим, что многоугольниквыпуклый следовательно, данные 5 точек являются вершинами пирамиды с выпуклымоснованием, вершины пирамиды:
(2,-1,-1)
(1, 2, 3)
(4, 1, 1)
(0, 1, 2)
(7, 1, 1)
(интерфейспрограммы)
/>
(ввод точек)
/>
(вычисление вершинпирамиды с выпуклым основанием и вывод их на дисплей)
/>
Заключение
пирамида вершинаподпрограмма вектор
В курсовом проекте былопредусмотрено следующее:
• создание библиотеки дляработы с векторами в пространстве ;
• определение вершин пирамидыв с выпуклым основанием;
Список используемой литературы
1) Брусенцева В.С. Конспектлекций по программированию
2) Фаронов В. С. Turbo Pascal. Начальный курс. Учебное пособие. — М.: Нолидж»,1998 – 616 с.
3) Привалов И.И.Аналитическая геометрия. Учебник издательство «Лань» -304с .
4) Соболь Б.В.Практикум по высшей математике. издательство Ростов. 2006-640с
Приложение
Текст программ
Модуль MyUnit;
UnitMyUnitVector;
interface
Const{константы ошибок}
ListOk=0;
ListNotMem=1;
ListUnder=2;
ListEnd=3;
Type
mnoj=setof byte;
{Определениетипов}
Coordinates=record{коориднаты}
x,y,z:real;
end;
P_Points=^point; {Описаниетипа Points}
point=record
data:Coordinates;
Next:P_Points;
end;
P_Descriptor=record {Дескриптор для работы со списком точек}
Start,Ptr:P_Points;
Number:Word;
end;
P_Vectors=^Vector;{Описание типа Vector}
Vector=record
data:Coordinates;
Next:P_Vectors;
end;
V_Descriptor=record {Дескриптор для работы со списком векторов}
V_Start,V_Ptr:P_Vectors;
V_Number:Word;
end;
Var
ListError:0..3;mno:mnoj;
{подпрограммыдля формирования списка хранения и обработки списка векторов}
ProcedureInitListOfVectors(var V:V_Descriptor);
ProcedurePutVector(var V:V_Descriptor;c:Coordinates);
procedureCreateVector (a,b:Coordinates;var c:Coordinates);
ProcedureWriteVectors(var V:V_Descriptor);
ProcedureBeginOfVectors(var V:V_Descriptor);
{Подрограммыдля работы с векторами}
ProcedureAdditionVectors(a,b:Coordinates;var c:Coordinates);
ProcedureMultOnNumber (Number:real; a:Coordinates;var c:Coordinates);
FunctionlengthOfVector(a:Coordinates):real;
FunctionScalar(a,b:Coordinates):real;
Functionangle(a,b:coordinates):real;
Functionprojection(a,b:coordinates):real;
ProcedureVECTMult(a,b:Coordinates;var c:Coordinates);
Functioncollinearity(a,b:Coordinates):boolean;
FunctionMixeMult(a,b,c:Coordinates):real;
Functioncoplanarity(a,b,c:Coordinates):boolean;
{Подпрограммыдля нахождения пирамиды в пространстве}
ProcedureFinDaPyramid(var P:P_descriptor;mno:mnoj);
Procedureploskost(var P:P_descriptor;a,b,c:coordinates;var ax,bx,cx,dx:real);
functionproverka_na_ploskost(var P:P_descriptor;var mno:mnoj; n:byte):boolean;
FunctionVypuklost(var P:P_descriptor;mno:mnoj;n:byte):boolean;
functionSign(T:real):byte;
{подпрограммдля формирования списка хранения и обработки точек}
ProcedureInitListOfPoint(var P:P_Descriptor);
ProcedurePutPoint(var P:P_Descriptor);
ProcedureWritePoints(var P:P_Descriptor);
ProcedureBeginOfPoints(var P:P_Descriptor);
ProcedureReadPoint(var P:P_Descriptor;var a:Coordinates);
ProcedureMovePtrOfPoints(var P:P_Descriptor);
ProcedureMoveToPoints(var P:P_Descriptor; n:word);
ProcedureClearMem(var P:P_Descriptor;var V:V_Descriptor);
Implementation
ProcedureInitListOfVectors;
Begin
IfMaxAvail
ListError:=ListNotMem
else
begin
ListError:=ListOk;
V.V_Number:=0;
New(V.V_start);
V.V_Ptr:=V.V_Start;
end;
End;
ProcedurePutVector;
varbuf:P_Vectors;
Begin
IfMaxAvail
ListError:=ListNotMem
else
begin
ListError:=ListOk;
V.V_Ptr:=V.V_start;
New(Buf);
buf^.data:=c;
buf^.next:=V.V_Ptr^.next;
V.V_Ptr^.next:=buf;
V.V_Number:=V.V_number+1;
end;
end;
procedurecreateVector;
begin
withc do
begin
x:=a.x-b.x;
y:=a.y-b.y;
z:=a.z-b.z;
end;
end;
ProcedureWriteVectors;
varindex:word;
begin
IfV.V_Number=0 then
ListError:=ListUnder
else
index:=1;
beginOfVectors(V);
while(V.V_Ptr^.nextV.V_Start)and(index
begin
writeln('Vector',index,'= (',V.V_Ptr^.data.x:5:2,', ',V.V_Ptr^.data.y:5:2,', ',V.V_Ptr^.data.z:5:2,')');
V.V_Ptr:=V.V_Ptr^.next;
inc(index);
end;
end;
ProcedureBeginOfVectors;
begin
V.V_Ptr:=V.V_start^.next;
end;
{Процедуры насвойства векторов}
ProcedureAdditionVectors;
begin
withc do
begin
x:=a.x+b.x;
y:=a.y+b.y;
z:=a.z+b.z;
end;
end;
ProcedureMultOnNumber;
begin
withc do
begin
x:=number*a.x;
y:=number*a.y;
z:=number*a.z;
end;
end;
FunctionlengthOfVector;
begin
lengthOfVector:=sqrt(sqr(a.x)+sqr(a.y)+sqr(a.z));
end;
FunctionScalar;
begin
Scalar:=a.x*b.x+a.y*b.y+a.z*b.z;
end;
Functionangle;
begin
Angle:=arccos(scalar(a,b))/(lengthOf Vector(a)*lengthOfVector(b));
end;
Functionprojection;
begin
projection:=(lengthOfVector(a)*lengthOfVector(b)*angle(a,b));
end;
ProcedureVECTMult;
begin
withc do
begin
x:=a.y*b.z-b.y*a.z;
y:=a.z*b.x-b.z*a.z;
z:=a.x*b.y-b.x*a.y;
end;
end;
Functioncollinearity;
begin
if((a.x/b.x)=(a.y/b.y))and((a.y/b.y)=(a.z/b.z)) then
collinearity:=true
else
collinearity:=false;
end;
FunctionMixeMult;
begin
MixeMult:=a.x*b.y*c.z+a.y*b.z*a.x+a.z*b.x*c.z-a.z*b.y*c.x-a.y*b.x*c.z-a.x*b.z*c.y;
end;
Functioncoplanarity;
begin
ifMixeMult(a,b,c)=0 then
coplanarity:=true
else
coplanarity:=false;end;
{Подпрограммыдля нахождения пирамиды}
Procedure ploskost;
var
j:word;
Begin
Ax:=(1*b.y*c.z)+(1*c.y*a.z)+(a.y*b.z*1)-(a.z*b.y*1)-(1*a.y*c.z)-(c.y*b.z*1);
Bx:=(a.x*1*c.z)+(1*b.z*c.x)+(b.x*1*a.z)-(a.z*1*c.x)-(b.x*1*c.z)-(1*b.z*a.x);
Cx:=(a.x*b.y*1)+(b.x*c.y*1)+(a.y*1*c.x)-(1*b.y*c.x)-(c.y*1*a.x)-(b.x*a.y*1);
Dx:=-((a.x*b.y*c.z)+(b.x*c.y*a.z)+(a.y*b.z*c.x)-(c.y*b.z*a.x)-(a.z*b.y*c.x)-(b.x*a.y*c.z));
if(ax=0)and(bx=0)and(cx=0) then
writeln('lejatna odnoi pr9mou');
end;
ProcedureFindaPyramid;
var
i,k:word;
f,fl:boolean;
a:coordinates;
begin
mno:=[];
fori:=1 to p.number do
mno:=mno+[i];
f:=proverka_na_ploskost(p,mno,p.number);
iff then writeln('resheni9 net..vse to4ki lejat v ploskosti')
else
begin
i:=1;
fl:=false;
while(not fl)and(i
begin
mno:=mno-[i];
writeln;
ifproverka_na_ploskost(p,mno,p.number-1) then
fl:=Vypuklost(p,mno,p.number-1)
else
fl:=false;
mno:=mno+[i];
i:=i+1;
end;
iffl then
begin
writeln('pyramida''stop are= ');
fori:=1 to p.number do
begin
movetopoints(p,i);
readpoint(p,a);
Writeln('(',a.x:6:2,' ',a.y:6:2,' ',a.z:6:2,') ');
end;
end
elsewriteln('pyramida is not found ');
end;
end;
functionproverka_na_ploskost;
var
ax,bx,cx,dx:real;
i:word;
a,t1,t2,t3:coordinates;
f:boolean;
begin
i:=1;
whilenot( i in mno) do i:=i+1;
movetopoints(p,i);
readpoint(p,t1);
i:=i+1;
whilenot( i in mno) do i:=i+1;
movetopoints(p,i);
readpoint(p,t2);
i:=i+1;
whilenot( i in mno) do i:=i+1;
movetopoints(p,i);
readpoint(p,t3);
ploskost(p,t1,t2,t3,ax,bx,cx,dx);
f:=true;
while(i
begin
i:=i+1;
whilenot( i in mno) do i:=i+1;
movetopoints(p,i);
readpoint(p,a);
ifax*a.x+bx*a.y+cx*a.z+dx=0 then
begin
f:=true;
end
else
begin
f:=false;
end;
end;
proverka_na_ploskost:=f;
end;
FunctionVypuklost;
var
i,j,k:byte;
Q:boolean;
T,Z,Px:real;
a,b,v1,v2:coordinates;
begin
i:=1;
whilenot( i in mno) do i:=i+1;
movetopoints(p,i);
readpoint(p,a);
k:=0;
while(kn) do
begin
if(i in mno) then inc(k);
inc(i);
end;
movetopoints(p,i);
readpoint(p,b);
inc(i);
createVector(a,b,V1);
createVector(a,b,V2);
T:=(v1.y*v2.z-v2.y*v1.z)-(v1.x*v2.z-v2.y*v1.z)+(v1.x*v2.y-v2.x*v1.y);
Z:=Sign(T);
Px:=1.0;
j:=1;
Q:=true;
While(Q and (j
begin
whilenot( j in mno) do j:=j+1;
movetopoints(p,j);
readpoint(p,a);
inc(j);
whilenot( j in mno) do j:=j+1;
movetopoints(p,j);
readpoint(p,b);
createVector(a,b,V1);
createVector(a,b,V2);
T:=(v1.y*v2.z-v2.y*v1.z)-(v1.x*v2.z-v2.y*v1.z)+(v1.x*v2.y-v2.x*v1.y);
Px:=Px*Z*Sign(T);
if(Px
inc(i);
end;
Vypuklost:=Q;
end;
functionSign;
begin
ift=0 then
Sign:=1
else
sign:=round(t/abs(t));
end;
{Подпрограммыдля обрабоки списка точек}
ProcedureInitListOfPoint;
Begin
IfMaxAvail
ListError:=ListNotMem
else
begin
ListError:=ListOk;
P.Number:=0;
New(P.start);
P.Ptr:=P.Start;
end;
End;
ProcedurePutPoint;
varbuf:P_Points;
Begin
IfMaxAvail
ListError:=ListNotMem
else
begin
ListError:=ListOk;
P.ptr:=P.start;
New(Buf);
write('Inputpoint = ');
readln(buf^.data.x,buf^.data.y,buf^.data.z);
buf^.next:=P.Ptr^.next;
P.Ptr^.next:=buf;
P.Number:=P.number+1;
end;
end;
ProcedureWritePoints;
varindex:word;
begin
IfP.Number=0 then
ListError:=ListUnder
else
index:=1;
beginOfPoints(P);
while(P.Ptr^.nextP.Start)and(index
begin
writeln('point',index,'= (',P.Ptr^.data.x:5:2,', ',P.Ptr^.data.y:5:2,', ',P.Ptr^.data.z:5:2,')');
P.Ptr:=P.Ptr^.next;
inc(index);
end;
end;
ProcedureBeginOfPoints;
begin
P.Ptr:=P.start^.next;
end;
ProcedureReadPoint;
begin
ifP.Number=0 then
ListError:=ListUnder
else
begin
ListError:=ListOk;
a:=P.Ptr^.data;
end;
end;
procedureMovePtrOfPoints;
begin
P.Ptr:=P.Ptr^.next;
end;
ProcedureMoveToPoints;
vari:word;
begin
IFn>P.Number then
ListError:=ListUnder
else
begin
ListError:=ListOk;
P.Ptr:=P.start;
i:=0;
Whilei
begin
P.Ptr:=P.Ptr^.next;
i:=i+1;
end;
end;
end;
ProcedureClearMem;
var
P_i,P_j:P_Points;
V_i,V_j:P_Vectors;
Begin
P_i:=P.start^.next;
V_i:=V.V_start^.next;
dispose(P.start);
dispose(V.V_start);
While(P.Number0) do
begin
P.Number:=P.number-1;
P_j:=P_i;
P_i:=P_i^.next;
dispose(P_j);
end;
dispose(V_j);
end;
end;
end.
Текстосновной программы
programFindPyramid;
usesMyUnitVector,crt;
varD_Vector:V_Descriptor;
D_point:P_Descriptor;
a,b,c:Coordinates;
ch:char;
sum,sum2:real;
n1,n2:word;
begin
clrscr;
initlistOfPoint(D_point);
InitListOfVectors(D_vector);
repeat
writeln('Thisprogramm will perform a task,which find a pyramid ');
writeln;
writeln('please,enter «1» if you want to add point');
writeln('please,enter «2» if you want to display all points');
writeln('please,enter «3» if you want to find pyramid');
writeln('please,enter «0» if you want to exit');
ch:=readkey;
Casech of
#49: PutPoint(D_point);
#50: begin
WritePoints(D_point);
readkey;
end;
#51: begin
FinDaPyramid(D_point,mno);
readkey;
end;
end;
c lrscr;
untilch=#48;
clearmem(D_point,D_vector);
writeln('Error=',ListError);
readkey;
end./> /> /> /> /> /> /> /> />