4. Программирование и отладка

4.1. Тексты программы и подпрограмм

(* Курсовая работа по дисциплине "Информатика" *)

(* Выполнил: студент гр. 9999 Иванов И.И. *)

(* Дата: 15.05.2003 *)

Program Main_Kursrab;

(* Программа поиска параллельных прямых и наибольшего *)

(* расстояния между ними *)

Uses Crt;

Const

KolPrMax = 20; (* Максимальное количество прямых *)

Type

FileName = String[20]; (* Тип для имен файлов *)

ArrCoef = Array [1..KolPrMax, 1..3] of real; (* Тип для массива

коэффициентов *)

ArrNom = Array [1..KolPrMax, 1..2] of integer; (*Тип для массива

номеров попарно

параллельных прямых *)

Vector = Array [1..KolPrMax] of real; (* Тип для массива расстояний *)

Var

(* Входные данные *)

N : integer; (*Количество исходных прямых *)

ABC : ArrCoef; (*Множество троек коэффициентов А, В, С;

каждая тройка занимает одну строку *)

E : real; (*Погрешность оценки параллельности прямых*)

(* Выходные данные *)

K : integer; (*Счетчик пар параллельных прямых *)

NomPr : ArrNom; (*Пары порядковых (в массиве АВС) номеров

параллельных прямых *)

R : Vector; (*Вектор расстояний между параллельными

прямыми *)

NomMax : integer; (*Порядковый номер в массиве R модуля

наибольшего расстояния между параллельными прямыми *)

RMax : real; (*Модуль наибольшего расстояния между прямыми *)

imax1,

imax2 : integer; (*Номера параллельных прямых, расстояние

между которыми наибольшее *)

InFileName : FileName; (*Имя входного файла *)

ResFileName : FileName; (*Имя выходного файла *)

F1 : text; (*Файловая переменная для входного файла *)

F2 : text; (*Файловая переменная для выходного файла*)

i, j : integer; (* Рабочие *)

i1,i2 : integer; (* переменные *)

Ch : char; (* Символ для ввода *)

Procedure POISK( N : integer; ABC : ArrCoef; E : real; var K : integer;

var NomPr : ArrNom; var R : Vector );

(* Подпрограмма поиска параллельных прямых и *)

(* вычисления расстояний между ними *)

