Temat Grupowanie pascal

0

Witam mam takie zadanie: wypisz n osób i podziel je na 4 grupy biorąc pod uwage płeć oraz wiek(chłopak do 20 lat, chłopak powyżej 20 lat,dziewczyna do 20 lat , dziewczyna powyzej 20 lat). I tak zrobiłem taki program program pięknie dzieli osoby na grupy , pisze która osoba do której grupy należy i wypisuje najpierw osoby z grupą zerową potem pierwszą drugą i trzecią ale jeszcze muszę zrobić aby Napisało mi przed wypisywaniem tych informacji takie cos:
GRUPA 0
{i tu informacje o osobach}
GRUPA 1
{i tu informacje o osobach}
GRUPA 1
{i tu informacje o osobach}
GRUPA 1
{i tu informacje o osobach}

tego właśnie nie wiem jak zrobic bardzo proszę o pomoc

 

type
osoba=record
imie:string;
ostatnialitera:string[1]; 
plec:string;
wiek:integer;  
grupa:integer;    
group:integer; 
end;

tab = array of osoba;

var
x:tab;
c,n,i,j,q,m:integer;
r,h:string;
begin
writeln('Ile jest osob???');  readln(n);
SetLength(x,n);
for i:=1 to n do

begin
writeln;
writeln('Osoba nr ',i,': ');
write('Imie: ');  readln(x[i].imie);
write('wiek: ');  readln(x[i].wiek);
x[i].ostatnialitera := Copy(x[i].imie,Length(x[i].imie),1);   {kopiujesz ostatnią litere z stringu 'imię'}
   if ((x[i].ostatnialitera='a') or (x[i].ostatnialitera='A')) then
     x[i].plec:='kobieta'
	 else
	 x[i].plec:='mezczyzna';
   if ((x[i].plec='kobieta') and (x[i].wiek<=20)) then
     x[i].grupa:=0;
   if ((x[i].plec='kobieta') and (x[i].wiek>20)) then
     x[i].grupa:=1;
   if ((x[i].plec='mezczyzna') and (x[i].wiek<=20)) then
	 x[i].grupa:=2;
   if ((x[i].plec='mezczyzna') and (x[i].wiek>20)) then
	 x[i].grupa:=3;
    
	writeln('plec: ',x[i].plec); 
    writeln('grupa: ',x[i].grupa);

end;
	
 for i:=2 to n do begin
    for j:=n downto i do begin
        if x[j-1].grupa > x[j].grupa then begin
            
		    
      h:=x[j-1].imie; 
      x[j-1].imie:=x[j].imie; 
      x[j].imie:=h; 
 
      m:=x[j-1].wiek;
	  x[j-1].wiek:=x[j].wiek;
      x[j].wiek:=m;   
	  
	  r:=x[j-1].plec; 
      x[j-1].plec:=x[j].plec; 
      x[j].plec:=r; 

      q := x[j-1].grupa;
      x[j-1].grupa := x[j].grupa;
      x[j].grupa := q;
                     end;
                                       end;
writeln;

end;


for i:=1 to n do
begin
writeln('Osoba nr: ');
writeln('imie: ',x[i].imie);
writeln('wiek: ',x[i].wiek);
writeln('plec: ',x[i].plec);
writeln('grupa: ',x[i].grupa);
writeln;

end;
     

	 	 end.

0
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type osoba=record
  imie:string;
  ostatnialitera:string[1];
  plec:string;
  wiek:integer;
  grupa:integer;
  group:integer;
end;
 
tab = array of osoba;
 
var
  x:tab;
  c,n,i,j,q,m:integer;
  r,h:string;

begin
  writeln('Ile jest osob???');  readln(n);
  SetLength(x,n);
  for i:=0 to n -1 do
  begin
    writeln;
    writeln('Osoba nr ',i +1,': ');
    write('Imie: ');  readln(x[i].imie);
    write('wiek: ');  readln(x[i].wiek);
    x[i].ostatnialitera := Copy(x[i].imie,Length(x[i].imie),1);   {kopiujesz ostatnią litere z stringu 'imię'}
    if ((x[i].ostatnialitera='a') or (x[i].ostatnialitera='A')) then
      x[i].plec:='kobieta'
        else
         x[i].plec:='mezczyzna';
    if ((x[i].plec='kobieta') and (x[i].wiek<=20)) then
      x[i].grupa:=0;
    if ((x[i].plec='kobieta') and (x[i].wiek>20)) then
      x[i].grupa:=1;
    if ((x[i].plec='mezczyzna') and (x[i].wiek<=20)) then
      x[i].grupa:=2;
    if ((x[i].plec='mezczyzna') and (x[i].wiek>20)) then
      x[i].grupa:=3;
    writeln('plec: ',x[i].plec);
    writeln('grupa: ',x[i].grupa);
  end;
 
  for i:=0 to n do
  begin
    for j:=n -1 downto i do
    begin
    if x[j-1].grupa > x[j].grupa then
      begin
        h:=x[j-1].imie;
        x[j-1].imie:=x[j].imie;
        x[j].imie:=h;
 
        m:=x[j-1].wiek;
        x[j-1].wiek:=x[j].wiek;
        x[j].wiek:=m;
 
        r:=x[j-1].plec;
        x[j-1].plec:=x[j].plec;
        x[j].plec:=r;
 
        q := x[j-1].grupa;
        x[j-1].grupa := x[j].grupa;
        x[j].grupa := q;
      end;
    end;
    writeln;
  end;

  writeln('Nr Imie                 Wiek Plec       Grupa');

  for i := 0 to n -1 do
  begin
    writeln(Format('%-2d %-20s %-4d %-10s %-6d',[i +1, x[i].imie, x[i].wiek, x[i].plec, x[i].grupa]));
  end;
  readln;
