Задача на записи, Почти доделал но одну вещь незнаю как сделать Опции

[nblazhko]

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

Критерий шахматы это нужно подсчитать сколько людей с одинаковым хобби


Вот код:

Program Adress_Book;
uses
Crt;
type
    Adressitem = record
    Fio: String;
    Hob: String;
    Phone: LongInt;
    Email: String;
end;


var
   Book: Array [1..10] of Adressitem;
   hobbusovp:array[1..10] of string;
   Nums, I,Oh,k,mk: Byte;
   Code: Integer;
   ind:LongInt;
   C: Char;
   Quit: Boolean;
   StrNum,IntToStr:string;
   Phone1,Ph:LongInt;

Function Search(TelNum:LongInt):integer;
Var
 i:Integer;
 StrNum:String;
Begin
 Search:=-1;
 StrNum:=IntToStr;
 For i:=1 to 10 do
Begin
 If Book[i].Phone=Phone1 Then
  Begin
   Search:=i;
   Break;
  end;
 end;
end;




Procedure New_Item;
var
   F, A, Em: String;
   Ph: LongInt;
   begin
   ClrScr;
   Inc(Nums);
if Nums > 10 then
begin
     Write('MAx kol-vj zapisey!');
     exit;
end;

Writeln('Zapis N', Nums); Writeln;
Write('Vvedite FIO: ');
Readln(F);
Write('Vvedite Xobbu: ');
Readln(A);
Write('Vvedite telefon: ');
Readln(Ph);
Writeln;
with Book[Nums] do
begin
     Fio := F;
     Hob := A;
     Phone := Ph;
end;
Write('NEW Zapis dobavlena');
end;



Procedure List_Item(N: Byte);
begin
     if N > Nums then
     begin
          Write('Nevernui nomer');
          exit;
     end;

With Book[N] do
begin
     Writeln('Zapis N', N); Writeln;
     Writeln('FIO: ', Fio);
     Writeln('Hobbu: ', Hob);
     Writeln('Telefon: ', Phone);
     Writeln;
end;
Readln;
end;

begin
     Quit := False;
     Nums := 0;
     for I:=1 to 10 do book[i].phone:=0;
     repeat
