Program Lists;

{$APPTYPE CONSOLE}

{$R *.res}

Uses
  System.SysUtils,
  System.Generics.Collections;

Const
    FileName = 'in.txt';
    MIN_I = 1;
    MAX_I = 5;

Type
    TPElem = ^TElem;
    TElem = Record
        Surname: String;
        Group: Integer;
        Marks: Array[MIN_I..MAX_I] Of Integer;
        Next, Prev: TPElem;
    End;

    TStudents = Record
        Head, Tail: TPElem
    End;
Var
    Len: Integer = 1;
    Checked: Array[0..1000] Of Integer;
    Index: Integer = 0;

Procedure InitList(Var MyList: TStudents);
Begin
    MyList.Head := Nil;
    MyList.Tail := Nil;
End;

Procedure ReadInfoFromFile(Var MyList: TStudents);
Var
    InputFile: File Of TPElem;
    Temp, TempStr, TempSurname, TempGroup: String;
    MyFile: TextFile;
    I, J, K: Integer;
    Arr: Array[1..5] Of Integer;
    Curr: TPElem;
Begin
    AssignFile(MyFile, FileName);
    Reset(MyFile);

    While Not EoF(MyFile) Do
    Begin
        Readln(MyFile, Temp);
        TempStr := '';
        J := 1;
        K := 0;
        While J < Temp.Length Do
        Begin
            If Temp[J] <> ' ' Then
            Begin
                TempStr := TempStr + Temp[J];
                Inc(J);
            End
            Else
            Begin
                If K = 2 Then
                Begin
                    Inc(J);
                    For I := Low(Arr) To High(Arr) Do
                    Begin
                        If Temp[J] = ' ' Then
                        Begin
                            Arr[I - 1] := 10;
                            Inc(J);
                        End;
                        Arr[I] := StrToInt(Temp[J]);
                        Inc(J, 2);
                    End;
                End
                Else If K = 1 Then
                Begin
                    TempGroup := TempStr;
                    TempStr := '';
                    Inc(K);
                End
                Else
                Begin
                    TempSurname := TempStr;
                    TempStr := '';
                    Inc(J);
                    Inc(K);
                End;
            End;
        End;

        New(Curr);
        Curr^.Surname := TempSurname;
        Curr^.Group := StrToInt(TempGroup);
        For I := Low(Arr) To High(Arr) Do
            Curr^.Marks[I] := Arr[I];
        Curr^.Next := Nil;
        Curr^.Prev := Nil;

        If MyList.Head = Nil Then
            MyList.Head := Curr
        Else
        Begin
            MyList.Tail^.Next := Curr;
            Curr^.Prev := MyList.Tail;
        End;
        MyList.Tail := Curr;
    End;

    CloseFile(MyFile);
End;

{Procedure ReadInfoFromFile(Var MyList: TStudents);
Var
    InputFile: File Of TPElem;
    Temp, TempStr, TempSurname, TempGroup: String;
    MyFile: TextFile;
    I, J, K: Integer;
    Arr: Array[1..5] Of Integer;
    Curr: TPElem;
Begin
    AssignFile(InputFile, 'out.txt');
    Reset(InputFile);

    While Not EoF(InputFile) Do
    Begin
        New(Curr);
        Read(InputFile, Curr);

        If MyList.Head = Nil Then
            MyList.Head := Curr
        Else
        Begin
            MyList.Tail^.Next := Curr;
            Curr^.Prev := MyList.Tail;
        End;
        MyList.Tail := Curr;
    End;

    CloseFile(MyFile);
End;}

Procedure InitChecked();
Var
    I: Integer;
Begin
    For I := 0 To 1000 Do
        Checked[I] := 0;
End;

Function WasUsed(Const ThisGroup: Integer): Boolean;
Var
    I: Integer;
    Flag: Boolean;
Begin
    I := 0;
    If Checked[I] <> 0 Then
        While Checked[I] <> 0 Do
        Begin
            If Checked[I] = ThisGroup Then
                Flag := True;
            Inc(I);
        End
    Else
        Flag := False;
    WasUsed := Flag;
End;

Procedure OutputGoodGroups(Const GoodGroups: Array Of Integer);
Var
    I: Integer;
Begin
    Writeln('Список групп без отстающих студентов: ');
    For I := Low(GoodGroups) To High(GoodGroups) Do
        Write(IntToStr(GoodGroups[I]) + ' ');
End;

Procedure FindGoodGroups(MyList: TStudents);
Var
    GoodGroups: Array Of Integer;
    Curr: TPElem;
    IsGood: Boolean;
    I, ThisGroup: Integer;
    ListForCheck: TStudents;
    Used: Boolean;
