Работа с текстовыми строками, двумерными массивами, файловыми структурами данных (стр. 2 из 5)
end;
Процедура поворота матрицы на 90 градусов направо.
procedure TurnMatrix(var A: Matrix; N: Integer);
var
Arr: Vector;
I, J, K, Ot, L: Integer;
R: Integer;
Revers: Integer;
Buf1, Buf2: Integer;
begin
R:=N div 2;
Ставим начальное значение отступа Ot равным нулю.
Ot:=0;
for K:=1 to R do
begin
Переменная L отвечает за количество элементов в массиве Arr. Ставим начальное значение равное нулю, а затем заносим в массив Arr элементы матрицы.
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
Arr[L]:=A[1+Ot, J];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
Arr[L]:=A[I, N-Ot];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
Arr[L]:=A[N-Ot, J];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
Arr[L]:=A[I, 1+Ot];
end;
Находим на сколько элементов нужно сдвинуть массив Arr.
Revers:=N-2*Ot-1;
Далее, с помощью процедуры, циклически сдвигаем массив Arr из L элементов на Revers позиций вправо. И записываем получившийся массив обратно в матрицу.
TurnArray(Arr, L, Revers);
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
A[1+Ot, J]:=Arr[L];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
A[I, N-Ot]:=Arr[L];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
A[N-Ot, J]:=Arr[L];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
A[I, 1+Ot]:=Arr[L];
end;
Увеличиваем значение отступа.
Inc(Ot);
end;
Процедура циклического сдвига массива.
procedure TurnArray(var V: Vector; NN: Integer; Rev: Integer);
var
Buf: Integer;
I, J: Integer;
Begin
for J:=1 to Rev do
begin
Сохраняем значение элемента V[NN] в Buf, а затем сдвигаем элементы массива на 1 позицию.
Buf:=V[NN];
for I:=NN downto 2 do
V[I]:=V[I-1];
V[1]:=Buf;
end;
end;
3 Задание №3
Соединить два файла в третий, добавив после содержимого первого файла только те строки второго файла, в которых имеются числа-палиндромы.
3.1 Блок-схема программы
 | |||||
 | |||||
 | |||||
 | |||||
