Реферат: Создание программы для определения вершин пирамиды с выпуклым основанием по данным точкам

КУРСОВОЙ ПРОЕКТ

по дисциплине

«Программированиена языке высокого уровня»

на тему:

«Созданиепрограммы для определения вершин пирамиды с выпуклым основанием по даннымточкам»


Введение

Целью данного проекта –является закрепление материала, изложенного в курсе «Программирование на языкевысокого уровня» на основе какой-либо обобщающей задачи. В качестве таковойбыла выбрана задача определения пирамиды с выпуклым основанием по данным 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, если λ<0.

/>

Доказательство.

Построим векторы 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 одинаковонаправлены. Если λ < 0, то точка B лежит на дополнительном луче ивекторы 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.


Блок-схема

/>

/> /> /> /> /> /> /> /> <td/> />

ТестовыеДанные

-Введем 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

-6<>0

Точка 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<sizeOf(Vector) Then

          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<sizeOf(Vector) Then

          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^.next<>V.V_Start)and(index<=V.V_number) do

 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<=p.number) do

 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<=n)and f do

                   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(k<>n) 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<n))do

         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<0) then Q:=false;

         inc(i);

         end;

         Vypuklost:=Q;

end;

functionSign;

begin

ift=0 then

         Sign:=1

else

         sign:=round(t/abs(t));

end;

{Подпрограммыдля обрабоки списка точек}

ProcedureInitListOfPoint;

Begin

IfMaxAvail<sizeOf(point) Then

          ListError:=ListNotMem

else

          begin

          ListError:=ListOk;

          P.Number:=0;

          New(P.start);

          P.Ptr:=P.Start;

          end;

End;

ProcedurePutPoint;

varbuf:P_Points;

Begin

IfMaxAvail<sizeOf(point) Then

          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^.next<>P.Start)and(index<=P.number) do

 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<n do

                   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.Number<>0) 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.

/> /> /> /> /> <td/> /> /> /> />
еще рефераты
Еще работы по информатике, программированию