end.
0

W poście wyżej coś jest namieszane w sortowaniu a już nie chciało mi się tego analizować, poniżej wersja z QuickSortem.

 program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type osoba=record
  imie:string;
  ostatnialitera:string[1];
  plec:string;
  wiek:integer;
  grupa:integer;
  group:integer;
end;
 
tab = array of osoba;
 
var
  x:tab;
  c,n,i,j,q,m:integer;
  r,h,a:string;

procedure Sort(var A: array of osoba);

  procedure QuickSort(var A: array of osoba; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: osoba;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo].grupa < Mid.grupa do Inc(Lo);
      while A[Hi].grupa > Mid.grupa do Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

begin
  writeln('Ile jest osob???');  readln(n);
  SetLength(x,n);
  for i:=0 to High(x) do
  begin
    writeln;
    writeln('Osoba nr ',i +1,': ');
    write('Imie: ');  readln(x[i].imie);
    write('wiek: ');  readln(x[i].wiek);
    x[i].ostatnialitera := Copy(x[i].imie,Length(x[i].imie),1);   {kopiujesz ostatnią litere z stringu 'imię'}
    if ((x[i].ostatnialitera='a') or (x[i].ostatnialitera='A')) then
      x[i].plec:='kobieta'
        else
         x[i].plec:='mezczyzna';
    if ((x[i].plec='kobieta') and (x[i].wiek<=20)) then
      x[i].grupa:=0;
    if ((x[i].plec='kobieta') and (x[i].wiek>20)) then
      x[i].grupa:=1;
    if ((x[i].plec='mezczyzna') and (x[i].wiek<=20)) then
      x[i].grupa:=2;
    if ((x[i].plec='mezczyzna') and (x[i].wiek>20)) then
      x[i].grupa:=3;
    writeln('plec: ',x[i].plec);
    writeln('grupa: ',x[i].grupa);
  end;

  Sort(x);

  writeln;
  writeln('Nr Imie                 Wiek Plec       Grupa');

  for i := 0 to High(x) do
  begin
    writeln(Format('%-2d %-20s %-4d %-10s %-6d',[i +1, x[i].imie, x[i].wiek, x[i].plec, x[i].grupa]));
  end;
  readln;
end.
0

Dzięki za próbe pomocy ale chyba źle się zrozumieliśmy (a raczej ja niedokładnie napisałem treść:)) chodziło mi o to żeby program zrobił takie coś:
np: dla 7 osób
Powiedzmy ze trzy osoby należą do grupy 0 jedna osoba do grupy pierwszej dwie do grupy drugiej i jedna do trzeciej
i chciałbym zeby pokazało mi takie coś:

GRUPA 0 :

osoba
{info}

osoba
{info}

osoba
{info}

GRUPA 1

osoba
{info}

GRUPA 2

osoba
{info}

osoba
{info}

GRUPA 3

osoba
{info}

0
 program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type osoba=record
  imie:string;
  ostatnialitera:string[1];
  plec:string;
  wiek:integer;
  grupa:integer;
  group:integer;
end;
 
tab = array of osoba;
 
var
  x:tab;
  c,n,i,j,q,m:integer;
  r,h:string;
  biezacaGrupa : integer;

procedure Sort(var A: array of osoba);

  procedure QuickSort(var A: array of osoba; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: osoba;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo].grupa < Mid.grupa do Inc(Lo);
      while A[Hi].grupa > Mid.grupa do Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

