Списки. Помогите пожалуйста

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Ответить
alexdog
Сообщения: 7
Зарегистрирован: 05 апр 2008, 21:38

Если кто может помочь с программой... помогите пожалуста... Я попытался сделать, но у меня ничего не вышло с проверкой равенства. Вот задача:

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

Списки. Составить процедуру, проверяющая на равенство значения элементов списков L1 и L2 и подсчитывающей количество
одинаковых элементов в них.Используя данную процедуру, проанализировать пары списков К1 и К2; М1 и М2. Списки 
заполнять данными из файла
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

Если вы произвели некоторый попытки решения данной задачи, предоставьте пожалуйста код. Вам помогут найти ошибки и исправить их.
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
alexdog
Сообщения: 7
Зарегистрирован: 05 апр 2008, 21:38

Вот что я смог только сделать.... Но я неуверен что правельно:

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

Program sd;
uses crt;
Type
  NameStr=string[20];
  Link=^Auto;
  Auto=record
      Name:nameStr;
      S1:integer;
      S2:integer;
      S3:integer;
      Next:Link;
  end;
var
  P,First:Link; q:^auto;
  NamFind:nameStr;
  V:0..4;
  EndMenu:boolean;
  f1,f2: file of Auto;

Procedure open1;
begin
 assign(f1,'c:\1.txt');
end;

Procedure open2;
begin
 assign(f2,'c:\2.txt');
end;


 Function FindName(FN:nameStr):Link;
   var
    Curr:Link;
   begin
     Curr:=First;
     while Curr<> nil do
      if Curr^.Name=FN then
        begin
          FindName:=Curr;
           exit;
         end else
         Curr:=Curr^.Next;
         FindName:=Nil;
        end;

Procedure AddFirst(A:Link);
Begin
 A^.next:=first;
 first:=a;
end;

procedure Delfirst(var a:link);
begin
 a:=first;
 first:=first^.next;
end;


procedure delAfter(Old:Link; var a:link);
begin
 A:=Old^.next;
 Old^.next:=old^.next^.next;
end;

procedure sa;
begin
with P^ do  begin
 p:=new(link);
 write('Ќ*§ў**ЁҐ');
 readln(P^.name);
 write('1 §**зҐ*ЁҐ: ');
 readln(P^.S1);
 write('2 §**зҐ*ЁҐ: ');
 readln(P^.S2);
 write('3 §**зҐ*ЁҐ: ');
 readln(P^.S3);
 addfirst(p);
end; end;

procedure InpAvto;
var z,d:byte;
begin
Writeln('ўўҐ¤ЁвҐ ў Є*Є®© Ё§ бЇЁбЄ®ў ўл е®вЁвҐ ¤®Ў*ўЁвм');
Writeln('1 - ЇҐаўл©(L1) 2 - ўв®а®©(L2)');
readln(d);
if d=1 then begin
open1;
reset(f1);
seek(f1,filesize(f1));
sa;
writeln('‘®еа**Ёвм?');
    readln(z);
      if z=1 then begin
       write(f1,P^);
      end;
 close(f1);
end;
{end;}

if d=2 then begin
open2;
reset(f2);
seek(f2,filesize(f2));
sa;
writeln('‘®еа**Ёвм?');
    readln(z);
      if z=1 then begin
       write(f2,P^);
      end;
 close(f2);
end;
end;

procedure dd;
var
 curr:link;
begin

   end;

procedure myList;
var
 curr:link; i,j:byte;
begin
i:=15;
j:=15;
open1;
  reset(f1);
 curr:=first;
 gotoxy(7,13);
 writeln('ЇҐаўл© (L1)');
  while not(eof(f1)) do begin
  read(f1,curr^);
  gotoxy(6,i);
  writeln(curr^.name);
  gotoxy(10,i);
  Write(curr^.S1);
  gotoxy(13,i);
  write(curr^.S2);
  gotoxy(16,i);
  write(curr^.S3);
   curr:=curr^.next;
   inc(i);
  end;
  open2;
  reset(f2);
 curr:=first;
  gotoxy(26,13);
 writeln('ўв®а®© (L2)');
  while not(eof(f2)) do begin
  read(f2,curr^);
  gotoxy(26,j);
  writeln(curr^.name);
  gotoxy(30,j);
  Write(curr^.S1);
  gotoxy(33,j);
  write(curr^.S2);
  gotoxy(36,j);
  write(curr^.S3);
   curr:=curr^.next;
   inc(j);
   curr:=curr^.next;
end;
  readln;
  end;
  begin
   new(p);
   endmenu:=false;
   repeat
    clrscr;
     writeln('“Є*¦ЁвҐ ўЁ¤ а*Ў®вл');
     writeln('1 - §*ЇЁбм ЇҐаўл¬ ў бЇЁб®Є');
     writeln('2 - г¤*«Ґ*ЁҐ ЇҐаў®Ј® ®ЎҐЄв* Ё§ бЇЁбЄ*');
     writeln('3 - Їа®б¬®ва ўбҐе бЇЁбЄ®ў');
     writeln('4 - г¤*«Ґ*ЁҐ ®ЎкҐЄв* б«Ґ¤го饣® ў бЇЁбЄҐ §* гЄ*§**л¬');
     writeln('0 - ЋЄ®*з**ЁҐ а*Ў®вл');
      readln(v);
        case v of
          1:inpAvto;
          2 :D elFirst(p);
          3:Mylist;
          4:begin
            write('ўўҐ¤ЁвҐ ¬*аЄг *ўв®¬*ЎЁ«п §* Є®в®ал¬ б«Ґ¤гҐв г¤*«пҐ¬л© Ё§ бЇЁб®Є*');
            readln(namfind);
            DelAfter(findname(NamFind),P);
           end;
         else
          endMenu:=true;
        end;
      until endMenu;
    dispose(p);
end.
Аватара пользователя
Игорь Акопян
Сообщения: 1440
Зарегистрирован: 13 окт 2004, 17:11
Откуда: СПБ
Контактная информация:

Перед копированием включите русский язык, тогда вставится всё нормально.
Изображение
Serge_Bliznykov
Сообщения: 375
Зарегистрирован: 31 авг 2007, 03:06

alexdog, я ОЧЕНЬ сильно сомневаюсь, что код, который Вы привели - Ваш.
Впрочем, если Вы действительно понимаете, как он работает, для Вас не составит труда вставить мою процедуру. если нет - используйте мою программу полностью.
Добавить ещё пару текстовых файлов и четыре-пять строчек код, надеюсь умений и знаний хватит? :)

Сделал решение скорее из жалости... И, наверное, всё же зря...
ну да ладно. вот, в архиве CMPLIST.zip, полное (ну почти полное) решение Вашей задачи (смотрите
procedure CompareLists( L1, L2 : TPointerMyRecordType; var CountMatch : integer);

p.s. нет удаления списков/очистки памяти - чисто лень ;-)
Вложения
CMPLIST.zip
(4.98 КБ) 25 скачиваний
Ответить