Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 3)

(0, 1, 2)

(7, 1, 1)

(интерфейс программы)

(ввод точек)

(вычисление вершин пирамиды с выпуклым основанием и вывод их на дисплей)

Заключение

пирамида вершина подпрограмма вектор

В курсовом проекте было предусмотрено следующее:

• создание библиотеки для работы с векторами в пространстве ;

• определение вершин пирамиды в с выпуклым основанием;

Список используемой литературы

1. Брусенцева В.С. Конспект лекций по программированию

2. Фаронов В. С. Turbo Pascal. Начальный курс. Учебное пособие. - М.: Нолидж»,1998 – 616 с.

3. Привалов И.И .Аналитическая геометрия. Учебник издательство «Лань» -304с .

4. Соболь Б.В. Практикум по высшей математике. издательство Ростов. 2006-640с

Приложение

Текст программ

Модуль MyUnit;

Unit MyUnitVector;

interface

Const {константы ошибок}

ListOk=0;

ListNotMem=1;

ListUnder=2;

ListEnd=3;

Type

mnoj=set of 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;

{подпрограммы для формирования списка хранения и обработки списка векторов}

Procedure InitListOfVectors(var V:V_Descriptor);

Procedure PutVector(var V:V_Descriptor;c:Coordinates);

procedure CreateVector (a,b:Coordinates;var c:Coordinates);

Procedure WriteVectors(var V:V_Descriptor);

Procedure BeginOfVectors(var V:V_Descriptor);

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

Procedure AdditionVectors(a,b:Coordinates;var c:Coordinates);

Procedure MultOnNumber (Number:real; a:Coordinates;var c:Coordinates);

Function lengthOfVector(a:Coordinates):real;

Function Scalar(a,b:Coordinates):real;

Function angle(a,b:coordinates):real;

Function projection(a,b:coordinates):real;

Procedure VECTMult(a,b:Coordinates;var c:Coordinates);

Function collinearity(a,b:Coordinates):boolean;

Function MixeMult(a,b,c:Coordinates):real;

Function coplanarity(a,b,c:Coordinates):boolean;

{Подпрограммы для нахождения пирамиды в пространстве}

Procedure FinDaPyramid(var P:P_descriptor;mno:mnoj);

Procedure ploskost(var P:P_descriptor;a,b,c:coordinates;var ax,bx,cx,dx:real);

function proverka_na_ploskost(var P:P_descriptor;var mno:mnoj; n:byte):boolean;

Function Vypuklost(var P:P_descriptor;mno:mnoj;n:byte):boolean;

function Sign(T:real):byte;

{подпрограмм для формирования списка хранения и обработки точек}

Procedure InitListOfPoint(var P:P_Descriptor);

Procedure PutPoint(var P:P_Descriptor);

Procedure WritePoints(var P:P_Descriptor);

Procedure BeginOfPoints(var P:P_Descriptor);

Procedure ReadPoint(var P:P_Descriptor;var a:Coordinates);

Procedure MovePtrOfPoints(var P:P_Descriptor);

Procedure MoveToPoints(var P:P_Descriptor; n:word);

Procedure ClearMem(var P:P_Descriptor;var V:V_Descriptor);

Implementation

Procedure InitListOfVectors;

Begin

If MaxAvail

ListError:=ListNotMem

else

begin

ListError:=ListOk;

V.V_Number:=0;

New(V.V_start);

V.V_Ptr:=V.V_Start;

end;

End;

Procedure PutVector;

var buf:P_Vectors;

Begin

If MaxAvail

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;

procedure createVector;

begin

with c do

begin

x:=a.x-b.x;

y:=a.y-b.y;

z:=a.z-b.z;

end;

end;

Procedure WriteVectors;

var index:word;

begin

If V.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;

Procedure BeginOfVectors;

begin

V.V_Ptr:=V.V_start^.next;

end;

{Процедуры на свойства векторов}

Procedure AdditionVectors;

begin

with c do

begin

x:=a.x+b.x;

y:=a.y+b.y;

z:=a.z+b.z;

end;

