Упорядочить по фамилиям

[virginia]

Упорядочить по фамилиям

program Project2;

const
    n=2;
type
      telem=record
      fam:string[30];
      markaavto:string[30];
      nomer:string[10];
      adres:string[50]
end;
tmas=array [1..n] of telem;
//-------------------------------------------------------------------
procedure vvoddannuh(var a:tmas); //ввод данных
var i:Integer;
    b:telem;
begin
  for i:=1 to n do
  begin
    Writeln('введи фамилию');
    Readln(b.fam);
    Writeln('введи марку автомобиля');
    Readln(b.markaavto);
    Writeln('введи номер');
    Readln(b.nomer);
    Writeln('введи адрес');
    Readln(b.adres)
  end
end;
Procedure vuvoddannuh(var a:tmas);
var i:Integer;
    b:array[1..n] of telem;
begin
   for i:=1 to n do
   begin
   writeln ('--------------------------------------------------------------------------');
   writeln ('фамилия    / марка автомобиля       / номер           / адрес             ');
   writeln ('--------------------------------------------------------------------------');
   writeln(b[i].fam:15,' ',b[i].markaavto:15,' ',b[i].nomer:15,' ',b[i].adres);
   readln
   end
end;
var
  a:tmas;
begin
  vvoddannuh(a);
  vuvoddannuh(a);

end.

помогите написать процедуру упорядочения массива по фамилиям

 

[Vladimir_S]

помогите написать процедуру упорядочения массива по фамилиям

Написал. Заодно исправил кучу ошибок:

1. В полях записи не нужно задавать формат строк: при выводе поля nomer это приводит к ошибке, поскольку там формат вывода (15) превышает длину строки (10) и номер просто не отображается.

2. В процедуре vvoddannuh не установлена связь между внутренним параметром b и элементом массива a. Я предлагаю вообще обойтись без этого b - он не нужен. То же относится и к процедуре vuvoddannuh.

3. В процедуре vuvoddannuh массив a является входным параметром, а потому ставить перед ним var недопустимо.

4. Поправлена строка-заголовок таблицы. Тут, в принципе, следовало бы еще поработать. Ну это уж Вы сами.

Упорядочение я оформил в виде процедуры Ordering без параметров, поскольку идет обработка глобального массива. Но чтобы не возникало ошибки, раздел описания глобальных переменных пришлось переместить в начало, перед процедурами. Между прочим, именовать глобальные переменные и параметры процедур одинаково (в данном случае речь о массиве a) хоть и допустимо, но крайне нежелательно. Поэтому глобальный я обозвал owners (владельцы). Впрочем, это можете переделать на свой вкус.
Итого:

const
    n=5;
type
      telem=record
      fam:string;
      markaavto:string;
      nomer:string;
      adres:string
end;
tmas=array [1..n] of telem;

var
  owners:tmas;

//-------------------------------------------------------------------
procedure vvoddannuh(var a:tmas); //ввод данных
var i:Integer;
begin
  for i:=1 to n do
  begin
    Writeln('введи фамилию');
    Readln(a[i].fam);
    Writeln('введи марку автомобиля');
    Readln(a[i].markaavto);
    Writeln('введи номер');
    Readln(a[i].nomer);
    Writeln('введи адрес');
    Readln(a[i].adres);
    writeln;
  end
end;

Procedure vuvoddannuh(a:tmas);
var i:Integer;
begin
   for i:=1 to n do
   begin
   writeln ('--------------------------------------------------------------------------');
   writeln ('    фамилия    / марка автомобиля       / номер           / адрес             ');
   writeln ('--------------------------------------------------------------------------');
   writeln(a[i].fam:15,' ',a[i].markaavto:15,' ',a[i].nomer:15,' ',a[i].adres);
   end
end;

Procedure ordering;
var
 Dummy:telem;
 i,j:Integer;
begin
 for i:=1 to n do
  for j:=1 to n-i do
   if Ord(owners[j].fam[1])>Ord(owners[j+1].fam[1]) then
    begin
     Dummy:=owners[j];
     owners[j]:=owners[j+1];
     owners[j+1]:=Dummy;
    end