ClrScr;
       Writeln('Telefonnau kniga"');
       Writeln('==========================='); Writeln;
       Writeln('Zapisu: ');
       Writeln('--------------------');
       if Nums = 0 then Writeln('Zapisey net') else
       For I := 1 to Nums do
       Writeln(I, ' - FIO: ', Book[I].Fio);
       Writeln('--------------------'); Writeln; Writeln;
       Writeln('''a'' - Dobavit zapis');
       WriteLn ('''b'' - Poisk zapisu');
       WriteLn ('''h'' - Sovpadeniya');
       Writeln('Nomer - pokazat zapis');
       Writeln('Esc - Exit');



       Writeln;
       Write('Vash vibor: ');
       C := ReadKey;
       case C of
       '1'..'9': begin
       Val(C, I, Code);
       List_Item(I);
end;
'a': New_Item;
'h': begin
If Nums<=0 then begin
 writeln('Zapisey net'); readln; end
  else
begin
     Oh:=0;
     for k:=1 to Nums do begin
     for i:=1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             mk:=i;
        end;

end;

if k<>mk then
begin
  Writeln('Odinakovuh hobbu:',Oh);
  Readln;
  Oh:=0;
end;
 end;
 end;
 end;

'b': begin
Write ('Vvedite tel.:  ');
ReadLn(Phone1);
Ph:=Search(Phone1);
If Ph <> -1 then
List_Item(Search(Phone1));
End;
#27: Quit := true;
end;
until Quit;

end.

И я не могу сделать чтоб она находила людей с одинаковым хобби

я попробывал использовать вот такую конструкцию:

 begin
If Nums<=0 then begin
 writeln('Zapisey net'); readln; end
  else
begin
     Oh:=0;
     for k:=1 to Nums do begin
     for i:=1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             mk:=i;
        end;

end;

if k<>mk then
begin
  Writeln('Odinakovuh hobbu:',Oh);
  Readln;
  Oh:=0;
end;
 end;
 end;
 end;

[Lapp]

И я не могу сделать чтоб она находила людей с одинаковым хобби

Что значит "с одинаковым хобби"? Не значит ли это, что нужно сначала выбрать, какое хобби тебя интересует, а потом уже искать (то есть сравнивать поле именно с этим хобби, а не поля между собой)? То есть делаешь одинарный цикл и в нем выборку по условию хобби=шахматы (например).

То, что ты сделал, во-первых даст тебе, скорее всего, просто всех людей (кроме нескольких, имеющих уникальные хобби). Во-вторых, они войдут в сумму дважды (то есть желательно делить пополам, либо второй цикл проводить от i:=k+1.

[nblazhko]

Что значит "с одинаковым хобби"? Не значит ли это, что нужно сначала выбрать, какое хобби тебя интересует, а потом уже искать (то есть сравнивать поле именно с этим хобби, а не поля между собой)? То есть делаешь одинарный цикл и в нем выборку по условию хобби=шахматы (например).

То, что ты сделал, во-первых даст тебе, скорее всего, просто всех людей (кроме нескольких, имеющих уникальные хобби). Во-вторых, они войдут в сумму дважды (то есть желательно делить пополам, либо второй цикл проводить от i:=k+1.

Нужно чтобы программа выводила фамилии людей с одни и тем же хобби,при том если есть пары людей с одним и тем же хобби то выводить обе пары тоесть допустим запись 1 и запись 2 с одинаковым хобби выводим их и запись 4 и 6 с одинаковым выводим и их

[Lapp]

Нужно чтобы программа выводила фамилии людей с одни и тем же хобби,при том если есть пары людей с одним и тем же хобби то выводить обе пары тоесть допустим запись 1 и запись 2 с одинаковым хобби выводим их и запись 4 и 6 с одинаковым выводим и их

Тогда все правильно, за исключением того, что второй цикл начинать с k+1 (первый, соответственно, вести до предпоследней записи). Это исключит тебе и двойной учет одной пары, и уберет "одинаковость" хобби человека с самим собой.

[nblazhko]

Тогда все правильно, за исключением того, что второй цикл начинать с k+1 (первый, соответственно, вести до предпоследней записи). Это исключит тебе и двойной учет одной пары, и уберет "одинаковость" хобби человека с самим собой.

Тоесть нужно чтоб было так:

begin
             k:=k+1;
             oh:=oh+1;
             mk:=i;

Добавлено через 15 мин.
я сделал так:

If Nums<=0 then begin
 writeln('Zapisey net'); readln; end
  else
begin
     Oh:=0;
     for k:=1 to Nums-1 do begin
     for i:=1 to Nums-1 do begin
     if book[k].hob=book[i].Hob then
        begin
			 k:=k+1;
             oh:=oh+1;
             mk:=i;
        end;

end;

if k<>mk then
begin
  Writeln('Odinakovuh hobbu:',Oh);
  Readln;
  Oh:=0;
end;
 end;
 end;
 end;

Оно считает но зацикливается сначала выдает правельное значение потом ноль ноль ноль и до бесконечности

[Lapp]

Нет... Вот так:

     Oh:=0;
     for k:=1 to Nums-1 do begin
     for i:=k+1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             mk:=i;
        end;

Я, правда, совсем не понял, что такое mk..
Печать пары можно вставить прямо сюда, в цикл:

     Oh:=0;
     for k:=1 to Nums-1 do begin
     for i:=k+1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             WriteLn('Одинаковые хобби у ',k,' и ',i);
             mk:=i;
        end;

Исправил: внутренний цикл до конца!

Сообщение отредактировано: Lapp - 23.12.2007 16:28

[nblazhko]

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

[Ozzя]

  WriteLn('Одинаковые хобби у ',book[k].fio,' и ',book[i].fio);