Поиск максимального в списке.

[Lubawa]

if a[i]>a[maxm].sr then
   maxm:=i; 
writeln(finout,'Лидеры: ', a[maxm].sr);

Как реализовать это же цыкл в списке?
if Temp^.sr>???.sr then

[Serge_Bliznykov]

нужно ПЕРЕБИРАТЬ по одному элементы списка!
Как это делать?
Ну точно так же, как Вы это делаете, когда выводите содержимое списка на экран...

давайте полный код Вашей программы, получите более конкретный ответ...

[Lubawa]

Program lab4;
uses crt;
type
PHuman=^THuman;
THuman=record
    Name:string[15];
    sex: string[1];
    ball:string[4];
    next:PHuman;
end;
var
i:integer;
sIn: string;
First,Last,Temp:PHuman;
finput,finout: text;
i, l, k, c, maxm, maxw: integer;
sum1,sum2,obball1,obball2:real;


procedure readtext;
begin
  while (not eof(finput)) do Begin
    new(Temp);
     readln(finput, sIn);
     {удаляем пробелы если они есть}
      while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
       {разбиваем строку на элементы}
     if Pos(' ', sIn)>1 then begin
        Temp^.Name:= Copy(sIn, 1, Pos(' ', sIn)-1);
         {удалим пробелы}
        sIn := Copy(sIn, Pos(' ', sIn)+1, Length(sIn) - Pos(' ', sIn));
        while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
        Temp^.sex:= sIn[1];
        delete(sIn,1,1); {удалим пол}
        {удалим пробел}
        while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
        Temp^.ball:= Copy(sIn, 1, 4);
        Temp^.sr:=(((ord(Temp^.ball[1])-48)+(ord(Temp^.ball[2])-48)+(ord(Temp^.ball[3])-48)+(ord(Temp^.ball[4])-48))/4);

    Temp^.next := nil;
    end;
    if (Last=nil) then Begin
      First := Temp;
      Last := Temp;
    end else Begin
      Last^.next:= Temp;
      Last:= Temp;
    end;
  end;
  Close(finput);
  end;
  
  
  procedure writetext;
begin
  writeln(finout, Temp^.fam,'  ', Temp^.sex,'  ', Temp^.ball,'  ', Temp^.sr);
  writeln(finout,'Лидеры: ',  ???.fam,' ', ???.sex,' ',a[maxm].ball,' ',???.sr);
  writeln(finout,'',???.fam,'  ', ???.sex,'  ',???.ball,'  ',???.sr);
  writeln(finout,'общий средний балл мужчин: ', obball1);
  writeln(finout,'общий средний балл женщин: ', obball2);
end;

  begin
  First := nil;
  Last := nil;
  Assign(finput,'lab_in.txt');
  Reset(finput);
  readtext;
  l:=1;
  k:=1;
  sum1:=0;
  sum2:=0;
  maxm:=0;
  maxw:=0;
  while (not eof(finput)) do Begin

   if Temp^.sex='м' then
   begin
   if Temp^.sr>???.sr then
   ????
   sum1:=sum1+Temp^.sr;
   obball1:=sum1/l;
   l:=l+1;
   end
   else
     begin
  if Temp^.sr>???.sr then
    ???
    sum2:=sum2+Temp^.sr;
   obball2:=sum2/k;
   k:=k+1;
   end;
   end;
  assign(finout, 'lab_out.txt');
  rewrite(finout);
  writetext;
  close(finout);
   close(finput);

end.

[Lubawa]

Я исправила ошибки в процедуре writetext, чтоб записывался весь список. И убрала закрытие файла в процедуре readtext.

[Lubawa]

Program lab4;
uses crt;
type
PHuman=^THuman;
THuman=record
    Name:string[15];
    sex: string[1];
    ball:string[4];
    sr: real;
    next:PHuman;
end;
var
sIn: string;
First,Last,Temp:PHuman;
finput,finout: text;
i, l, k, c, maxm, maxw: integer;
sum1,sum2,obball1,obball2:real;


