50096 (Работа с текстовыми строками, двумерными массивами, файловыми структурами данных), страница 2
Описание файла
Документ из архива "Работа с текстовыми строками, двумерными массивами, файловыми структурами данных", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "50096"
Текст 2 страницы из документа "50096"
begin
readln(first,S1);
m1:=m1+1;
end;
Пока не конец файла перебираем строки и прибавляем по единице к счетчику.
while not eof(second) do
Begin
readln(second,S2);
m2:=m2+1;
end;
И присваиваем минимальное значение для переменной m.
if m1 Заново закрываем и открываем файлы. 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; На экране построить семейство кривых (Гипоциклоида), заданных функцией: X=A∙cos(t)+D∙cos(A∙t); [0<=t<=2∙pi] X=A∙sin(t)+D∙sin(A∙t); Группа параметров A,D для построения семейства дана в текстовом файле. 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; Задаем цикл и ищем максимальное значение. while t <= 2*pi do begin xx:=trunc(Xfunc(t)); ifabs(xx)> maxx then maxx:=abs(xx); yy:=trunc(Yfunc(t)); if abs(yy)> maxy then maxy:=abs(yy); Здесь изменяем точность поиска. t:=t+0.001; end; После чего ищем коэффициент координат. Он зависит от нескольких переменных: ширина, высота, и максимальной координаты. if WindowWidth if maxy>maxx then k:=(WindowHeight/2)/maxy else k:=(windowWidth/2)/maxx else If maxx>maxy then k:=(windowheight/2)/maxx else k:=(windowWidth/2)/maxy; end; Функция проверки файла на правильность ввода имени и на нахождения в нем данных. function check1:boolean; begin Проверка длинны имени файла. if length(name)>0 then begin assign(fileg, name); reset(fileg); if eof(fileg)=false then check1:= true else check1:=false; end; end; Процедура построения графика. procedure graf; begin Уменьшаем наш коэффициент, чтобы уместились обозначения системы координат. k:=k-k*0.1; Далее чертим ровно по центру оси Х и У. Стрелочки, показывающее направление. Все данные берутся в зависимости от размера экрана, для удобства просмотра как при маленьком, так и при большом разрешение. moveto(1, windowHeight div 2); lineto(WindowWidth, WindowHeight div 2); moveto(WindowWidth div 2, 1); lineto(WindowWidth div 2, WindowHeight); moveto(trunc((WindowWidth div 2)*0.98),trunc(0.04*WindowHeight)); Lineto((Windowwidth div 2),1); lineto(trunc((windowWidth div 2)*1.02),trunc(0.04*windowHeight)); moveto(trunc(windowwidth*0.96),trunc(0.98*(windowheight div 2))); lineto(windowwidth,windowheight div 2); lineto(trunc(windowwidth*0.96),trunc(1.02*(windowheight div 2))); T:=0; Вычисляем стартовые координаты и перемещаем туда курсор, для дальнейшего построения. xx:=(WindowWidth div 2)+trunc(k*Xfunc(t)); yy:=(WindowHeight div 2)+trunc(k*Yfunc(t)); moveto(xx,yy); Задаем цикл, в котором программа сама будет высчитывать значения, и рисовать график. while t<=2*pi do begin xx:=(WindowWidth div 2)+trunc(k*Xfunc(t)); yy:=(WindowHeight div 2)+trunc(k*Yfunc(t)); lineto(xx,yy); Число ниже влияет на точность построения графика. При больших значениях график может очень долго строится, а при маленьких график получается не точны и угловатый. t:=t+0.001; end; Для улучшения просматриваемости графика, при маленьких разрешениях подписи систем координат скрываются. If WindowWidth>400 then If Windowheight>200 then begin textout(trunc(1.05*(windowWidth div 2)),trunc(0.01*(WindowHeight )),'Y'); Textout(trunc(0.95*WindowWidth),trunc((WindowHeight div 2)*1.05),'X'); end; end; Процедура перечерчивания графика при смене разрешения. procedure resize; begin mnoj; ClearWindow; graf; redraw; lockdrawing; end; Написать программу, которая формирует файл записей данной структуры: Type Vladelez=Record Familia: String; Adress:String; Avto:lnteger; Nomer:Integer; End; и определяет: -количество автомобилей каждой марки; -владельца самого старого автомобиля; -фамилии владельцев и номера автомобилей данной марки. Cont:=true Fzap:=false Readln(command) 0 Cont:=false Readln(n) Fzap:=true 1 2 Change(I,avtovl,ch) 3 Readln(i) Change(I,avtovl,ch) 4 Mark(avtovl) 5 MostOld(avtovl) 6 Oprmarki(avtovl)
Задание №4.
Работа программы
Задание №5
Б лок-схема программы
-
Работа программы
Begin
Задаем цикл, и заполняем массив ch, который будет отвечать за введение информации в другой массив.
for i:=1 to 200 do
ch[i]:=false;
Очищаем экран для удобного ввода, и выводим меню на экран, которое представлено на рисунке 4.
Рисунок 5 – меню пятой программы.
clrscr;
menu;
Задаем две переменные, которые отвечают за работу программы и за введение количества элементов.
cont:=true;
fzap:=false;
while cont do
begin
write('Vvedite komandu: ');
readln(command);
case command of
'0': cont := false;
'1':
Begin
Задаем общее количество элементов массива, если запись будет соответствовать условию, то fzap присвоится true.
Write('Vvedite kol-vo zapisei(1..200): ');
readln(n);
if (n>0) and (n<=200) then
fzap:=true else fzap:=false;
end;
'2':
Begin
Если было введено общее количество записей, то запустится цикл с повторяющейся процедурой, до тех пор пока не будут введены все записи. В противном случае выведется сообщение, что не введено общее количество записей.
if fzap=true then
begin
for i:=1 to n do
сhange(i, avtovl, ch);
clrscr;
menu;
end
else writeln('Ne vvedeno kol-vo zapisei');
end;
'3':
Begin
Если было введено общее количество элементов, то можно редактировать записи по очереди. Если введено число больше общего числа элементов, то программа сообщит от ошибке ввода.
if fzap=true then
begin
write('Vvedite nomer redaktiryemoi zapisi: ');
readln(i);
if i>n then writeln('Wrong input')
else
begin
change(i, avtovl, ch);
clrscr;
menu;
end;
end
else Writeln('Ne vvedeno obshee chislo zapisei');
end;
'4':
Begin
Вначале программа проверяет, введено ли общее число элементов. Затем проверяет каждый элемент по очереди. Если все они заполнены, то начинается выполнятся процедура по подсчету машин каждой марки.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln('Vvedeni ne vse zapisi');
end
else dzap:=true;
if dzap=true then
mark(avtovl);
end
else
Writeln('Ne vvedeno obshee chislo zapisei');
end;
'5':
Begin
Все проверки выполняются аналогично предыдущему варианту, но здесь выбирается процедура нахождения хозяина самого старого авто.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln('Vvedeni ne vse zapisi');
end
else dzap:=true;
if dzap=true then
mostold(avtovl);
end
else
Writeln('Ne vvedeno obshee chislo zapisei');
end;
'6':
Begin
Все проверки выполняются аналогично предыдущему варианту, но здесь выбирается иная процедура.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln('Vvedeni ne vse zapisi');
end
else dzap := true;
if dzap=true then
oprmarki(avtovl);
end
else
Writeln('Ne vvedeno obshee chislo zapisei');
end;
end;
end;
end.
Процедура oprmarki;
procedure oprmarki(x: mas);
var
h:integer;
m:string;
begin
Вводим название марки, и программа переберет все записи и при нахождение такой же марки выведет на экран фамилию владельца и номер автомобиля.
Write('Vvedite marku avto: ');
readln(m);
for h:=1 to n do
if x[h].Avto=m then
writeln(x[h].Familia, ' nomer-', x[h].Nomer);
end;
Процедура нахождения самого старого авто
procedure mostold(x: mas);
var
min,nmin,h:integer;
begin
min:=x[1].Vypusk;
nmin:=0;
Перебираем все записи и сохраняем минимальный год выпуска в переменную min, а номер записи в переменную nmin. А после цикла их выводит на экран.
for h:=1 to n do
if x[h].Vypusk begin min:=x[h].Vypusk; nmin:=h; end; Writeln(x[nmin].Familia, ' - ', min,' god vypuska'); end; Процедура подсчета автомобилей каждой марки. procedure mark(x: mas); var h, l, k: integer; begin for h := 1 to n do begin Вначале программы задаем пустое множество. И запускаем цикл. Если определенной марки нет в множестве, тогда добавляем ее. И запускаем второй цикл, только начиная не с единицы, а с h-го элемента. Затем если h-ый и l-ый элементы совпадают, прибавляем к счетчику единицу .И в конце второго цикла выводим собранные данные на экран. if not (x[h].avto in marki) = true then begin k := 0; include(marki, x[h].avto); for l:=h to n do if x[h]=x[l] then if x[l].avto in marki then k:=k + 1; writeln(x[h].avto, '-', k); end; end; end; Процедура ввода данных в запись. procedure change(x: integer; var z: mas; var v: mas2); begin clrscr; В контрольный массив ставим, что данная запись с этим номер заполнена. v[x]:=true; write('Vvedite familiu: '); readln(z[x].familia); write('Vvedite adress: '); readln(z[x].adress); write('Vvedite marku avto: '); readln(z[x].avto); write('Vvedite nomer avto: '); readln(z[x].nomer); z[x].Vypusk:= 0; while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do begin write('Vvedite god vipuska(1900..2000): '); readln(z[x].vypusk); end; end; В ходе выполнения курсовой работы мною был изучен язык програмированния Pascal. Также получены практические навыки работы с текстовыми строками, двумерными массивами, файловыми структурами данных, элементами машинной графики и записями. Код программы 1 program slova1; uses crt; type Stroka250=string[250]; Slovo=string[20]; function Copy1(S: Stroka250; Start, Len: Integer):Stroka250; var Rez: Stroka250; L: Integer; I, J: Integer; begin L:=byte(S[0]); if (L Rez[0]:=char(0) else begin if (Start+Len-1)>L then Len:=L-Start+1; J:=Start; for I:=1 to Len do begin Rez[I]:=S[J]; Inc(J); end; Rez[0]:=char(Len); end; Copy1:=Rez; end; function isletter(C: Char): Boolean; begin if ((C>='A') and (C='a') and (C<='z')) then isletter:=True else isletter:=False; end; function alforder(Sl: Slovo; var Count: Byte): Boolean; var I, L: Byte; F: Boolean; Buf: Char; begin L:=Length(Sl); Count:=0; for I:=1 to L do begin if (isletter(Sl[I])) then Inc(Count); if (Sl[I]>='A') and (Sl[I]<='Z') then Sl[I]:=char(byte(Sl[I])+32); end; {esli v slove net bukv} if Count=0 then alforder:=False else if Count=1 then alforder:=True else begin F:=True; While F do begin F:=False; for I:=1 to L-1 do if (Not isletter(Sl[I])) And (isletter(Sl[I+1])) then begin F:=True; Buf:=Sl[I]; Sl[I]:=Sl[I+1]; Sl[I+1]:=Buf; end; end; F:=true; for I:=1 to Count-1 do if Sl[I]>Sl[I+1] then begin F:=False; break; end; alforder:=F; end; end; procedure alfslovo(S: Stroka250); var F: boolean; Len: Byte; I: Byte; Counter: Byte; FSlovo, Buf: Slovo; Index, L: Byte; MaxCol: Byte; begin Len:=Length(S); if S[Len]<>' ' then begin S:=S+' '; Inc(Len); end; F:=False; MaxCol:=0; for I:=1 to Len do if S[I]<>' ' then begin if F=False then begin F:=True; Index:=I; L:=1; end else Inc(L); end else if F=True then begin F:=False; Buf:=Copy1(S, Index, L); Buf[0]:=char(L); if alforder(Buf, Counter) then begin if Counter>MaxCol then begin FSlovo:=Copy1(S, Index, L); FSlovo[0]:=char(L); MaxCol:=Counter; end; end; end; if MaxCol=0 then writeln('Net podhodyaschi slov v texte') else writeln(FSlovo, ' kol-vo bukv: ', MaxCol); end; function simmetr(S: Slovo):boolean; var L, I, R: Byte; F: Boolean; begin L:=Length(S); R:=L div 2; F:=True; for I:=1 to R do if S[I]<>S[L-I+1] then begin F:=False; break; end; simmetr:=F; end; procedure colsimmslovo(S: Stroka250); var F: boolean; Len: Byte; I: Byte; Counter: Byte; Buf: Slovo; Index, L: Byte; MaxCol: Byte; begin Len:=Length(S); if S[Len]<>' ' then begin S:=S+' '; Inc(Len); end; F:=False; Counter:=0; writeln('Spisok simmetrichnyh slov iz bolshe chem 2 znaka:'); for I:=1 to Len do if S[I]<>' ' then begin if F=False then begin F:=True; Index:=I; L:=1; end else Inc(L); end else if F=True then begin F:=False; if L>2 then begin Buf:=Copy(S, Index, L); Buf[0]:=char(L); if simmetr(Buf) then begin Inc(Counter); writeln(Buf); end; end; end; writeln('Kol-vo naidennyh slov: ', Counter); end; procedure menu; begin writeln; writeln('++++++++++++++++++++++++++++++++++++++++++++++++'); writeln('+ Vvod texta --> 1 +'); writeln('+ Slovo s max. kol.bukv v alf. poryadke --> 2 +'); writeln('+ Simmetrichnye slova --> 3 +'); writeln('+ Vyvod texta --> 4 +'); writeln('+ +'); writeln('+ Konec --> 0 +'); writeln('++++++++++++++++++++++++++++++++++++++++++++++++'); writeln; end; var Txt: Stroka250; Vvod, Cont: Boolean; Rem: Char; begin Vvod:=False; Cont:=True; while Cont do begin clrscr; menu; write('Vvedite komandu: '); readln(Rem); case Rem of '0': Cont:=False; '1': begin writeln('Text:'); readln(Txt); Vvod:=True; end; '2': begin if Not Vvod then writeln('Ne vveden text') else alfslovo(Txt); end; '3': begin if Not Vvod then writeln('Ne vveden text')
Заключение.
Приложения А