Одномерные массивы. Организация ввода и вывода данных

     name:string;

     page:integer;

     god:integer;

End;

Var Spisok:array[1..5] of knigi;

    i,o,summa:integer; m:string;

    Sr:real;

Begin

For i:=1 to 5 do

Begin

With Spisok[i] do

Begin

    Writeln('Vvedite familiu avtora', i);

Readln(fam);

    Writeln('Vvedite nazvanie knigi', i);

Readln(name);

    Writeln('vvedite god izdaniya');

Readln(god);

    Writeln('Vvedite kolichestvo stranic'); 

Readln(page);

End;

End;

Writeln;

Writeln('Spisok knig  izdannih s 1960 goda');

Writeln('Vvedite imya avtora');

Readln(m);

    For i:=1 to 5 do

If (m=spisok[i].fam) and (spisok[i].god>=1960) then

Writeln(spisok[i].fam,' ',spisok[i].name,' ',spisok[i].god); 

Writeln('Imeutsya li knigi s nazvaniem "Informatika"?');

For i:=1 to 5 do

begin

If spisok[i].name='Informatika' then

Writeln(Spisok[i].fam,' ',spisok[i].god,' ',spisok[i].page); o:=o+1 end;

if o=0 then Writeln('Takih knig net');

Summa:=0;

For i:=1 to 5 do

Summa:=Summa+Spisok[i].page;

Sr:=Summa/5;

Writeln('Srednee kolichestvo stranic=',Sr:2:2);

For i:=1 to 5 do

If Spisok[i].page>Sr THEN

Writeln('Stranici prevoshodyawie srednee kolichestvo stranic po spisky ',Spisok[i].fam,' ',Spisok[i].name);

Readln;

End. 

Файловая  переменная.

Типизированные  файлы. 

Задание 49.

а) Организовать файл CHISLA.dat с целыми числами. 

Program p1;

Var f:file of integer;

    n,i,c:integer;

Begin

Writeln('sozdat fail iz celih chisel');

Assign (f,'c:\ucheba\CHISLA.dat');

Rewrite(f);

Readln(n);

For i:=1 to n do

Begin

Read(c);

Write(f,c);

End;

End. 

б) Составить  программу, подсчитывающую количество элементов в файле, их сумму, среднее  арифметическое. 

program p3;

var

   f:file of integer;

   i,n,s:integer;

   elem,k:integer;   sum:integer;sa:real;

begin

   assign(f,'c:\ucheba\kolichestvo.txt');

   reset(f);

   sum:=0;   k:=0;

   while not eof (f) do

  begin

  read(f,elem);  k:=k+1;

       sum:=sum+elem;

     end;

   writeln('summa elementov=',sum);

   sa:=sum/k;

   writeln('sa=',sa:4:2);

   readln;

    end. 

Вариант 4в.

Задание 50.

Организовать  символьный файл f из N компонент. После этого организовать файл g, содержащий все компоненты файла f в обратном порядке. Вывести содержимое файлов на экран. 

Program p1;

Var f,g:file of char;

n,i:integer;

c:char;

a:array[1..10] of char;

Begin

Assign(f,'c:\ucheba\Simvoli.txt');

Rewrite(f);

Writeln('Vvedite kolichestvo komponent ');

Readln(n); writeln;

writeln('vvedite komponenti');

For i:=1 to n do

Begin

Readln(c);

Write(f,c);

End;

Close(f);

Reset(f); 

Assign(g,'c:\ucheba\Simvol_.txt');

Rewrite(g);

i:=1;

While not eof (f) do

Begin

read(f,c);

a[i]:=c;

i:=i+1;

end;

for i:=n downto 1 do

Write(g,a[i]);

Close(f);

Close(g);

Reset(g);

Writeln('simvoli faila g');

While not eof(g) do

Begin

Read(g,c);

Writeln(c,' ');

End;

Close(g);

Readln;End.

Задание 51.

Организовать  файл символов из N компонент. Определить символ, встречающийся в файле наиболее часто. Вывести на экр ан этот символ и его количество в файле.

 

Program z3;

var f:file of char;

    i,n,k,j,max:integer;

    c:char;

    a:array [1..100] of char;

    s:array [1..100] of integer;

Begin

writeln('Sozdat fail iz simvolov');

assign(f,'c:\docume~1\3193~1\0016~1\ucheba\baza4.txt');