procedure readtext;
begin
  while (not eof(finput)) do Begin
    new(Temp);
     readln(finput, sIn);
     {óäàëÿåì ïðîáåëû åñëè îíè åñòü}
      while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
       {ðàçáèâàåì ñòðîêó íà ýëåìåíòû}
     if Pos(' ', sIn)>1 then begin
        Temp^.Name:= Copy(sIn, 1, Pos(' ', sIn)-1);
         {óäàëèì ïðîáåëû}
        sIn := Copy(sIn, Pos(' ', sIn)+1, Length(sIn) - Pos(' ', sIn));
        while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
        Temp^.sex:= sIn[1];
        delete(sIn,1,1); {óäàëèì ïîë}
        {óäàëèì ïðîáåë}
        while (Length(sIn)>1) and (sIn[1]=' ') do delete(sIn,1,1);
        Temp^.ball:= Copy(sIn, 1, 4);
        Temp^.sr:=(((ord(Temp^.ball[1])-48)+(ord(Temp^.ball[2])-48)+(ord(Temp^.ball[3])-48)+(ord(Temp^.ball[4])-48))/4);
    Temp^.next := nil;
    writeln(finout, Temp^.name,'  ', Temp^.sex,'  ', Temp^.ball,'  ', Temp^.sr);
    end;
    if (Last=nil) then Begin
      First := Temp;
      Last := Temp;
    end else Begin
      Last^.next:= Temp;
      Last:= Temp;
    end;
  end;
  end;
  
  begin
  First := nil;
  Last := nil;
  Assign(finput,'lab_in.txt');
  Reset(finput);
  assign(finout, 'lab_out.txt');
  rewrite(finout);
  readtext;

исправила некоторые ошибки. Дальше для выполнения операций над данными списка мне необходимо вернуться на начало списка? Могу я написать Temp:=First; для перехода в начало.

[Lubawa]

  Temp:=First;
  while (not eof(finout)) do Begin
    if Temp^.sex='ì' then
   begin

[Lubawa]

 while (not eof(finout)) do Begin
    if Temp^.sex='ì' then
   begin
   sum1:=sum1+Temp^.sr;
   obball1:=sum1/l;
   l:=l+1;
   Temp:=Temp^.Next;
       end
   else
     begin
   sum2:=sum2+Temp^.sr;
   obball2:=sum2/k;
   k:=k+1;
   Temp:=Temp^.Next;
   end;
   end;

[Serge_Bliznykov]

Любава, у меня к Вам два вопроса...

первый. Вам не кажется, что Вы здесь одна беседуете?...

второй. Вы по прежнему решаете проблему поиска максимального в списке? Или что? Не бросайте просто кусочки кода без пояснения, зачем Вы их тут публикуете и в чём нужна помощь форумчан..

[Lubawa]

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

[Serge_Bliznykov]

пост #7 - если это перебор списка - то там АБСОЛЮТНО лишним является использование файловой переменной
вот эта строка

while (not eof(finout)) do Begin

- в топку!

перебрать элементы можно, например, так:

procedure ShowList;
var Tmp:PHuman;
begin
   Tmp:=First;
   WriteLn('___________________');
   while Tmp<>nil  do begin
     WriteLn(Tmp^.Name:15,' ',Tmp^.Sex,' ',Tmp^.Ball:4,' ',Tmp^.sr:4:2);
     Tmp:=Tmp^.Next;
   end;
   WriteLn('___________________');
   WriteLn('Press Enter to continue....');
   Readln; 
end;

вызовите эту процедуру после readtext;
и посмотрите, что она делает.

А теперь, когда у вас есть процедура, которая перебирает все элементы списка, найти максимальное - раз плюнуть!

Прежде всего, предположу, что максимальное нужно найти не самое длинное имя, а персону с максимальным средним балом.
Так?

Тогда:

procedure ShowMaximalSrednee;
var Tmp, MaxSrPerson:PHuman;
begin
   Tmp:=First;
   if Tmp <> nil then MaxSrPerson := tmp
   else MaxSrPerson := nil;

   while Tmp<>nil  do begin
     if Tmp^.sr>MaxSrPerson^.sr then 
                 MaxSrPerson := tmp;
     Tmp:=Tmp^.Next;
   end;
   if MaxSrPerson = nil then WriteLn('список пуст! Нет тут нечего! ')
   else 
      WriteLn('Максимальный средний балл равен ',MaxSrPerson^.sr:4:2,' фио '+MaxSrPerson^.Name);

   WriteLn('___________________');
   WriteLn('Press Enter to continue....');
   Readln; 
end;

всё.