Zistí či body A,B,C ležia na jednej priamke a nájde parametrické rovnice priamok A-B, A-C, B-C
Delphi & Pascal (česká wiki)
Kategória: Zadania Pascal
Program: 3dpriam.pas
Súbor exe: 3dpriam.exe
Súbor ubuntu: 3dpriam
Program: 3dpriam.pas
Súbor exe: 3dpriam.exe
Súbor ubuntu: 3dpriam
Zistí či body A,B,C ležia na jednej priamke a nájde parametrické rovnice priamok A-B, A-C, B-C.
{ 3DPRIAM.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Zistite ci body A,B,C lezia na jednej priamke } { Vstup : cisla A,B,C } { Vystup: Zisti ci body lezia na jednej priamke } { Ak nie potom najde parametricke rovnice priamok } { } { Datum:17.12.2000 http://www.trsek.com } program Priamka_3D; uses crt; var a,b,c:array[1..3] of real; k,q:array[1..3,1..3] of real; { Vypocita smernicu [k] pre riesenie y=k*x+q } function smer( a1,b1,a2,b2: real) : real; begin if( (b1-a1) <> 0 ) then begin smer := ( b2 - a2 ) / ( b1 - a1 ); end else begin writeln('Pocas vypoctu nastalo delenie nulou, riesenie nemusi byt korektne !'); smer := 0; end; end; { Vypocita konstantu [q] pre riesenie y=k*x+q } function konst( a1,b1,a2,b2: real) : real; begin if( (b1-a1) <> 0 ) then konst := b2 - ( b1 * ( b2 - a2) / ( b1 - a1 )) else konst := 0; end; { Vypise parametricke riesenie rovnice } procedure VypParRov( k2,q2,k3,q3 : real ); begin writeln('x = x'); if( q2 >= 0 ) then writeln('y = ', k2:0:3, '*x +', q2:0:3 ) else writeln('y = ', k2:0:3, '*x ', q2:0:3 ); if( q3 >= 0 ) then writeln('z = ', k3:0:3, '*x +', q3:0:3 ) else writeln('z = ', k3:0:3, '*x ', q3:0:3 ); writeln; end; begin repeat writeln('Zistite ci body A,B,C lezia na jednej priamke.'); writeln('Ak nie najdite parametricke rovnice priamok.'); writeln('Zadaj bod A=[a1,a2,a3]'); write('a1='); readln(a[1]); write('a2='); readln(a[2]); write('a3='); readln(a[3]); writeln('Zadaj bod B=[b1,b2,b3]:'); write('b1='); readln(b[1]); write('b2='); readln(b[2]); write('b3='); readln(b[3]); writeln('Zadaj bod C=[c1,c2,c3]:'); write('c1='); readln(c[1]); write('c2='); readln(c[2]); write('c3='); readln(c[3]); writeln; writeln('Riesenie:'); writeln('---------'); { priamka A-B } k[1,2] := smer ( a[1], b[1], a[2], b[2] ); q[1,2] := konst( a[1], b[1], a[2], b[2] ); k[1,3] := smer ( a[1], b[1], a[3], b[3] ); q[1,3] := konst( a[1], b[1], a[3], b[3] ); { priamka A-C } k[2,2] := smer ( a[1], c[1], a[2], c[2] ); q[2,2] := konst( a[1], c[1], a[2], c[2] ); k[2,3] := smer ( a[1], c[1], a[3], c[3] ); q[2,3] := konst( a[1], c[1], a[3], c[3] ); { priamka B-C } k[3,2] := smer ( b[1], c[1], b[2], c[2] ); q[3,2] := konst( b[1], c[1], b[2], c[2] ); k[3,3] := smer ( b[1], c[1], b[3], c[3] ); q[3,3] := konst( b[1], c[1], b[3], c[3] ); writeln('Parametricke riesenie priamky A-B je:'); VypParRov( k[1,2], q[1,2], k[1,3], q[1,3] ); if( ( k[1,2] = k[2,2] ) and ( k[1,2] = k[3,2] ) and ( k[1,3] = k[2,3] ) and ( k[1,3] = k[3,3] ) and ( q[1,2] = q[2,2] ) and ( q[1,2] = q[3,2] ) and ( q[1,3] = q[2,3] ) and ( q[1,3] = q[3,3] )) then begin writeln('Body A,B,C lezia na jednej priamke.'); end else begin writeln('Parametricke riesenie priamky A-C je:'); VypParRov( k[2,2], q[2,2], k[2,3], q[2,3] ); writeln('Parametricke riesenie priamky B-C je:'); VypParRov( k[3,2], q[3,2], k[3,3], q[3,3] ); end; writeln('Opakovat znova ? [ESC-koniec]'); until( readkey = #27 ); end.