rewrite(f);

writeln('vvesti kolichestvo komponentov');

readln(n);

for i:=1 to n do

    begin

    readln(c);

    write(f,c);

    end;

close(f);

reset(f);

i:=1;

while not eof(f) do

   begin

   read(f,c);

   a[i]:=c;

   i:=i+1;

   end;

for k:=1 to i do S[k]:=1;

for k:=1 to i do

for j:=k+1 to i do

    if a[k]=a[j] then s[k]:=s[k]+1;

max:=s[1];

n:=1;

for k:=1 to i do

    if max<s[k] then begin

        max:=s[k];n:=k;end;

for k:=1 to i do

    if s[k]=max then

    writeln('simvol ', a[n],' vstrechaetsya ',n,' raz');

readln;end

.

Задание 52.

Напишите программу  организующую хранение в файле нескольких записей (до 10) о результатах экзамена. Каждая запись содержит 3 поля: номер записи, фамилия, оценка. Организуйте вывод всей информации по форме: {1 Иванов 3} 

Program Z1;

type ekzamen=record

n:integer;

fam:string [15];

oc:integer;

end;

var baza1:file of ekzamen;

    rez:array  [1..10] of ekzamen;

    i:integer;  y:integer;f:string[100];

begin

write('vvedite chislo ychenikov');readln(y);

f:='c:\docume~1\3193~1\0016~1\ucheba\baza1.txt';assign(baza1,f);rewrite(baza1);

    for i:=1 to 10 do begin

       with rez[i] do begin

Writeln('Familiya');

readln(fam);

Writeln('Ocenka');

readln(oc);

end;end;

writeln;

reset(baza1);

Writeln('Rezyltati ekzamena:');

for i:=1 to 10 do

Writeln(i,' ', rez[i].fam, ' ', rez[i].oc);

Readln;end. 
 
 

Текстовые файлы.

 Задание 53

Организовать  файл из N строк (текстовый) text.txt. 

Program p1;

Uses Crt;

Var f:text;

i,n:integer;

c:string;

Begin

ClrScr;

Writeln('sozdanie tekstovogo faila ');

Writeln('vvedite kolichestvi strok');

Readln(n);

Assign(f,'c:\ucheba\text.txt');

Rewrite(f);

For i:=1 to n do

Begin

Readln(c);

Writeln(f,c);

End;

Close(f);

Readln;

End.

  
 

Задание 54

Подсчитать среднюю  длину строк из файла text.txt.

Program p2;

Uses crt;

Var f:text;

i,n,d:integer;

c:string;

Sa:real;

Begin

ClrScr;

Writeln('Nahozhdenie srednej dlini stroki');

Writeln;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

d:=0;

While not eof(f) do

begin

Readln(f,c);

n:=n+1;

d:=d+length(c);

End;

Sa:=d/n;

Writeln('srednee arifmeticheskoe=',sa:4:2);

Repeat Until Keypressed;

End. 

Задание 55

Удалить из текстового файла все пробелы(delete (St, n, 1).

St - строка, n- позиция, 1-количество удаляемых символов. 

Program p3;

Var f:text;

i,n:integer;

c:string;

Begin

Assign(f,'c:\ucheba\text.txt');

Reset(f);

While not eof(f) do

Begin

Readln(f,c);

for i:=1 to length(c) do

if c[i]=' ' then delete(c,i,1);

Writeln('Vivod faila bez probelov:',c);

End;

Readln;

End. 

Задание 56

В текстовом  файле text.txt определить максимальную длину строки. 

Program p2;

Uses crt;

Var f:text;

i,n,max:integer;

c:string;

a:array[1..100] of integer;

Begin

ClrScr;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

i:=1;

While not eof(f) do

Begin

Readln(f,c);

a[i]:=length(c);

i:=i+1;

End;

n:=i;

max:=a[1];

for i:=1 to n do

Begin

If a[i]>max then max:=a[i]; end;

Writeln('maksimalnaya dlina stroki=',max);

End. 

Задание 57

Строки из файла  text.txt разбить на части нечетные по счету строки. Записать в файл text.txt, четные- в text2.txt

Program p5;

Uses crt;

var f,g,h:text;

c:string;

i,n:integer;

Begin

ClrScr;

Writeln('Sortirovka strok faila na chetnie i nechetnie');

Writeln;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

Assign(g,'c:\ucheba\text1.txt');