end;

begin
  vvoddannuh(owners);
  writeln;
  vuvoddannuh(owners);
  writeln('Press "Enter" to continue...');
  readln;
  writeln;
  writeln('Ordered:');
  ordering;
  vuvoddannuh(owners);
  readln
end.

 

[virginia]

спасибо.

function poisk(a:tmas):string;
var i,j:Integer;
    k:string;
begin
   for i:=1 to n-1 do
   for j:=i+1 to n do
   if (owners[i].fam=owners[j].fam)and(owners[i].adres=owners[j].adres) then k:=owners[i].fam
                                                                else k:='таких нет';
   poisk:=k;
end;

не поможете еще доработать эту функцию?нужно вывести фамилии автовладельцев,имеющих более одной машины

 

[Vladimir_S]

не поможете еще доработать эту функцию?нужно вывести фамилии автовладельцев,имеющих более одной машины

Сейчас попробую. Но тут исключить повторы не так просто.

 

[Vladimir_S]

Ну вот что получилось. Заодно исправил процедуру вывода: как-то не обратил внимание, что шапка таблицы была внутрь цикла загнана. Вовсе ни к чему.

const
    n=5;
type
      telem=record
      fam:string;
      markaavto:string;
      nomer:string;
      adres:string
end;
tmas=array [1..n] of telem;

var
  owners:tmas;

//-------------------------------------------------------------------
procedure vvoddannuh(var a:tmas); //ввод данных
var i:Integer;
begin
  for i:=1 to n do
  begin
    Writeln('введи фамилию');
    Readln(a[i].fam);
    Writeln('введи марку автомобиля');
    Readln(a[i].markaavto);
    Writeln('введи номер');
    Readln(a[i].nomer);
    Writeln('введи адрес');
    Readln(a[i].adres);
    writeln;
  end
end;

Procedure vuvoddannuh(a:tmas);
var i:Integer;
begin
   writeln ('--------------------------------------------------------------------------');
   writeln ('    фамилия    / марка автомобиля       / номер           / адрес             ');
   writeln ('--------------------------------------------------------------------------');
   for i:=1 to n do
    writeln(a[i].fam:15,' ',a[i].markaavto:15,' ',a[i].nomer:15,' ',a[i].adres);
end;

Procedure ordering;
var
 Dummy:telem;
 i,j:Integer;
begin
 for i:=1 to n do
  for j:=1 to n-i do
   if Ord(owners[j].fam[1])>Ord(owners[j+1].fam[1]) then
    begin
     Dummy:=owners[j];
     owners[j]:=owners[j+1];
     owners[j+1]:=Dummy;
    end
end;

Procedure vuvod_multi(a:tmas);
var
 i,j,r:Integer;
 P:Set of Byte;
begin
   r:=0;
   P:=[];
   for i:=1 to n-1 do
    for j:=i[COLOR=Red][B]+1[/B][/COLOR] to n do
     if (a[j].fam=a[i].fam) and (a[i].adres=a[j].adres) then
      begin
       if Not(i in P) then writeln(a[i].fam);
       if Not(j in P) then P:=P+[j];
       Inc(r);
      end;
   if r=0 then writeln('No such owners');
end;

begin
  vvoddannuh(owners);
  writeln;
  vuvoddannuh(owners);
  writeln('Press "Enter" to continue...');
  readln;
  writeln;
  writeln('Ordered:');
  ordering;
  vuvoddannuh(owners);
  writeln('Press "Enter" to continue...');
  readln;
  writeln;
  writeln('2 and more car owners:');
  vuvod_multi(owners);
  readln
end.

 

[virginia]

процедура выводит все фамилии((((

 

[Vladimir_S]

процедура выводит все фамилии((((

Виноват, каюсь, посыпаю голову пеплом, смиренно прошу прощения: ошибочка таки да, проскочила. Исправил в исходном тексте (выделено красным). И ведь тестировал же - ан вот пропустил. :tehnari_ru_1019:

 

[virginia]

спасибо огромное