Мансуров. Основы программирования в среде Lazarus. 2010

Глава 3 Более сложные элементы языка

____________________________________________________________________

readln (fam);

if fam = '***' then break;

name[k]:= fam;

writeln(UTF8ToConsole('Введите номер телефона'));

readln(tel[k]);

{Удаляем ведущие и ведомые ("хвостовые") пробелы}

tel[k]:= Trim(tel[k]);

writeln(UTF8ToConsole('Введите фамилию'));

end;

writeln(UTF8ToConsole('Ввод данных закончен'));

end;

begin

n:= 50;

{сначала устанавливаем максимальный размер массивов}

SetLength(name, 50);

SetLength(tel, 50);

data_input(name, tel, n); {ввод фамилий и номеров телефонов} {теперь устанавливаем фактический размер массивов}

SetLength(name, n);

SetLength(tel, n);

if n = 0 then exit;

writeln(UTF8ToConsole('Для поиска абонента введите')); writeln(UTF8ToConsole('номер его телефона')); writeln(UTF8ToConsole('Для выхода из программы')); writeln(UTF8ToConsole('введите ''***'''));

phone:= '';

while phone <> '***' do

begin

writeln(UTF8ToConsole('Введите номер телефона'));

201

3.4 Массивы

____________________________________________________________________

readln(phone);

if (not find_data(name, tel, phone)) and (phone <>

'***') then

writeln(UTF8ToConsole('Абонента с таким номером нет'));

end;

end.

Как вы думаете, есть ли в программе еще недостатки? Вообще говоря,

можно, конечно, придраться и к столбу, но, справедливости ради, отмечу, что в программе есть еще существенные недостатки.

Во-первых, что будет, если при вводе будут введены одинаковые фамилии и/или телефоны? Будут выведены та фамилия и/или тот телефон, которые были введены первыми. Но в массиве дублирующие данные останутся. Значит,

предварительно необходимо просмотреть уже сформированный массив и толь-

ко, если фамилия и/или телефон не совпадают, лишь тогда добавлять очередно-

го абонента в массив. Второй значительный недостаток – при вводе телефона не осуществляется никакого контроля. В номере телефона могут быть только цифры, ну, может быть еще знак тире.

Однако разбор этой программы занимает уже чуть ли не половину книги.

Поэтому попробуйте сами покопаться. Идеи я вам подкинул. Уверен, что вы справитесь с этой задачей!

3.4.2 Программа решения системы линейных алгебраических

уравнений методом Гаусса

Напишем программу, реализующую алгоритм Гаусса с выбором главного элемента для решения системы линейных алгебраических уравнений. Сам ал-

горитм был нами рассмотрен в 1.3.4.

Как уже повелось у нас с вами, прежде чем смотреть программу, напишите его сами по блок схеме, приведенной в разделе 1.3.4. Используя массивы, реа-

202

Глава 3 Более сложные элементы языка

____________________________________________________________________

лизовать этот алгоритм для вас не составит труда. И лишь после этого сопос-

тавьте свою программу с приведенной в книге. Думайте, анализируйте, сравни-

вайте коды, ищите лучшие решения, нещадно критикуйте меня! Вполне воз-

можно, что вы напишете программу лучше. Лучше не в смысле получаемых ре-

зультатов (они должны совпадать!), а с точки зрения реализации. Может быть,

вы напишете более эффективную программу или реализуете отдельные фраг-

менты алгоритма более просто, ну и т.д. И имейте в виду, что и сами алгорит-

мы, решающие одну и ту же задачу, можно составлять по-разному! Так что по-

пробуйте и алгоритм придумать свой.

Для сравнения я приведу три варианта программы, написанных тремя моими студентами. Первый, назовем его "плохим программистом", реализовал алгоритм, как говорится в "лоб". Как записано в блок-схеме, так и реализовано в программе. На защите своей программы он признался мне, что так и не смог написать эту программу без оператора goto. Кроме того, его программа не умела определять существует решение или нет, а также не был организован ввод коэффициентов расширенной матрицы. Его программа умела решать только систему из трех уравнений с тремя неизвестными.

