50096 (Работа с текстовыми строками, двумерными массивами, файловыми структурами данных), страница 2

2016-07-30СтудИзба

Описание файла

Документ из архива "Работа с текстовыми строками, двумерными массивами, файловыми структурами данных", который расположен в категории "". Всё это находится в предмете "информатика" из 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;

  1. Задание №4.

На экране построить семейство кривых (Гипоциклоида), заданных функцией:

X=A∙cos(t)+D∙cos(A∙t); [0<=t<=2∙pi]

X=A∙sin(t)+D∙sin(A∙t);

Группа параметров A,D для построения семейства дана в текстовом файле.

    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;

Задаем цикл и ищем максимальное значение.

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;

  1. Задание №5

Написать программу, которая формирует файл записей данной структуры:

Type Vladelez=Record

Familia: String;

Adress:String;

Avto:lnteger;

Nomer:Integer;

End;

и определяет: -количество автомобилей каждой марки;

-владельца самого старого автомобиля;

-фамилии владельцев и номера автомобилей данной марки.

    1. Б лок-схема программы

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)


    1. Работа программы

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;

  1. Заключение.

В ходе выполнения курсовой работы мною был изучен язык програмированния Pascal. Также получены практические навыки работы с текстовыми строками, двумерными массивами, файловыми структурами данных, элементами машинной графики и записями.

  1. Приложения А

Код программы 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')

Свежие статьи
Популярно сейчас
Зачем заказывать выполнение своего задания, если оно уже было выполнено много много раз? Его можно просто купить или даже скачать бесплатно на СтудИзбе. Найдите нужный учебный материал у нас!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Нет! Мы не выполняем работы на заказ, однако Вы можете попросить что-то выложить в наших социальных сетях.
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
4144
Авторов
на СтудИзбе
666
Средний доход
с одного платного файла
Обучение Подробнее