3.2 Работа программы
Begin
Выводим на экран меню, представленное на рисунке 2.
Рисунок 2 – главное меню третьей программы.
menu;
Задаем три переменных, которые будут отвечать за информацию о вводе имени для трех файлов. И еще одну, которая будет отвечать за работу программы.
pf:=false;
vf:=false;
tf:=false;
cont:=true;
В будущем нам понадобится еще 2 переменных, flag1 и flag1, которые будут отвечать за наличие информации в файлах.
flag1:=false;
flag2:=false;
while cont do
begin
writeln;
write('Vvedite komandu: ');
Считываем команду и запускаем одну из процедур.
readln(command);
case command of
'0': cont:=false;
'1': begin
write('Vvedite imja pervogo faila: ');
readln(p);
Запускаем проверку правильности ввода имени файла, и если она проходит, то флаг ввода принимает значение True. Иначе будет выведено сообщение о неправильном вводе.
if check1(p)=true then
begin
pf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error input');
end;
end;
'2': begin
write('Vvedite imja vtorogo faila: ');
readln(v);
Запускаем проверку правильности ввода имени файла, и если она проходит, то флаг ввода принимает значение True. Иначе будет выведено сообщение о неправильном вводе.
if check1(v)=true then
begin;
vf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error input');
end;
end;
'3': begin
write('Vvedite imja tretego faila: ');
readln(t);
Запускаем проверку правильности ввода имени файла, и если она проходит, то флаг ввода принимает значение True. Иначе будет выведено сообщение о неправильном вводе.
if check1(t)=true then
begin
tf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln('Error input');
end;
end;
'4': begin
Если все три имени файла введены верно, то запускается ряд процедур по составлению третьего файла.
if (pf=true)and(vf=true)and(tf=true) then
begin
filepr;
Данная процедура смотрит количество строк в файлах и выбирает максимальное и минимальное.
chmax;
Если оба файлы не пустые, то программа приступает к образованием слов и записи их в третий файл.
if check2=false then
begin
Ставим цикл до минимального числа строк.
for l:=1 to m do
begin
slv;
obrslov(slova1,slova2,k1,k2,slova,k);
for g:=1 to k do
begin
write(third,slova[g]);
if g<k then write(third,' ');
end;
Здесь осуществляется переход на следующую строчку.
writeln(third,'');
end;
Выбираем в каком из файлов больше строк и переписываем оставшиеся без изменений.
if m1<>m2 then
begin
if m1>m2 then for L:=m to m1 do
begin
readln(first,S1);
writeln(third,S1);
end
else
for L:=m to m2 do
begin
readln(second,S2);
Writeln(third,S2);
end;
end;
closing;
writeln('Operacia zavershena');
end
else
Если первые два файла не прошли проверку, то программа скажет, какой именно из файлов пустой.
begin
if flag1=true then writeln('Pervii fail pustoi');
if flag2=true then writeln('Vtoroi fail pustoi');
end;
end
else
begin
Если файл не прошел первую проверку, то программа скажет, имя какого из файлов введено неверно или совсем не было введено.
if pf=false then writeln('Ne vvedeno imja pervogo faila');
if vf=false then writeln('Ne vvedeno imja vtorogo faila');
if tf=false then writeln('Ne vvedeno imja tretego faila');
end;
end;
else
writeln('Neizvestnaya komanda');
end;
end;
end.
Процедура правильности проверки ввода имени файлов.
function check1(x:string):boolean;
begin
В данном случае проверяется пустой ввод, и имя файла, начинающееся с пробела.
if length(x)>0 then begin
if x[1]<>' ' then
check1:=true;
end;
end;
Процедура привязки и открытия файлов.
procedure filepr;
begin
assign(first,p);
assign(second,v);
assign(third,t);
reset(first);
reset(second);
rewrite(third);
end;
Процедура проверки количества строк в файлах.
procedure chmax;
begin
Сбрасываем счетчик строк.
m1:=0;
m2:=0;
И пока не конец файла перебираем строки и прибавляем по единице к счетчику.
while not eof(first) do
begin
readln(first,S1);
m1:=m1+1;
end;
Пока не конец файла перебираем строки и прибавляем по единице к счетчику.
while not eof(second) do
Begin
readln(second,S2);
m2:=m2+1;
end;
И присваиваем минимальное значение для переменной m.
if m1<m2 then m:=m1 else m:=m2;
Заново закрываем и открываем файлы.
close(first);
reset(first);
close(second);
reset(second);
end;
Процедура разбития строки на слова и перемещение их в массив.
Procedure slv;
var
i,j:integer;
begin
Считываем первую строчку из обоих файлов и добавляем пробел вначале и в конце строки.
Readln(first,S1);
readln(second,S2);
S1:=' '+S1+' ';
S2:=' '+S2+' ';
Сбрасываем счетчик количества слов.
k1:=0;
k2:=0;
Начинаем перебор элементов до тех пор, пока не найдем пробел. Далее смотрим, если след элемент после пробела, тоже пробел, то пропускаем первый. Если же мы получаем слово, то копируем его в одну из ячеек массива.
for i:=1 to length(S1) do
begin
if s1[i]=' ' then
begin
for j:=i+1 to length(s1) do
if s1[i+1]<>' ' then
if s1[j]=' ' then begin
k1:=k1+1;
slova1[k1]:=copy(s1,i+1,j-i-1);
break;
end;
end;
end;
for i:=1 to length(S2) do
begin
if s2[i]=' ' then
begin
for j:=i+1 to length(s2) do
if s2[i+1]<>' ' then
if s2[j]=' ' then begin
k2:=k2+1;
slova2[k2]:=copy(s2,i+1,j-i-1);
break;
end;
end;
end;
end;
Процедура отсортировки слов.
procedure obrslov(a,b:arr;na,nb:integer; var c:arr; var nc:integer);
var i,j,k:integer;
begin
nc:=0;
Делаем несколько циклов, среди которых перебираем элементы первого массива и сравниваем их со вторым. Затем элементы вторго с элементами первого и оставшиеся заносятся в новый массив.
for i:=1 to na do
begin
k:=0;
for j:=1 to nb do
if a[i]=b[j] then k:=1;
if k=0 then
begin
nc:=nc+1;
c[nc]:=a[i];
end;
end;
for i:=1 to nb do
begin
k:=0;
for j:=1 to na do
if b[i]=a[j] then k:=1;
if k=0 then
begin
nc:=nc+1;
c[nc]:=b[i];
end;
end;
end;
Функция проверки файлов на информацию.
function check2:boolean;
begin
В данному случае мы смотри, не находится ли конец файла на первом месте, и если хоть один файл пустой, то функции присваивается значение False.
if eof(first)=true then flag1:=true else flag1:=false;
if eof(second)=true then flag2:=true else flag2:=false;
if (flag1=false)and(flag2=false) then check2:=false else check2:=true;
end;
Процедура закрытия всех файлов.
procedure closing;
begin
close(first);
close(second);
close(third);
end;
4 Задание №4.
На экране построить семейство кривых (Гипоциклоида), заданных функцией:
X=A∙cos(t)+D∙cos(A∙t); [0<=t<=2∙pi]
X=A∙sin(t)+D∙sin(A∙t);
Группа параметров A,D для построения семейства дана в текстовом файле.
4.1 Работа программы
Begin
Присваиваем начальное значение t, и флаг работы программы.
t:=0;
menu;
cont:=true;
while cont do
begin
Вводим команду в появившееся меню, показанное на рисунке 3.
Рисунок 3 – меню программы 4.
Writeln('Vvedite komady: ');
Readln(command);
case command of
'0':cont:=false;
'1':
begin
writeln;
Вводится имя файла. Имя проходит проверку, если проверка успешна, то из него читаются два значения (А и D) и файл сразу же закрывается.
writeln('Vvedite imja faila: ');
Readln(name);
if check1 = true then begin
namef:=true;
read(fileg,a);
read(fileg,d);
close(fileg);
end else namef:=false;
end;
'2':
Begin
Если из файла успешно считали информацию, программа переходит к построению графика, а именно:
-Очистака окна.
-Изменению разрешения.
-Построению графика.
-Завершению выполнения программы.
if namef=false then
writeln('Ne Vvedeno imja faila')
else
begin
clearwindow;
SetWindowSize(800,600);
mnoj;
graf;
cont:=false;
end;
end;
end;
end;
Следующая функция не дает изменять график до функции ReDraw.
lockdrawing;
OnResize же позволяет делать определенные процедуры при изменение размера окна.
OnResize:=resize;
end.
Функция У
function Yfunc(i: real): real;
begin
result:=A*sin(i)-D*sin(A*t);
end;
Функция Х
function Xfunc(i:real):real;
begin
Xfunc:=A*cos(i)+D*cos(A*i);
end;
Процедура нахождения максимального значения функции, а заодно и множителя.
procedure mnoj;
begin
t:=0;
Задаем цикл и ищем максимальное значение.