Нахождение одинаковых строк в двух файлах и вывод результата в третий файл

@Messa · Регистрация: 19.03.2011

Author24 — интернет-сервис помощи студентам

Помогите пожалуйста.
Есть два тестовых файла, которые содержат строки (файлы большие, по 60k строк в каждом).
Задача сравнить эти два этих файла и найти одинаковые строки и вывести эти строки в третий файл, который программа будет создавать.
Структура файла такова, что все строки имеют фиксированную длину (41 символ).
Пример:

Кликните здесь для просмотра всего текста

"h0001d8b9g13d6g4605g85e9g708fe1e537c8"_
"h000310b1gc6f0g4341gbbddgf1f5fc471eae"_

В конце программы нужно вывести на экран количество одинаковых строк, которые были найдены программой, иначе написать "Не найдено"

Что у меня получилось:

Pascal

program pr3;
 
var
  str,ste:String;
  fr,fe,fd:Text;
  n,q1,q2,l:word;
begin
 
   Assign(fe,'D:\eng_pure.txt');
   Assign(fr,'D:\rus_pure.txt');
   Assign(fd,'D:\delta.txt');
   rewrite(fd);
   reset(fe);
   reset(fr);
   n:=0;
   q1:=1;
   q2:=1;
   l:=1;
    For q1:=1 to 65000 do begin
     ReadLn(fe,ste);
 
     For q2:=1 to 16200 do begin
      ReadLn(fr,str);
 
      for l:=1 to 41 do
       if ste[l]=str[l] then
         begin
          writeln(fd, ste);
         end;
 
    end;
    end;
 If n>0 then
  Writeln('naydeno ', n, ' sovpadeniy');
 else 
  Writeln('Sovpadeniy ne naydeno');
readln
end.

Перебор q1 и q2 сейчас сделан по фактическому количеству строк в тестовых файлах, в идеале нужен EOF, но с ним программа вообще отказывалась запускаться.

Подскажите пожалуйста, где я ошибся?

Добавлено через 17 минут
Если что самый похожий вариант
Переписать в третий файл только те строчки, которые есть и в первом, и во втором файлах.
уже был испробован - в файл результата не выводится ни одной строки.

@bormant · 25.09.2016, 13:25

Сообщение от Messa

где я ошибся?

А покажите-ка сначала результат выполнения вот такой простой программки:

Pascal

const d: array [0..$F] of Char = '0123456789ABCDEF';
var s: String; i: Integer;
begin
  Assign(input,'D:\eng_pure.txt'); Reset(input);
  ReadLn(s); Close(input); WriteLn(Length(s));
  for i:=1 to Length(s) do Write(' ',d[Ord(s[i]) shr 4],d[Ord(s[i]) and $F]); WriteLn;
  Assign(input,'D:\rus_pure.txt'); Reset(input);
  ReadLn(s); Close(input); WriteLn(Length(s));
  for i:=1 to Length(s) do Write(' ',d[Ord(s[i]) shr 4],d[Ord(s[i]) and $F]); WriteLn;
end.

Добавлено через 10 минут
Кроме того, приведенные вами выше строки имеют длину 40 символов, а не 41.

Не хотите переместиться с задачей в раздел Free Pascal, там нет смешных ограничений "640 КБ хватит всем".

Добавлено через 18 минут
PS. Если бы нужно было решение задачи безотносительно языка, то в Linux было бы достаточно выполнить

Bash

1	comm -12 <(sort eng_pure.txt) <(sort rus_pure.txt) > delta.txt

@Messa · 25.09.2016, 17:49 **[ТС]**

Сообщение от bormant

результат выполнения вот такой простой программки:

Кликните здесь для просмотра всего текста

Код

40
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F
41
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F 20
Ошибка выполнения 104 по адресу 0000:0270.
40
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F
41
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F 20
40
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F
41
 22 68 30 30 30 31 64 38 62 39 67 31 33 64 36 67 34 36 30 35 67 38 35 65 39 67 3
7 30 38 66 65 31 65 35 33 37 63 38 22 5F 20

Сообщение от bormant

е хотите переместиться с задачей в раздел Free Pascal, там нет смешных ограничений "640 КБ хватит всем".

если это поможет с решением, то несомненно

ФедосеевПавел · 25.09.2016, 18:30

Во FreePascal можно использовать больше памяти (в разумных пределах 2ГБ для Win32 = "2 ГБайта хватит всем"

) и применить тип (класс) TStringList со свойством сортировки и удаления дубликатов. Тогда задача сводится к подсчёту (=выводу) одинаковых элементов (=строк) в двух упорядоченных массивах (=файлах).

Почти похожим методом можно воспользоваться и в TurboPascal - правда, я никогда не задумывался о способах использования памяти сверх 1 МБайта под DOS одноимённым объектом TStringList.