Begin
    InitChecked;
    While MyList.Head <> Nil Do
    Begin
        ListForCheck := MyList;
        ThisGroup := ListForCheck.Head^.Group;
        IsGood := True;
        Used := WasUsed(ThisGroup);
        While IsGood And Not Used And (ListForCheck.Head <> Nil) Do
        Begin
            If ListForCheck.Head^.Group = ThisGroup Then
            Begin
                For I := MIN_I To MAX_I Do
                    If ListForCheck.Head^.Marks[I] < 4 Then
                        IsGood := False;
                ListForCheck.Head := ListForCheck.Head^.Next;
            End
            Else
            Begin
                ListForCheck.Head := ListForCheck.Head^.Next;
            End;
        End;
        If IsGood And Not Used Then
        Begin
            SetLength(GoodGroups, Len);
            Inc(Len);
            GoodGroups[Len - 2] := ThisGroup;
        End;
        MyList.Head := MyList.Head^.Next;
        If Not Used Then
        Begin
            Checked[Index] := ThisGroup;
            Inc(Index);
        End;
    End;

    OutputGoodGroups(GoodGroups);
End;

Function FindAverage(Elem: TPElem): Real;
Var
    I, Sum: Integer;
Begin
    Sum := 0;
    For I := MIN_I To MAX_I Do
        Sum := Sum + Elem^.Marks[I];
    FindAverage := Sum / 5;
End;

Procedure OutputBestStudent(Const BestStudent: String);
Begin
    Writeln(#10#13 + #10#13 + 'Студент(-ы) с наивысшим баллом: ' + BestStudent);
End;

Procedure FindBestStudent(MyList: TStudents);
Var
    BestStudent: String;
    Temp: TPElem;
    I: Integer;
    Average, Max: Real;
Begin
    BestStudent := '';
    Max := 0;
    Temp := MyList.Head;
    While Temp <> Nil Do
    begin
        Average := 0;
        For I := MIN_I To MAX_I Do
            Average := Average + Temp^.Marks[I];

        Average := Average / 5;

        If Average > Max Then
        Begin
            Max := Average;
            BestStudent := Temp^.Surname;
        End
        Else If Average = Max Then
            BestStudent := BestStudent + ', ' + Temp^.Surname;

        Temp := Temp^.Next;
    End;

    OutputBestStudent(BestStudent);
End;

Procedure OutputList(MyList: TStudents);
Var
    I: Integer;
Begin
    Writeln(#10#13 + 'Отсортированный список: ' + #10#13);
    While MyList.Head <> Nil Do
    Begin
        Write(MyList.Head^.Surname + ' ' + IntToStr(MyList.Head^.Group) + ' ');
        For I := MIN_I To MAX_I Do
            Write(IntToStr(MyList.Head^.Marks[I]) + ' ');
        Writeln;
        MyList.Head := MyList.Head^.Next;
    End;
End;

Procedure SortList(Var MyList: TStudents);
Var
    AElem, BElem: TPElem;
    Temp: TElem;
Begin
    AElem := MyList.Head;
    While AElem <> Nil Do
    Begin
        BElem := MyList.Head;

        While BElem^.Next <> Nil Do
        Begin
            If FindAverage(BElem) < FindAverage(BElem^.Next) Then
            Begin
                Temp.Surname :=  BElem^.Surname;
                Temp.Group := BElem^.Group;
                Temp.Marks := BElem^.Marks;

                BElem^.Surname := BElem^.Next^.Surname;
                BElem^.Group := BElem^.Next^.Group;
                BElem^.Marks := BElem^.Next^.Marks;

                BElem^.Next^.Surname := Temp.Surname;
                BElem^.Next^.Group := Temp.Group;
                BElem^.Next^.Marks := Temp.Marks;
            End;

            BElem := BElem^.Next;
        End;

        AElem := AElem^.Next;
    End;

    OutputList(MyList);
End;

Procedure WriteToFile(MyList: TStudents);
Var
    MyFile: File Of TPElem;
    Student: TPElem;
    I: Integer;
Begin
    AssignFile(MyFile, 'out.txt');
    Rewrite(MyFile);
    While MyList.Head <> Nil Do
    Begin
        New(Student);
        Student^.Surname := MyList.Head^.Surname;
        Student^.Group := MyList.Head^.Group;
        For I := MIN_I To MAX_I Do
            Student^.Marks[I] := MyList.Head^.Marks[I];
        Student^.Next := Nil;
        Student^.Prev := Nil;

        Write(MyFile, Student);

        MyList.Head := MyList.Head^.Next;
    End;
    CloseFile(MyFile);
End;

Procedure Main();
Var
    MyList: TStudents;
Begin
    InitList(MyList);
    ReadInfoFromFile(MyList);
    FindGoodGroups(MyList);
    FindBestStudent(MyList);
    //WriteToFile(MyList);
    SortList(MyList);
End;

Begin
    Main;
    Readln;
    Readln;
End.