Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача на записи
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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
Цитата(nblazhko @ 23.12.2007 15:09) *

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

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

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

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

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



Нужно чтобы программа выводила фамилии людей с одни и тем же хобби,при том если есть пары людей с одним и тем же хобби то выводить обе пары тоесть допустим запись 1 и запись 2 с одинаковым хобби выводим их и запись 4 и 6 с одинаковым выводим и их
Lapp
Цитата(nblazhko @ 23.12.2007 15:55) *

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

Тогда все правильно, за исключением того, что второй цикл начинать с k+1 (первый, соответственно, вести до предпоследней записи). Это исключит тебе и двойной учет одной пары, и уберет "одинаковость" хобби человека с самим собой.
nblazhko
Цитата(Lapp @ 23.12.2007 15:59) *

Тогда все правильно, за исключением того, что второй цикл начинать с 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;

Исправил: внутренний цикл до конца!
nblazhko
Во тер норм,а как можно еще замутить чтобы оно просто вывело фамилии тех людей с одинаковым хобби?
Ozzя
  WriteLn('Одинаковые хобби у ',book[k].fio,' и ',book[i].fio);
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.