Второй студент, назовем его "средним программистом", сумел написать программу без goto, но также действовал в "лоб". Правда его программа уже

"умела" вводить коэффициенты расширенной матрицы.

И, наконец, третий студент, назовем его "хорошим программистом", сумел написать очень изящную по реализации программу. Его программа оказалась намного короче по количеству операторов в тексте программы. В программе он использовал динамические массивы, что позволило реализовать алгоритм ме-

тода Гаусса для любого числа уравнений. Кроме того, часть кода, где непосред-

ственно реализуется алгоритм метода Гаусса, организовал в виде процедуры.

В качестве модельного примера выбрана система:

203

3.4 Массивы

____________________________________________________________________

3.4.1.1. Вариант 1 – с goto

program Gauss_console_app; {$mode objfpc}{$H+}

uses

CRT, FileUtil; label

L1, L2, L3, L4, L5, L6, L7; var

a:array[1..3, 1..3] of real;

b:array[1..3] of real;

x: array[1..3] of real; i, j, k, p, n: integer; m, S, t: real;

begin

{Определение коэффициентов расширенной матрицы} n:= 3;

a[1,1]:= 2; a[1,2]:= 6; a[1,3]:=-1; b[1]:=-12; a[2,1]:= 5; a[2,2]:=-1; a[2,3]:= 2; b[2]:=29; a[3,1]:=-3; a[3,2]:=-4; a[3,3]:= 1; b[3]:=5;

{Основная часть программы} k:= 1;

L1: i:= k + 1;

if (a[k, k] = 0) then begin

{перестановка уравнений}

p:= k; // в алгоритме используется буква l, но она похожа на 1

// Поэтому используем идентификатор p

L6: if abs(a[i, k]) > abs(a[p, k]) then p:= i; if not( i = n) then

begin

i:= i + 1; goto L6;

end;

if p = k then i:= k + 1

204

Глава 3 Более сложные элементы языка

____________________________________________________________________

else begin

j:= k;

L7: t:= a[k, j]; a[k, j]:= a[p, j]; a[p, j]:= t;

if not(j = n) then begin

j:= j + 1; goto L7;

end;

t:= b[k]; b[k]:= b[p]; b[p]:= t;

end;

end; // конец блока перестановки уравнений

L2: m:= a[i, k] / a[k, k]; a[i, k]:= 0;

j:= k + 1;

L3: a[i, j]:= a[i, j] - m * a[k, j]; if not(j = n) then

begin

j:= j + 1; goto L3;

end;

b[i]:= b[i] - m * b[k]; if not(i = n) then begin

i:= i + 1; goto L2;

end;

if not( k= n - 1) then begin

k:= k + 1; goto L1;

end;

x[n]:= b[n] / a[n, n]; i:= n - 1;

L4: j:= i + 1; S:= 0;

L5: S:= S - a[i, j] * x[j]; if not(j = n) then

begin

j:= j + 1;

205

3.4 Массивы

____________________________________________________________________

goto L5; end;

x[i]:= (b[i] + S) / a[i, i]; if not(i = 1) then

begin

i:= i - 1; goto L4;

end;

for i:= 1 to n do

writeln('x', i, '= ', x[i]:0:4); writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;

end.

3.4.1.2. Вариант 2 – без goto

program Gauss_console_app; {$mode objfpc}{$H+}

uses

CRT, FileUtil; var

a:array[1..3, 1..3] of real;

b:array[1..3] of real;

x: array[1..3] of real; i, j, k, p, n: integer; m, S, t: real;

begin

{Ввод коэффициентов расширенной матрицы} n:= 3;

for i:=1 to n do begin

for j:=1 to n do begin

writeln(UTF8ToConsole('Введите a'), i, j); readln (a[i, j]);

end;

writeln(UTF8ToConsole('Введите b'), i); readln(b[i]);

end;

{Основная часть программы} k:= 1;

206

Глава 3 Более сложные элементы языка

____________________________________________________________________

while true do begin

i:= k + 1;

if (a[k, k] = 0) then begin

{перестановка уравнений}

p:= k; // в алгоритме используется буква l, но она похожа на 1 // Поэтому используем идентификатор p

