IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Поиск в записи (файл) [Pascal]
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Задача.
Создайте файл. В каждом курсе найдите гркппу (группы), в которой больше всего отличников.

Проблема заключается в том, что не очень понимаю как осуществить поиск
Вот мой код, только процедура PROCESS не сделана.....

Код

const
  n = 10;  //сессии
  m = 2;   //экзамены

type
   //Запись сведений об экзамене
   ekzamen = record
               pred: string[10];
               ocen: byte;
             end;

   Te = array [1..n,1..m] of ekzamen;

   student = record
               fio: string[40];
               nkurs: 0..10;
               ngrup: char;
               uspev: te;  
               form: char;
             end;

   fs = file of student;  
var
   fstud: fs;    
   name,        
   pr: string;  
   st: student;  
   ek: ekzamen;  
   i,
   j,
   k,
   nk: integer;  
   S: real;      


procedure create;  //Создание файла
const esc='N';
var
   name: string;
   f: fs;
   st: student;
   ek: ekzamen;
   c: string;
   k,i,j: integer;

begin
  write ('Введите название : ');
  readln (name);
  assignfile (f, name);
  rewrite (f);
  repeat
    write ('ФИО: '); readln (st.fio);
    write ('Номер Курса: '); readln (st.nkurs);
    write ('Номер группы: '); readln (st.ngrup);
    writeln ('---------------------');
    writeln ('Введите усеваемость: ');

     for i:=1 to 2*st.nkurs do  
       for j:=1 to m do
     begin
      write ('Введите предмет: ');
      readln (st.uspev[i,j].pred);
      write ('Введите оценку: ');
      readln (st.uspev[i,j].ocen);
     end;

    writeln ('---------------------');
    write ('Форма обучения (Д/Б): ');
     readln (st.form);
     write(f,st);
  writeln ('Закончить - "N", Продолжить Enter');
  readln (c);
  until c = esc;
  closefile (f);
end;

procedure print;  
var
   f: fs;
   st: student;
   ek: ekzamen;

begin
  write ('Имя файла: ');
  readln (name);
  assignfile (f, name);

  reset (f);

  while not eof(f) do
    begin
      read (f, st);
      with st do
        begin
          writeln ('ФИО> ',fio);
          writeln ('Курс> ',nkurs);
          writeln ('№ Группы> ',ngrup);
           for i:=1 to 2*st.nkurs do
             for j:=1 to m do  
              begin
                writeln ('Предмет> ',st.uspev[i,j].pred,' Оценка> ',st.uspev[i,j].ocen);
              end;
          writeln ('Форма>',form);
      end;
    end;
  closefile (f);
end;

{ТУТ НАДО ЧЕГО-НИБУДЬ НАПИСАТЬ!!!!!}
procedure process;
var
   name: string;
   f: fs;
   st: student;
   k,i,j: integer;
   s: real;
begin

  write ('Имя файла: ');
  readln (name);
  assignfile (f, name);    
  reset (f);


  closefile (f);
end;


begin {main}
  {меню}
  repeat
    writeln ('****************');
    writeln ('1 - Создать');
    writeln ('2 - Печать');
    writeln ('3 - Обработка');
    writeln ('0 - Выход');
    writeln ('****************');
    write (' Введите цифру >> ');
    readln (k);

  if (k<>0) then
    begin
      case k of
        1 : create;
        2 : print;
        3 : process;
      end;{case}
    end;
  until k = 0;
end.{main}

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Если не надо распечатывать собственно данные об отличниках, а требуется только собрать статистику - то вот так можно сделать:

1. Пишешь функцию, определяющую, является ли студент отличником:

function IsExcellent(const X: student): boolean;
begin
result := true;
for i := 1 to n do
for j := 1 to m do
result := result and (X.uspev[i, j].ocen = 5); { <--- только круглые отличники }
end;



2. И теперь ею пользуешься:

procedure process;
{ тут все переменные - опишешь их сам, я добавлю только то что требуется для алгоритма }
type
group_set = set of char;
var
X: student;
i: integer; j: char;
data_array: array[0 .. 10] of record { <--- 5Кб, если что - можно выделить память в куче }
max: integer;
groups: array[char] of integer;
end;
begin
{ открываешь файл... }

fillchar(data_array, sizeof(data_array), 0);
for i := 0 to 10 do
while not eof(f) do begin
read(f, X);
if IsExcellent(X) then begin
inc(data_array[X.nkurs].groups[X.ngrup]);
if data_array[X.nkurs].groups[X.ngrup] > data_array[X.nkurs].max then
data_array[X.nkurs].max := data_array[X.nkurs].groups[X.ngrup];
end;
end;
{ закрываешь файл... }

{ Ну, а теперь уже проходишь по всем строкам и ... }
for i := 0 to 10 do begin

writeln('kurs: ', i, ': ');
for j := low(char) to high(char) do begin
if data_array[i].groups[j] = data_array[i].max
then write(j); { <--- вывод можешь сделать и другой... }
end;

end;
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +



1. Пишешь функцию, определяющую, является ли студент отличником:

function IsExcellent(const X: student): boolean;
begin
result := true;
for i := 1 to n do
for j := 1 to m do
result := result and (X.uspev[i, j].ocen = 5); { <--- только круглые отличники }
end;



2. И теперь ею пользуешься:

procedure process;
{ тут все переменные - опишешь их сам, я добавлю только то что требуется для алгоритма }
type
group_set = set of char;
var
X: student;
i: integer; j: char;
data_array: array[0 .. 10] of record { <--- 5Кб, если что - можно выделить память в куче }
max: integer;
groups: array[char] of integer;
end;
begin
{ открываешь файл... }

fillchar(data_array, sizeof(data_array), 0);
for i := 0 to 10 do
while not eof(f) do begin
read(f, X);
if IsExcellent(X) then begin
inc(data_array[X.nkurs].groups[X.ngrup]);
if data_array[X.nkurs].groups[X.ngrup] > data_array[X.nkurs].max then
data_array[X.nkurs].max := data_array[X.nkurs].groups[X.ngrup];
end;
end;
{ закрываешь файл... }

{ Ну, а теперь уже проходишь по всем строкам и ... }
for i := 0 to 10 do begin

writeln('kurs: ', i, ': ');
for j := low(char) to high(char) do begin
if data_array[i].groups[j] = data_array[i].max
then write(j); { <--- вывод можешь сделать и другой... }
end;

end;
end;


[/quote]
Volvo, а можно как-нибудь по-другому реализовать procedure process?? а то просто я не знаком с fillchar и т.д. ....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
а можно как-нибудь по-другому реализовать procedure process?? а то просто я не знаком с fillchar и т.д. ....
Угу... И с циклами не знаком, без них желательно обойтись, да? То что ты не знаком - должно оказывать на помогающего тебе какое-то влияние? Не знаком - познакомься. Help в Паскале еще никто не отменял. А одну и ту же программу в пяти вариациях (для того, кто не знаком с пользовательскими типами; для того кто понятия не имеет? что такое FillChar; для того кто в глаза не видел множества; остальные не желающие ничего знать) я делать не собираюсь...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 1.11.2020 6:16
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name