begin
  writeln('Ile jest osob???');  readln(n);
  SetLength(x,n);
  for i:=0 to High(x) do
  begin
    writeln;
    writeln('Osoba nr ',i +1,': ');
    write('Imie: ');  readln(x[i].imie);
    write('wiek: ');  readln(x[i].wiek);
    x[i].ostatnialitera := Copy(x[i].imie,Length(x[i].imie),1);   {kopiujesz ostatnią litere z stringu 'imię'}
    if ((x[i].ostatnialitera='a') or (x[i].ostatnialitera='A')) then
      x[i].plec:='kobieta'
        else
         x[i].plec:='mezczyzna';
    if ((x[i].plec='kobieta') and (x[i].wiek<=20)) then
      x[i].grupa:=0;
    if ((x[i].plec='kobieta') and (x[i].wiek>20)) then
      x[i].grupa:=1;
    if ((x[i].plec='mezczyzna') and (x[i].wiek<=20)) then
      x[i].grupa:=2;
    if ((x[i].plec='mezczyzna') and (x[i].wiek>20)) then
      x[i].grupa:=3;
    writeln('plec: ',x[i].plec);
    writeln('grupa: ',x[i].grupa);
  end;

  Sort(x);

  writeln;
  //writeln('Nr Imie                 Wiek Plec       Grupa');

  writeln('Grupa ',x[0].grupa);
  writeln;
  biezacaGrupa := x[0].grupa;
  for i := 0 to High(x) do
  begin
    //writeln(Format('%-2d %-20s %-4d %-10s %-6d',[i +1, x[i].imie, x[i].wiek, x[i].plec, x[i].grupa]));
    if biezacaGrupa <> x[i].grupa then
      begin
        biezacaGrupa := x[i].grupa;
        writeln;
        writeln('Grupa ',x[i].grupa);
        writeln;
      end;
      writeln('Osoba nr: ', i +1);
      writeln('imie: ',x[i].imie);
      writeln('wiek: ',x[i].wiek);
      writeln('plec: ',x[i].plec);
      writeln;
  end;
  readln;
end.
0

Wielkie dzięki bardzo mi pomogleś pozdrawiam:)

0

Mam jeszcze jedno pytanie program jest prawie gotowy ludzie śą podzieleni na grupy i podają pięć utworów muzycznych a program oblicza mi 3 najpopularniejsze piosenki ale podaje tylko liczbe głosów a nie podaje tytułów więc jak to zrobić aby podawał jeszcze tytuły tych piosenek??

 

program daniel;

{$APPTYPE CONSOLE}

uses
  SysUtils;
  
type 
  TPopular = record 
    Glosy : Integer; 

  end;
  
  
  type 
  TPerson = record 
    Imie, Plec     : String; 
    OstatniaLitera : Char;
    Wiek, Grupa    : Integer; 
  
    Wybory         : array [1..5] of Integer; 
    Utwory         : array [1..5] of String; 
  end; 

var 
  Osoby : array of TPerson; 
  IloscOsob, I, J, K,f,g,h,KA,q,w,t,AktualnaGrupa :Integer; 
   Max : array [1..3] of TPopular; 
      IloscGlosow : array [1..11] of Integer; 

  Tytuly : array [1..11] of String = 
  ( 
    ('Peja - Cicha Noc'), 
    ('Toto - Hold The Line'), 
    ('John Lenon - Imagine'), 
    ('Cutting Crew - I Just Died in your arms tonight'),
    ('Tiesto - Show Me A Way'), 
    ('O.S.T.R - Kochana Polsko'), 
    ('Murrray Head - One Night in Bangkok'), 
    ('Tupac - California Love'), 
    ('Tupac - Geto gospel'), 
    ('ABBA - Knowing Me Knowing You'),
    ('Metalica - Brothers in Army ') 
  ); 
  
procedure ReplaceStrings(var S1, S2: String); 
var Temp: String; 
begin
  Temp := S1; 
  S1 := S2; 
  S2 := Temp; 
end; 
  
procedure ReplaceIntegers(var I1, I2: Integer);
var Temp: Integer; 
begin 
  Temp := I1; 
  I1 := I2; 
  I2 := Temp; 
end; 

