Паскаль. Записи

[zena]

Паскаль. Записи

Помогите написать программу на турбопаскале с использованием записей.

В магазине имеется список лиц, записавшихся на покупку мебельного гарнитура. Каждая запись этого списка содержит порядковый номер, фамилию, домашний адрес покупателя и дату постановки на учет. Предполагается, что список упорядочен в порядке возрастания даты постановки на учет. Требуется удалить в нем все повторные записи, проверку осуществлять по фамилии и домашнему адресу.

У меня получилось только реализовать ввод данных, а с проверкой одни муки...

program uydg;
uses crt;
type
    zap=record
    Nomer:integer;
    Fam :string[5];
    adr:string[15];
    data:string[10];
end;
var
 rec:zap;
 cena:string;
 q,i,n,z,t,k,d:integer;
 a:array[1..45] of zap;
 
begin
clrscr;
writeln('Введите количество записей: ');
readln(n);
for i:=1 to n do
with a[i] do
begin
write(' Порядковый номер покупателя: ' , I,': ');
  readln(a[i].Nomer);
write('Фамилия покупателя:',fam,': ');
  readln(a[i].Fam);
write('Адрес покупателя: ' , I,': ');
  readln(a[i].adr);
write('Дата постановки на учёт: ',I,': ');
  readln(a[i].data);
end;
 
 
 
begin
writeln('',a[i].adr,' ',a[i].Nomer,'  ',a[i].data,'   ',a[i].Fam,'');
end;
readln;
end.

 

[Vladimir_S]

Ну, что нибудь в таком роде (еще ввести j:Integer):

i:=1;
Repeat
 d:=0;
 for j:=i+1 to n do
  if (a[i].fam=a[j].fam) and (a[i].adr=a[j].adr) then
   begin
    for k:=j+1 to n do
     a[k-1]:=a[k];
     Inc(d);
    end;
   end;
 Dec(n,d);
 Inc(i);
Until i>=n;

Извините, не проверял. Попробуйте.

 

[zena]

Ну, что нибудь в таком роде (еще ввести j:Integer):

i:=1;
Repeat
 d:=0;
 for j:=i+1 to n do
  if (a[i].fam=a[j].fam) and (a[i].adr=a[j].adr) then
   begin
    for k:=j+1 to n do
     a[k-1]:=a[k];
     Inc(d);
    end;
   end;
 Dec(n,d);
 Inc(i);
Until i>=n;

Извините, не проверял. Попробуйте.

Спасибо, всё работает.

 

[Vladimir_S]

Спасибо, всё работает.

Ох - ну конечно, напортачил! Там end один лишний. Поправьте, пожалуйста.
Надо так:

i:=1; 
Repeat  
 d:=0;  
 for j:=i+1 to n do   
  if (a[i].fam=a[j].fam) and (a[i].adr=a[j].adr) then    
   begin     
    for k:=j+1 to n do      
     a[k-1]:=a[k];      
    Inc(d);     
   end;    
 Dec(n,d);  
 Inc(i); 
Until i>=n;

 

[zena]

Ну я это сразу заметила:tehnari_ru_942:

 

[zena]

Тут возникла такая проблемка: если ввести, например 3, разные записи, то выводится только одна. А если ввести 3 записи, две из которых одинаковые, то они обе удаляются(а нужно чтобы удалялась только одна запись).
Не подскажете как это можно подправить?

 

[Vladimir_S]

Тут возникла такая проблемка: если ввести, например 3, разные записи, то выводится только одна. А если ввести 3 записи, две из которых одинаковые, то они обе удаляются(а нужно чтобы удалялась только одна запись).
Не подскажете как это можно подправить?

Видимо, Вы как-то не так состыковали. В общем, отладил. Вот:

uses crt;
type
    zap=record
    Nomer:integer;
    Fam :string[5];
    adr:string[15];
    data:string[10];
end;
var
 rec:zap;
 cena:string;
 q,i,j,n,k,d:integer;
 a:array[1..45] of zap;

BEGIN
 clrscr;
 writeln('Введите количество записей: ');
 readln(n);
 for i:=1 to n do
  with a[i] do
   begin
    write('Порядковый номер покупателя: ');
    readln(a[i].Nomer);
    write('Фамилия покупателя: ');
    readln(a[i].Fam);
    write('Адрес покупателя: ');
    readln(a[i].adr);
    write('Дата постановки на учет: ');
    readln(a[i].data);
    writeln;
   end;


 for i:=1 to n do
  writeln(a[i].Nomer:2,'  ',a[i].Fam,'  ',a[i].adr,'  ',a[i].data);

 writeln;

 i:=1;
 Repeat
  d:=0;
  for j:=i+1 to n do
   if (a[i].fam=a[j].fam) and (a[i].adr=a[j].adr) then
    begin
     if j<n then
      for k:=j+1 to n do a[k-1]:=a[k];
     Inc(d);
    end;
  Dec(n,d);
  Inc(i);
 Until i>=n;

 for i:=1 to n do
  writeln(a[i].Nomer:2,'  ',a[i].Fam,'  ',a[i].adr,'  ',a[i].data);
 readln;
end.

У меня работает безупречно.

 

[zena]

for i:=1 to n do
writeln(a.Nomer:2,' ',a.Fam,' ',a.adr,' ',a.data);

Кажется просто этой строки не хватило.