while true do begin

if abs(a[i, k]) > abs(a[p, k]) then p:= i; if i = n then break;

i:= i + 1; continue;

end;

if p= k then i:= k + 1 else

begin j:= k;

while true do begin

t:= a[k, j];

a[k, j]:= a[p, j]; a[p, j]:= t;

if j = n then break; j:= j + 1; continue;

end;

t:= b[k]; b[k]:= b[p]; b[p]:= t;

end;

end; // конец блока перестановки уравнений while true do

begin

m:=a[i, k] / a[k, k]; a[i, k]:= 0;

j:= k + 1; while true do begin

a[i, j]:= a[i, j] - m * a[k, j]; if j = n then break;

j:= j + 1;

207

3.4 Массивы

____________________________________________________________________

continue;

end;

b[i]:= b[i] - m * b[k]; if i = n then break; i:= i + 1;

continue;

end;

if k= n - 1 then break; k:= k + 1;

continue;

end;

{Проверка существования решения} if a[n, n] <> 0 then begin

x[n]:= b[n] / a[n, n]; i:= n - 1;

while true do begin

j:= i + 1; S:= 0;

while true do begin

S:= S - a[i, j] * x[j]; if j = n then break; j:= j + 1;

continue;

end;

x[i]:= (b[i] + S) / a[i, i]; if i = 1 then break;

i:= i - 1; continue;

end;

for i:= 1 to n do

writeln('x', i, '= ', x[i]:0:4); end

else

if b[n] = 0 then writeln(UTF8ToConsole('Система уравнений' +

' не имеет решения.'))

else

writeln(UTF8ToConsole('Система уравнений'+ ' имеет бесконечное множество решений.'));

writeln(UTF8ToConsole('Нажмите любую клавишу'));

208

Глава 3 Более сложные элементы языка

____________________________________________________________________

readkey;

end.

3.4.1.3. Вариант 3 – наилучшая реализация

program Gauss_console_app; {$mode objfpc}{$H+}

uses

CRT, FileUtil; var

a:array of array of real; {матрица коэффициентов системы, двумерный динамический массив}

vector: array of real; {преобразованный одномерный динамический массив}

b:array of real;

x: array of real; i, j, k, n: integer;

procedure gauss(var vector: array of real; var b: array of real;

var x: array of real; var n: integer);

var

a: array of array of real; {матрица коэффициентов системы, двумерный динамический массив}

i, j, k, p, r: integer; m, s, t: real;

begin

SetLength(a, n, n); // установка фактического размера массива {Преобразование одномерного массива в двумерный}

k:=1;

for i:=0 to n-1 do for j:=0 to n-1 do begin

a[i,j]:= vector[k]; k:=k+1;

end;

for k:=0 to n-2 do begin

for i:=k+1 to n-1 do begin

if (a[k,k]=0) then begin

{перестановка уравнений}

209

3.4 Массивы

____________________________________________________________________

p:=k; // в алгоритме используется буква l, но она похожа на 1 // Поэтому используем идентификатор p

for r:=i to n-1 do begin

if abs(a[r,k]) > abs(a[p,k]) then p:=r; end;

if p<>k then begin

for j:= k to n-1 do begin

t:=a[k,j];

a[k,j]:=a[p,j];

a[p,j]:=t;

end;

t:=b[k];

b[k]:=b[p];

b[p]:=t;

end;

end; // конец блока перестановки уравнений m:=a[i,k]/a[k,k];

a[i,k]:=0;

for j:=k+1 to n-1 do begin

a[i,j]:=a[i,j]-m*a[k,j]; end;

b[i]:= b[i]-m*b[k]; end;

end;

{Проверка существования решения} if a[n-1,n-1] <> 0 then begin

x[n-1]:=b[n-1]/a[n-1,n-1]; for i:=n-2 downto 0 do begin

s:=0;

for j:=i+1 to n-1 do begin

s:=s-a[i,j]*x[j]; end;

x[i]:=(b[i] + s)/a[i,i]; end;

writeln(''); writeln(UTF8ToConsole('Решение:'));

210