end;

Procedure MultOnNumber;

begin

with c do

begin

x:=number*a.x;

y:=number*a.y;

z:=number*a.z;

end;

end;

Function lengthOfVector;

begin

lengthOfVector:=sqrt(sqr(a.x)+sqr(a.y)+sqr(a.z));

end;

Function Scalar;

begin

Scalar:=a.x*b.x+a.y*b.y+a.z*b.z;

end;

Function angle;

begin

Angle:= arccos(scalar(a,b))/(lengthOf Vector(a)*lengthOfVector(b));

end;

Function projection;

begin

projection:=(lengthOfVector(a)*lengthOfVector(b)*angle(a,b));

end;

Procedure VECTMult;

begin

with c 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;

Function collinearity;

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;

Function MixeMult;

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;

Function coplanarity;

begin

if MixeMult(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('lejat na odnoi pr9mou');

end;

Procedure FindaPyramid;

var

i,k:word;

f,fl:boolean;

a:coordinates;

begin

mno:=[];

for i:=1 to p.number do

mno:=mno+[i];

f:=proverka_na_ploskost(p,mno,p.number);

if f 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;

if proverka_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;

if fl then

begin

writeln('pyramida''s top are= ');

for i:=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

else writeln('pyramida is not found ');

end;

end;

function proverka_na_ploskost;

var

ax,bx,cx,dx:real;

i:word;

a,t1,t2,t3:coordinates;

f:boolean;

begin

i:=1;

while not( i in mno) do i:=i+1;

movetopoints(p,i);

readpoint(p,t1);

i:=i+1;

while not( i in mno) do i:=i+1;

movetopoints(p,i);

readpoint(p,t2);

i:=i+1;

while not( 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;

while not( i in mno) do i:=i+1;

movetopoints(p,i);

readpoint(p,a);

if ax*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;

Function Vypuklost;

var

i,j,k:byte;

Q:boolean;

T,Z,Px:real;

a,b,v1,v2:coordinates;

begin

i:=1;

while not( 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

begin

while not( j in mno) do j:=j+1;

movetopoints(p,j);

readpoint(p,a);

inc(j);

while not( 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;

function Sign;

begin

if t=0 then

Sign:=1

else

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

end;

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

Procedure InitListOfPoint;

Begin

If MaxAvail

ListError:=ListNotMem

else

begin

ListError:=ListOk;

P.Number:=0;

New(P.start);

P.Ptr:=P.Start;

end;

End;

Procedure PutPoint;

var buf:P_Points;

Begin

If MaxAvail

ListError:=ListNotMem

else

begin

ListError:=ListOk;

P.ptr:=P.start;

New(Buf);

write('Input point = ');

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;

Procedure WritePoints;

var index:word;

begin

If P.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;

Procedure BeginOfPoints;

begin

P.Ptr:=P.start^.next;

end;

Procedure ReadPoint;

begin

if P.Number=0 then

ListError:=ListUnder

else

begin

ListError:=ListOk;

a:=P.Ptr^.data;

end;

end;

procedure MovePtrOfPoints;

begin

P.Ptr:=P.Ptr^.next;

end;

Procedure MoveToPoints;

var i:word;

begin

IF n>P.Number then

ListError:=ListUnder

else

begin

ListError:=ListOk;

P.Ptr:=P.start;

i:=0;

While i

begin

P.Ptr:=P.Ptr^.next;

i:=i+1;

end;

end;

end;

Procedure ClearMem;

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.

Текст основной программы

program FindPyramid;

uses MyUnitVector,crt;

var D_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('This programm 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;

Case ch of

#49 : PutPoint(D_point);

#50 : begin

WritePoints(D_point);

readkey;

end;

#51 : begin

FinDaPyramid(D_point,mno);

readkey;

end;

end;

c lrscr;

until ch=#48;

clearmem(D_point,D_vector);

writeln('Error=',ListError);

readkey;

end.

Размещено на Allbest.ru

Возвращаем исключенную точку I в множество mno

Увеличиваем i

Характеристики

Список файлов курсовой работы