@bormant · 26.09.2016, 14:51

Messa,
теперь внимательно смотрим на вывод:

Код

40
... 22 5F
41
... 22 5F 20

и видим, что во втором файле строки действительно строго не равны строкам в первом -- в rus_pure.txt они длиннее на 1 символ (41 против 40), хоть и пробельный.

Выход простой -- после чтения строки обрезать пробелы с хвоста:

Pascal

1	while s[Length(s)] in [#9,' '] do Delete(s,Length(s),1);

Тогда медленный вариант будет выглядеть так:

Pascal

var
  f, g, h: Text;
  s, st: String;
  b: Boolean;
  n: Longint;
begin
  Assign(f,'D:\eng_pure.txt'); Assign(g,'D:\rus_pure.txt'); Assign(h,'D:\delta.txt');
  Reset(f); Rewrite(h);
  while not Eof(f) do begin
    ReadLn(f,s);
    while s[Length(s)] in [#9,' '] do Delete(s,Length(s),1);
    Reset(g); b:=False;
    while not EoF(g) and not b do begin
      ReadLn(g,st);
      while s[Length(st)] in [#9,' '] do Delete(st,Length(st),1);
      b:=st=s;
    end;
    if b then begin
      Inc(n); WriteLn(h,s);
    end;
  end;
  Close(g); Close(f); Close(h);
  if n>0
  then WriteLn('Найдено ',n,' совпадений')
  else WriteLn('Совпадений не найдено');
end.

Добавлено через 9 часов 5 минут
Но можно использовать "военную хитрость" -- поручить усекновение строки компилятору и получить необходимое "безвозмездно, то есть даром":

Pascal

var
  f, g, h: Text;
  s, st: String[40];
  b: Boolean;
  n: Longint;
begin
  Assign(f,'D:\eng_pure.txt'); Assign(g,'D:\rus_pure.txt'); Assign(h,'D:\delta.txt');
  Reset(f); Rewrite(h);
  while not Eof(f) do begin
    ReadLn(f,s);
    Reset(g); b:=False;
    while not EoF(g) and not b do begin
      ReadLn(g,st);
      b:=st=s;
    end;
    if b then begin
      Inc(n); WriteLn(h,s);
    end;
  end;
  Close(g); Close(f); Close(h);
  if n>0
  then WriteLn('Найдено ',n,' совпадений')
  else WriteLn('Совпадений не найдено');
end.

Добавлено через 51 минуту
Улучшенная версия с использованием буфера на 1598 строк (больше не поместится в одном сегменте) и двоичным поиском в нем:

Pascal

type
  String40 = String[40];
  PBuf = ^TBuf;
  TBuf = array [0..$FFFE div SizeOf(String40)-1] of String40;
var
  f, g, h: Text;
  s: String40;
  n: Longint;
  p: PBuf;
  pn, j, l, r, m: Integer;
begin
  Assign(f,'eng_pure.txt'); Assign(g,'rus_pure.txt'); Assign(h,'delta.txt');
  Reset(f); Rewrite(h); New(p);
  while not Eof(f) do begin
    { наполняем буфер, используя сортировку вставками и двоичный поиск }
    ReadLn(f,p^[0]); pn:=1;
    while (pn<=High(p^)) and not EoF(f) do begin
      ReadLn(f,s); l:=0; r:=pn;
      while l<r do begin
        m:=l+(r-l) div 2; if p^[m]<=s then l:=m+1 else r:=m;
      end;
      if (r=0) or (p^[r-1]<>s) then begin
        for j:=pn downto r+1 do p^[j]:=p^[j-1];
        p^[r]:=s; Inc(pn);
      end;
    end;
    Reset(g);
    while not EoF(g) do begin { двоичный поиск строки в буфере }
      ReadLn(g,s); l:=0; r:=pn-1;
      while l<r do begin
        m:=l+(r-l) div 2; if p^[m]<s then l:=m+1 else r:=m;
      end;
      if p^[r]=s then begin
        Inc(n); WriteLn(h,s);
      end;
    end;
  end;
  Close(g); Close(f); Close(h);
  Dispose(p);
  if n>0
  then WriteLn('Найдено ',n,' совпадений')
  else WriteLn('Совпадений не найдено');
end.

Обычно можно выделить порядка 19 подобных буферов, поэтому следующей оптимизацией может быть такой многосегментный буфер, в зависимости от MemAvail и MaxAvail.

Также может быть оптимизацией использование для сортировки массива указателей на строки вместо самих строк. Здесь накладные расходы по памяти составят почти 10% (4 байта на указатель / 41 байт на строку).

Добавлено через 42 минуты
С текущими ограничениями алгоритмически проще всего подложить под p 10 буферов:

Pascal

type
  PString40 = ^String40;
  String40 = String[40];
const
  BufSize = $FFFE div SizeOf(String40);
  BufCount = 10;
type
  PBuf = ^TBuf;
  TBuf = array [0..BufSize-1] of String40;
 
function HeapFunc(Size: Word): Integer; far; assembler; asm mov al,1 end;
 
var
  f, g, h: Text;
  s: String40;
  n: Longint;
  b: array [0..BufCount-1] of PBuf;
  p: array [0..BufCount*BufSize-1] of PString40;
  t: PString40;
  pn, pm, j, l, r, m: Integer;
begin
  HeapError:=@HeapFunc;
  for j:=0 to BufCount-1 do begin
    New(b[j]); if b[j]<>nil then Inc(pm) else Break;
  end; pm:=pm*BufSize-1;
  Assign(f,'eng_pure.txt'); Assign(g,'rus_pure.txt'); Assign(h,'delta.txt');
  Reset(f); Rewrite(h);
  while not Eof(f) do begin
    for j:=0 to pm do p[j]:=@(b[j div BufSize]^[j mod BufSize]);
    { наполняем буфер, используя сортировку вставками и двоичный поиск }
    ReadLn(f,p[0]^); pn:=1;
    while (pn<=pm) and not EoF(f) do begin
      t:=p[pn]; ReadLn(f,t^); l:=0; r:=pn;
      while l<r do begin
        m:=l+(r-l) div 2; if p[m]^<=t^ then l:=m+1 else r:=m;
      end;
      if (r=0) or (p[r-1]^<>t^) then begin
        for j:=pn downto r+1 do p[j]:=p[j-1];
        p[r]:=t; Inc(pn);
      end;
    end;
    Reset(g);
    while not EoF(g) do begin
      ReadLn(g,s); l:=0; r:=pn-1; { двоичный поиск строки в буфере }
      while l<r do begin
        m:=l+(r-l) div 2; if p[m]^<s then l:=m+1 else r:=m;
      end;
      if p[r]^=s then begin
        Inc(n); WriteLn(h,s);
      end;
    end;
  end;
  Close(g); Close(f); Close(h);
  for j:=0 to BufCount-1 do if b[j]<>nil then Dispose(b[j]) else Break;
  if n>0
  then WriteLn('Найдено ',n,' совпадений')
  else WriteLn('Совпадений не найдено');
end.

Добавлено через 8 минут
Вероятно, есть смысл увеличить файловые буферы:

Pascal

var
  bf, bg, bh: array [0..1024*4-1] of Char;
{...}
  Assign(f,'eng_pure.txt'); SetTextBuf(f,bf);
  Assign(g,'rus_pure.txt'); SetTextBuf(f,bg);
  Assign(h,'delta.txt');    SetTextBuf(f,bh);
{...}

Добавлено через 1 час 12 минут
Итого:

Pascal

type
  PString40 = ^String40;
  String40 = String[40];
const
  BufSize = $FFFE div SizeOf(String40);
  BufCount = 10;
  BufSizeF = 1024*4;
type
  PBuf = ^TBuf;
  TBuf = array [0..BufSize-1] of String40;
 
function HeapFunc(Size: Word): Integer; far; assembler; asm mov al,1 end;
 
var
  f, g, h: Text;
  s: String40;
  n: Longint;
  b: array [0..BufCount-1] of PBuf;
  p: array [0..BufCount*BufSize-1] of PString40;
  t: PString40;
  pn, pm, j, l, r, m, k: Integer;
  bf, bg, bh: PChar;
begin
  HeapError:=@HeapFunc; {ReturnNilIfGrowHeapFails:=True;}
  for j:=0 to BufCount-1 do begin
    New(b[j]); if b[j]<>nil then Inc(pm) else Break;
  end; pm:=pm*BufSize-1;
  Assign(f,'eng_pure.txt'); Assign(g,'rus_pure.txt'); Assign(h,'delta.txt');
  GetMem(bh,BufSizeF); if bh<>nil then SetTextBuf(h,bh^,BufSizeF);
  GetMem(bg,BufSizeF); if bg<>nil then SetTextBuf(g,bg^,BufSizeF);
  GetMem(bf,BufSizeF); if bf<>nil then SetTextBuf(f,bf^,BufSizeF);
  Reset(f); Rewrite(h);
  while not Eof(f) do begin
    Write('.');
    for j:=0 to pm do p[j]:=@(b[j div BufSize]^[j mod BufSize]);
    { наполняем буфер, используя сортировку вставками и двоичный поиск }
    ReadLn(f,p[0]^); pn:=1;
    while (pn<=pm) and not EoF(f) do begin
      t:=p[pn]; ReadLn(f,t^); l:=0; r:=pn;
      while l<r do begin
        m:=l+(r-l) div 2; if p[m]^<=t^ then l:=m+1 else r:=m;
      end;
      if (r=0) or (p[r-1]^<>t^) then begin
        for j:=pn downto r+1 do p[j]:=p[j-1];
        p[r]:=t; Inc(pn);
      end;
    end;
    Reset(g);
    while not EoF(g) do begin
      ReadLn(g,s); l:=0; r:=pn-1; { двоичный поиск строки в буфере }
      while l<r do begin
        m:=l+(r-l) div 2; if p[m]^<s then l:=m+1 else r:=m;
      end;
      if p[r]^=s then begin
        Inc(n); WriteLn(h,s);
      end;
    end;
  end;
  Close(g); Close(f); Close(h);
  if bf<>nil then FreeMem(bf,BufSizeF);
  if bg<>nil then FreeMem(bg,BufSizeF);
  if bh<>nil then FreeMem(bh,BufSizeF);
  for j:=0 to BufCount-1 do if b[j]<>nil then Dispose(b[j]) else Break;
  WriteLn; WriteLn('Найдено совпадений: ',n)
end.

Пару файлов по 65 К записей (по 2,6 МБ) с только парой совпадений (близкий к худшему случай) перемалывает за вполне приемлемое время.

Добавлено через 2 часа 30 минут
Либо с p в динамической памяти и файловыми буферами в сегменте данных, что принципиально от предыдущего варианта не отличается:

Pascal

type
  PString40 = ^String40;
  String40 = String[40];
const
  BufSize = $FFFE div SizeOf(String40);
  BufCount = 10;
type
  PBuf = ^TBuf;
  TBuf = array [0..BufSize-1] of String40;
  PLst = ^TLst;
  TLst = array [0..BufCount*BufSize-1] of PString40;
 
function HeapFunc(Size: Word): Integer; far; assembler; asm mov al,1 end;
 
var
  f, g, h: Text;
  bf, bg, bh: array [0..1024*4-1] of Char;
  b: array [0..BufCount-1] of PBuf;
  p: PLst;
  pn, pm, j, l, r, m: Integer;
  n: Longint;
  s: String40;
  t: PString40;
begin
  HeapError:=@HeapFunc; {ReturnNilIfGrowHeapFails:=True;}
  New(p);
  for j:=0 to BufCount-1 do begin
    New(b[j]); if b[j]<>nil then Inc(pm) else Break;
  end; pm:=pm*BufSize-1;
  Assign(f,'eng_pure.txt'); SetTextBuf(f,bf);
  Assign(g,'rus_pure.txt'); SetTextBuf(g,bg);
  Assign(h,'delta.txt');    SetTextBuf(h,bh);
  Reset(f); Rewrite(h);
  while not Eof(f) do begin
    Write('.');
    for j:=0 to pm do p^[j]:=@(b[j div BufSize]^[j mod BufSize]);
    { наполняем буфер, используя сортировку вставками и двоичный поиск }
    ReadLn(f,p^[0]^); pn:=1;
    while (pn<=pm) and not EoF(f) do begin
      t:=p^[pn]; ReadLn(f,t^); l:=0; r:=pn;
      while l<r do begin
        m:=l+(r-l) div 2; if p^[m]^<=t^ then l:=m+1 else r:=m;
      end;
      if (r=0) or (p^[r-1]^<>t^) then begin
        for j:=pn downto r+1 do p^[j]:=p^[j-1];
        p^[r]:=t; Inc(pn);
      end;
    end;
    Reset(g);
    while not EoF(g) do begin
      ReadLn(g,s); l:=0; r:=pn-1; { двоичный поиск строки в буфере }
      while l<r do begin
        m:=l+(r-l) div 2; if p^[m]^<s then l:=m+1 else r:=m;
      end;
      if p^[r]^=s then begin
        Inc(n); WriteLn(h,s);
      end;
    end;
  end;
  Close(g); Close(f); Close(h);
  for j:=0 to BufCount-1 do if b[j]<>nil then Dispose(b[j]) else Break;
  Dispose(p);
  WriteLn; WriteLn('Найдено совпадений: ',n)
end.

ФедосеевПавел Модератор 8477 / 4335 / 1643 Регистрация: 01.02.2015 Сообщений: 13,462 Записей в блоге: 8
	25.09.2016, 18:30	4
	Во FreePascal можно использовать больше памяти (в разумных пределах 2ГБ для Win32 = "2 ГБайта хватит всем") и применить тип (класс) TStringList со свойством сортировки и удаления дубликатов. Тогда задача сводится к подсчёту (=выводу) одинаковых элементов (=строк) в двух упорядоченных массивах (=файлах). Почти похожим методом можно воспользоваться и в TurboPascal - правда, я никогда не задумывался о способах использования памяти сверх 1 МБайта под DOS одноимённым объектом TStringList. 0

	26.09.2016, 14:51

Нахождение одинаковых строк в двух файлах и вывод результата в третий файл

Решение