begin 
  Writeln('Ile jest osob???'); 
  Readln(IloscOsob); 
  
  SetLength(Osoby, IloscOsob); 
  
  for I := 0 to IloscOsob-1  do
    begin 
      Writeln; 
      Writeln('Osoba nr ', I+1, ': '); 
  
      Write('Imie: '); 
      Readln(Osoby[I].Imie); 

      Write('Wiek: '); 
      Readln(Osoby[I].Wiek); 
  
      Osoby[I].OstatniaLitera := Osoby[I].Imie[  Length(Osoby[I].Imie)  ]; 
  
      if LowerCase(Osoby[I].OstatniaLitera) = 'a' then 
         Osoby[I].Plec := 'Kobieta'
      else 
         Osoby[I].Plec := 'Mezczyzna'; 
  
      if Osoby[I].Plec = 'Kobieta' then 
        begin 
          if Osoby[I].Wiek <= 20 then 
             Osoby[I].Grupa := 0
          else 
             Osoby[I].Grupa := 1; 
        end 
      else 
        begin 
          if Osoby[I].Wiek <= 20 then 
             Osoby[I].Grupa := 2
          else 
             Osoby[I].Grupa := 3; 
        end; 
  
      writeln; 
      writeln('Podaj 5 najlepszych wedlug ciebie utworow (wedlug priorytetu)', #13); 

      for K := Low(Tytuly) to High(Tytuly) do 
        Writeln(K, '  --  ', Tytuly[K]); 
  
  
      for K := 1 to 5 do 
        begin 
          Write('Wybor ', K, ': ');
          Readln(Osoby[I].Wybory[K]); 
        end; 
  
      for K := 1 to 5 do 
        Osoby[I].utwory[K] := Tytuly[Osoby[I].Wybory[K]]; 
  
      Writeln;
      Writeln('Twoj wybor: '); 
      Writeln('Utwor Pierwszy: ', Osoby[I].Utwory[1]);
      Writeln('Utwor Drugi: ',    Osoby[I].Utwory[2]); 
      Writeln('Utwor trzeci: ',   Osoby[I].Utwory[3]);
      Writeln('Utwor czwarty: ',  Osoby[I].Utwory[4]); 
      Writeln('Utwor piaty: ',    Osoby[I].Utwory[5]);
    end; 
  
{sortownie babelkowe} 
  for I := 1 to IloscOsob-1 do 
    begin 
      for J := IloscOsob downto I do
        begin 
  
          if Osoby[J - 1].Grupa > Osoby[J].grupa then 
            begin 
              ReplaceStrings(Osoby[J - 1].Imie,  Osoby[J].Imie); 
              ReplaceStrings(Osoby[J - 1].Plec,  Osoby[J].Plec);
  
              ReplaceIntegers(Osoby[J - 1].Wiek,  Osoby[J].Wiek); 
              ReplaceIntegers(Osoby[J - 1].Grupa, Osoby[j].Grupa); 
  
              for K := 1 to 5 do 
                ReplaceIntegers(Osoby[J - 1].Wybory[K], Osoby[J].Wybory[K]);
  
              for K := 1 to 5 do 
                ReplaceStrings(Osoby[J - 1].Utwory[K], Osoby[J].Utwory[K]); 
            end; 
  
        end;
      Writeln; 
    end; 
{koniec sortowania} 
 writeln; 
Writeln('Grupa ', Osoby[0].Grupa+1); 
writeln('-------------------------------------------------');
  
  AktualnaGrupa := Osoby[0].Grupa; 
  
  for I := 0 to High(Osoby)  do 
    begin 

      if AktualnaGrupa <> Osoby[i].Grupa then 
        begin 
          AktualnaGrupa := Osoby[i].Grupa; 
          writeln('---------------------------------------'); 
          writeln; 
          Writeln('Grupa ', Osoby[i].Grupa+1);
          writeln('---------------------------------------'); 
          Writeln; 
        end; 
      Writeln('Osoba : '); 
      Writeln('Imie: ',           Osoby[I].Imie);
      Writeln('Wiek: ',           Osoby[I].Wiek); 
      writeln('Plec: ',           Osoby[I].Plec); 
  
      writeln('Utwor Pierwszy: ', Osoby[I].utwory[1]); 
      writeln('Utwor Drugi: ',    Osoby[I].utwory[2]);
      writeln('Utwor trzec: ',    Osoby[I].utwory[3]); 
      writeln('Utwor czwarty: ',  Osoby[I].utwory[4]); 
      writeln('Utwor piaty: ',    Osoby[I].utwory[5]); 
      writeln; 

    end; 
  
  
    begin 
 for f := Low(Osoby) to High(Osoby) do
    for g := 1 to 5 do 
      begin 
        K := Osoby[f].Wybory[g]; 
        IloscGlosow[K] := IloscGlosow[K] + 1;
      end; 
  
  
    for t:=1 to 11 do
 writeln(Tytuly[t],' Ilosc glosow: ',IloscGlosow[t]);
 writeln 
  

end; 
  
begin
  
  for q := 1 to 3 do
    begin
      for w := 1 to 11 do
        if IloscGlosow[w] > Max[q].Glosy then
          begin
            Max[q].Glosy := IloscGlosow[w];
            IloscGlosow[w] := 0;
          end;
    end;

for I := 1 to 3 do
  Writeln(I, ' Utwór: ',Tytuly[I], '  Liczba Glosow: ', Max[I].Glosy);
end;
  writeln(max[1].glosy);
  writeln(max[3].glosy);
  writeln(max[2].glosy);

  for i:=1 to 11 do  begin
  if  Osoby[I].wybory[1] =  max[1].glosy then
  writeln(Osoby[I].Imie);
                          end;
{ TO -ODoUser -cConsole Main : Insert code here }
readln;
end.

1 użytkowników online, w tym zalogowanych: 0, gości: 1