Developing.ru

Код: Выделить всё

const
  N=20; {макс. число элементов}
  MaxGN=N; {макс. количество групп}
  GN:integer=0; {кол-во групп}
type
  TR =array[1..N+1] of integer; {массив}
  TGroup = record {группа}
    pos:integer; {с какого элемента начинается группа}
    len:integer; {какой она длины}
    sum:longint; {ее сумма}
  end;
var
  R,R2: TR; {исходный и результир. массивы}
  G: array[1..MaxGN] of TGroup; {массив групп}
  Gi: TGroup; 
  i,j,k:integer;
  {заполнение массива сл. числами}
  procedure Init(var A:TR); 
  var
    i,EOG:integer;
  begin
    EOG:=random(N div 2)+1;
    for i:=1 to N do begin
      if i=EOG then begin
        A[i]:=0; EOG:=i+random(N div 2)+1;
      end else
        A[i]:=random(maxint)-maxint div 2;
    end;
    A[N+1]:=0;
  end;
  {вывод массива на экран}
  procedure Print(const A:TR; Header:string);
  var
    i:integer;
  begin
    writeln('*** ',Header,' ***');
    for i:= 1 to N do write(A[i],'; ');
    writeln;
  end;
  {упорядоченное добавление описания группы}
  procedure AddGroup(Grp:TGroup);
  var i:integer; B:TGroup;
  begin
    inc(GN);
    if GN=1 then begin
      G[GN]:=Grp;
    end else begin
      for i:=1 to GN do begin
        if G[i].sum>Grp.sum then begin
          B:=G[i];
          G[i]:=Grp;
          Grp:=B;
        end else if i=GN then G[i]:=Grp;
      end;
    end;
  end;



begin
  randomize;
  Init(R);
  Print(R,'Before sorting');
  {сканируем группы}
  Gi.pos:=1; Gi.Sum:=0; Gi.Len:=0;
  for i:=1 to N+1 do begin
    {накапливаем сумму и считаем длину группы}
    inc(Gi.len);
    inc(Gi.sum, R[i]);
    if R[i]=0 then begin {если обнаружен конец группы, то
    добавляем группу в массив, и начинаем новую группу}
      AddGroup(Gi);
      Gi.pos:=i+1; Gi.Sum:=0; Gi.Len:=0;
    end;
  end;

  {формируем новый массив, руководствуясь 
  упорядоченным списком групп}
  k:=0;
  for i:=1 to GN do for j:=1 to G[i].len do begin
    inc(k);
    R2[k]:=R[G[i].pos+j-1];
  end;

  {вывод результата}
  Print(R2,'After sorting');
  readln;
end.

Код: Выделить всё

const
  N = 5;
  M = 20;
type
  TArr = array[1..N,1..M] of integer;
var
  A:TArr;
  B:TArr;
  C:array[1..N] of integer;
  i,j:integer;
  {процедура вывода массива на экран}
  procedure PrintArr(X:TArr; width:byte; Header:string);
  var i,j:integer;
  begin
    writeln;
    write('*** ',Header,' ***');
    for i:=1 to N do begin
      writeln; write('House',i:4,' ');
      for j:=1 to M do write(X[i,j]:width);
    end;
    writeln;
  end;
  {процедура заполнения массива}
  procedure FillArr(var X:TArr; min,max:integer);
  var i,j:integer;
  begin
    for i:=1 to N do for j:=1 to M do X[i,j]:=min+random(max-min+1);
  end;
begin
  randomize;
  FillArr(A,20,70); {квартиры от 20 до 70 м.кв.}
  FillArr(B,1,5);     {от 1 до 5 человек на квартиру}
  PrintArr(A,3,'Square of flats');
  PrintArr(B,2,'Persons per flat');

  for i:=1 to N do begin
    C[i]:=0;
    for j:=1 to M do if A[i,j]/B[i,j]<7 then inc(C[i]);
  end;
  writeln;
  writeln('Number of flats where the square is less 7sq.m per person:');
  for i:=1 to N do begin
    writeln('House',i:4,' - ',C[i],' flat(s)');
  end;

  readln;
end.