(* Входные данные

(* N : integer; - Количество исходных прямых *)

(* ABC : ArrCoef; - Множество троек коэффициентов А, В, С *)

(* E : real; - Погрешность оценки *)

(* параллельности прямых *)

(* *)

(* Выходные данные *)

(* K : integer; - Счетчик пар параллельных прямых *)

(* NomPr : ArrNom; - Пары порядковых (в массиве АВС) номеров *)

(* параллельных прямых *)

(* R : Vector; - Вектор расстояний между параллельн. прямыми *)

(* *)

Var

Prisnak : real; (* Признак параллельности прямых *)

i1, i2 : integer; (* Рабочие переменные *)

begin

(* Установка начальных значений *)

K := 0;

(* Проверка попарной параллельности прямых *)

for i1 := 1 to N-1 do (*Номер первой прямой i1 *)

begin

for i2 := i1 + 1 to N do (* Номер второй прямой *)

begin

Prisnak := abs(ABC[i1,1] * ABC[i2,2] - ABC[i2,1] * ABC[i1,2]);

if (Prisnak < E) (* Проверка условия параллельности *)

then

(*Две прямые параллельны*)

begin

K := K + 1;

(*Вычисление расстояний между прямыми*)

R(K) := abs((ABC[i1,3] * ABC[i2,1] -

ABC[i2,3] * ABC[i1,1]) /

ABC[i2,1] / sqrt(ABC[i1,1] * ABC[i1,1] +

ABC[i1,2] * ABC[i1,2]));

(*Запись номеров параллельных прямых*)

NomPr[K,1] := i1;

NomPr[K,2] := i2

end {if}

end {for_i2}

end {for_i1}

end; {POISK}

Function Nmax(Vec:Vector; Kol: integer) : integer;

(* Подпрограмма определения номера наибольшего

элемента в одномерном массиве

Входные данные:

Vector - массив действительных чисел;

Kol - число элементов (размер) массива (от 1 до 190)

Выходные данные:

Nmax - номер в массиве Vec наибольшего элемента.

Пример вызова:

i := Nmax(R,K); *)

Var

rab : real; (* Рабочие *)

i : integer; (* переменные *)

begin

(* Установка начальных значений *)

rab := Vec[1];

Nmax := 1;

(* Начало цикла сравнения элементов *)

for i := 2 to Kol do

begin

if rab < Vec[i]

then

(* Замена наибольшего элемента *)

begin

rab := Vec[i];

Nmax := i

end (*if*)

end (*for*)

end;(*Nmax*)

(*------------- Основной модуль программы-------------------*)

Begin

ClrScr;

WriteLn(' Нажмите любую клавишу для старта... ');

Ch := ReadKey;

ClrScr;

(* Подготовка к чтению файла исходных данных *)

Writeln(' Введите имя файла исходных данных ');

ReadLn(InFileName);

Assign(F1, InFileName);

Reset(F1);

(* Формирование имени и подготовка файла результатов *)

ResFileName := '';

i := 1;

while (InFileName[i] <> '.') and

(i <= Length(InFileName)) do

begin

ResFileName := ResFileName + InFileName[i];

i := i + 1

end; (*while*)

Assign(F2, ResFileName + '.res');

Rewrite(F2);

(* Ввод и проверка исходных данных *)

ReadLn(F1, N);

if (N>1) and (N <= KolPrMax)

then

begin

ReadLn(F1, E);

if (E>0)

then

begin

(*Ввод коэффициентов прямых *)

for i := 1 to N do

for j := 1 to 3 do

read(F1, ABC[i,j]);

(*Обращение к подпрограмме POISK*)

POISK( N, ABC, E, K, NomPr, R );

if K <> 0

then

(*Среди прямых есть К пар параллельных *)

begin

(*Определение номера наибольшего расстояния*)

i := Nmax(R,K);

Rmax := R[i];

imax1 := NomPr[i,1];

imax2 := NomPr[i,2]

end {if};

(* ВЫВОД РЕЗУЛЬТАТОВ *)

writeLn(F2,'');

writeLn(F2,' И С Х О Д Н Ы Е Д А Н Н Ы Е ');

writeLn(F2,'');

writeLn(F2,' Количество прямых N = ', N:2);

writeLn(F2,' Погрешность E = ', E:10);

writeln(F2,' Номер Коэффициенты прямой');

writeln(F2,' прямой A B C ');

for i := 1 to N do

begin

write(F2,' ', i:2);

for j :=1 to 3 do

write(F2,' ', ABC[i,j]:8:3);

writeln(F2);

end;

if K <> 0

then

(* Есть пары параллельных прямых *)

begin

writeln(F2);

writeln(F2,' Р Е З У Л Ь Т А Т Ы');

writeln(F2,' Коэффициенты');

writeln(F2,' прямых Расстояния');

writeln(F2, ' A B C ');

for i := 1 to K do

begin

i1 := NomPr[i,1];

i2 := NomPr[i,2];

for j := 1 to 3 do

write(F2, ABC[i1,j] :8:3);

writeln(F2,' ', R[i]:8:3);

for j := 1 to 3 do

write(F2, ABC[i2,j]:8:3);

writeln(F2);

writeln(F2)

end;

writeln(F2);

writeln(F2,' Наибольшее расстояние: ', Max:7:3);

writeln(F2,' между прямыми ', imax1:2,' и ', imax2:2,

' с коэффициентами');

writeln(F2, ' A B C ');

for j := 1 to 3 do

write(F2, ABC[imax1,j]:8:3);

writeln(F2);

for j:=1 to 3 do

write(F2, ABC[imax2,j]:8:3);

writeln(F2)

end (*then*)

else

(* Нет параллельных прямых *)

writeln(F2,' Параллельных прямых нет')

end {if_K}

else

(*Недопустимое значение Е*)

begin

writeLn('Недопустимое значение Е в файле ' + InFileName);

writeLn(' Нажмите любую клавишу для завершения... ');

Ch := ReadKey;

ClrScr

end

end (*if(E>0)*)

else

(*Недопустимое значение N *)

begin

writeLn('Недопустимое значение N в файле ' + InFileName);

writeLn(' Нажмите любую клавишу для завершения... ');

Ch := ReadKey;

ClrScr

end;

(* Закрытие файлов ввода и вывода *)

Close(F2);

Close(F1)

end.