Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Pascal
Перезагрузить страницу нужна ваша помощь по типизированным файлам
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
Yakup Yakup вне форума
Member
 
Сообщений: 16
Сказал(а) спасибо: 4
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 16.11.2017
Exclamation нужна ваша помощь по типизированным файлам - 16.11.2017, 16:42

Pascal Код:
Type
Student = record
  FIO:string[30];
  Data:string[10];
  ocenki:array[1..5] of integer;
 End;
 const
 n=3;
 
 Var
 s,k:Student;
 f:file of Student;
 i,j:integer;
 G:array[1..n]of student;
 Begin
 Assign(f,'SCHOOL');
 Rewrite(f);
 for i:=1 to n do
  Begin
   Writeln('FIO');
   Readln(s.FIO);
   Writeln('Data');
   Readln(s.Data);
   Writeln('Vvedite ocenki');
    for j:=1 to 5 do
     Readln(s.ocenki[j]);
   Write(f,s);
  End;
 Close(f);
 Reset(f);
 i:=0;
 while not(EOF(f)) do
 begin
 i:=i+1;
 read(f,G[i]);
 end;
 close(f);
 writeln(G);
 End.
Есть начало программы, помогите ее доделать.
Вот сама задача:

Дан файл SCHOOL, в котором содержится информация о школьниках:
1) Ф.И.О.
2) год рождения, месяц, число
3) оценки экзаменов
а) отсортировать записи по возрастанию среднего
экзаменационного балла;
б) по запросу по Ф.И.О. - выдать средний балл;
в) распечатать ведомость школьников со средним баллом
меньше 3.
Ответить с цитированием
  (#2 (permalink)) Старый
deckard deckard вне форума
Member
 
Сообщений: 79
Сказал(а) спасибо: 0
Поблагодарили 5 раз(а) в 5 сообщениях
Регистрация: 04.03.2008
По умолчанию 19.11.2017, 17:01

В программе для сортировки записей по именам и оценкам используется
метод пузырьковой сортировки. Обычно этот метод ругают в учебниках
за медлительность, зато он достаточно очевиден в написании и отладке.
А по скорости для современных компьютеров он работает практически мгновенно,
и "продвинутые алгоритмы", т н сортировка Шелла и быстрая сортировка
не оправдывают многочасовых усилий в изучении, написании и отладке.

Pascal Код:
Type
Student = record
  FIO:string[30];
  Data:string[12];
  ocenki:array[1..5] of integer;
 End;

 const nmax=50;

 Var
 s:Student;
 f:file of Student;
 i,j,n:integer;
 G:array[1..nmax] of student;
 index:array[1..nmax] of integer;

 procedure CreateTest;
 begin
 n:=0;
 n:=n+1;with G[n] do begin fio:='Neznayka';data:='23.02.2000';
      ocenki[1]:=2;ocenki[2]:=2;ocenki[3]:=2;ocenki[4]:=2;ocenki[5]:=2 end;
 n:=n+1;with G[n] do begin fio:='Znayka';data:='08.03.2000';
      ocenki[1]:=5;ocenki[2]:=5;ocenki[3]:=5;ocenki[4]:=5;ocenki[5]:=5 end;
 n:=n+1;with G[n] do begin fio:='Tubik';data:='01.05.2000';
      ocenki[1]:=2;ocenki[2]:=3;ocenki[3]:=2;ocenki[4]:=3;ocenki[5]:=2 end;
 n:=n+1;with G[n] do begin fio:='Vintik';data:='14.06.2000';
      ocenki[1]:=4;ocenki[2]:=4;ocenki[3]:=4;ocenki[4]:=4;ocenki[5]:=5 end;
 n:=n+1;with G[n] do begin fio:='Shpuntik';data:='12.08.2001';
      ocenki[1]:=4;ocenki[2]:=4;ocenki[3]:=4;ocenki[4]:=4;ocenki[5]:=4 end;
 for i:=1 to nmax do begin index[i]:=0 end;
 for i:=1 to n do begin index[i]:=i end;
 end;

 procedure CreateStud;
 label 1;
 begin
 writeln('Dlya wyhoda wwedite "0"');
 n:=0;
 while (n<nmax) do begin
 n:=n+1;
 writeln('Student ',n);
 write('FIO>');readln(s.fio);
 if (s.fio='0') then begin writeln('==Stop==');n:=n-1;goto 1;end;
 Write('Data>');Readln(s.Data);
 Writeln('Vvedite ocenki');
 for j:=1 to 5 do begin write('Ocenka',j,'>');  Readln(s.ocenki[j]);end;
 G[n]:=s;
 end;
 1:
 for i:=1 to nmax do begin index[i]:=0 end;
 for i:=1 to n do begin index[i]:=i end;
 end;

 procedure WriteFile;
 Begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 Assign(f,'SCHOOL');Rewrite(f);
 for i:=1 to n do begin Write(f,G[index[i]]) end;
 Close(f);
 writeln('File zapisan,zapisey ',n);
 end;

 procedure ReadFile;
 begin
 n:=0;
 Assign(f,'SCHOOL');Reset(f);
 while not eof(f) do begin
 n:=n+1;read(f,G[n]) end;
 close(f);
 for i:=1 to nmax do begin index[i]:=0 end;
 for i:=1 to n do begin index[i]:=i end;
 writeln('File schitan,zapisey ',n);
 end;


 function srednee(k:integer):real;
 var sum:real;
     ii:integer;
 begin
 sum:=0;
 for ii:=1 to 5 do sum:=sum+G[k].ocenki[ii];
 srednee:=sum/5.0;
 end;

 procedure SortImena;
 var exflag:integer;t:integer;
 begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 exflag:=0;
 while (exflag=0) do begin
   exflag:=1;
   for i:=1 to n-1 do begin
    if (G[index[i]].fio > G[index[i+1]].fio) then
                begin exflag:=0;
                      t:=index[i+1];index[i+1]:=index[i];index[i]:=t end;
                     end;
                    end;
 end;

 procedure SortOcenki;
 var exflag:integer;t:integer;
 begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 exflag:=0;
 while (exflag=0) do begin
   exflag:=1;
   for i:=1 to n-1 do begin
    if (srednee(index[i]) > srednee(index[i+1])) then
                begin exflag:=0;
                      t:=index[i+1];index[i+1]:=index[i];index[i]:=t end;
                     end;
                    end;
 end;

 procedure LineStud(k:integer);
 var ii:integer;
 begin
 with G[k] do begin write(k,chr(32),fio,chr(9),data);
                    for ii:=1 to 5 do write(chr(32),ocenki[ii]);
                    writeln (chr(32),srednee(k):3:1);
              end;
 end;

 procedure ShowStud;
 begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 for i:=1 to n do begin LineStud(index[i]) end;
 end;

 procedure ShowStud2(Sredn:real);
 begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 for i:=1 to n do begin
               if (srednee(index[i])<Sredn) then LineStud(index[i])
               end;
 end;

 procedure ShowStud3;
 var found:integer;
 begin
 if (n=0) then begin writeln('Sozdayte dannye');exit end;
 found:=0;
 write('FIO>');readln(s.fio);
 for i:=1 to n do begin
               if (G[index[i]].fio=s.fio) then
                       begin found:=1;LineStud(index[i]);end;
               end;
 if (found=0) then writeln('Student ne najden');
 end;

 {main}
 var exitprog:integer;cmd:integer;
 begin
 exitprog:=0;
 while (exitprog=0) do begin
 writeln;
 writeln('1. Sozdat demo bazu');
 writeln('2. Sozdat bazu');
 writeln('3. Sortirovka po imeni');
 writeln('4. Sortirovka po srednemu ballu');
 writeln('5. Spisok vsex studentov');
 writeln('6. Spisok studentov so srednim ballom < 3');
 writeln('7. Poisk dannyh po imeni studenta');
 writeln('8. Zagruzit fail');
 writeln('9. Zapisat fail na disk');
 writeln('0. Konec raboty');
 write('>');readln(cmd);
 case cmd of
 0:begin exitprog:=1 end;
 1:begin CreateTest;ShowStud end;
 2:begin CreateStud;ShowStud end;
 3:begin SortImena;ShowStud end;
 4:begin SortOcenki;ShowStud end;
 5:begin ShowStud end;
 6:begin ShowStud2(3.0) end;
 7:begin ShowStud3 end;
 8:begin ReadFile;ShowStud end;
 9:begin WriteFile end;
 end; {case}
 end; {while}
 end.
Ответить с цитированием
Пользователь сказал cпасибо:
Yakup (28.11.2017)
  (#3 (permalink)) Старый
StudDraw2017 StudDraw2017 вне форума
Banned
 
Сообщений: 21
Сказал(а) спасибо: 0
Поблагодарили 1 раз в 1 сообщении
Регистрация: 23.11.2017
По умолчанию 23.11.2017, 21:19

Сортировка типизированного файла выполняется аналогично сортировке массива.
Различия только в цикле: FileSize() используется вместо n-длинны массива и перед обращением к полю записи надо поставить "головку" чтения процедурой Seek и выполнить чтение Read(F,...). После сравнения, если требуется перестановка элементов, снова используется Seek и Write(F,...).
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
нужна ваша помощь volk_8686 Память 15 30.11.2014 14:59
Нужна ваша помощь Andrei14199610 Апгрейд 10 13.08.2012 14:13
Нужна ваша помощь ramazan05duldug Любые вопросы от новичков 7 24.02.2012 21:58
нужна ваша помощь panov1 Любые вопросы от новичков 7 19.02.2012 21:54
Нужна ваша помощь ARROWS С/С++ 4 16.01.2012 01:28
Нужна ваша помощь mino Любые вопросы от новичков 34 03.07.2011 16:16
Нужна ваша помощь spyder Любые вопросы от новичков 2 18.06.2011 06:22
Нужна ваша помощь labor Любые вопросы от новичков 1 02.01.2011 15:08
Нужна ваша помощь compas Любые вопросы от новичков 14 05.12.2010 13:02
Нужна ваша помощь compas Любые вопросы от новичков 0 04.12.2010 01:10
Нужна ваша помощь!!! Катена Операционная система Windows 3 17.12.2009 17:30



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов