DELPHI数据比较问题

Posted 2023-05-16

有两个记事文件,其文件编辑格式很整齐,每行都是5组2位数数字,现在要做的是;取出记事本A中一行数据与记事B的每一行比较,如果B中没有就将写入记事本C中
直到取出——>比较完记事本所有的数据。记事本A的行数在2-3万行左右，记事本B在29万行左右。逐条比较法使用的时间太长，一般要在240分钟以上，看有没有什么办法缩短这个比较时间。

这是个基本的求差集的问题，按你的需求，似乎只是“整行”的差集，与行的结构无关。关键是先排序再处理，大致过程如下：
1、用两个StringList分别装载A.txt和B.txt
2、对两个StringList分别排序
3、模仿归并排序的算法处理，时间复杂度是O(m+n)，如果不排序就处理，将是O(m*n)。

咱写过一个叫做LineSub的命令行工具程序，代码如下，你可以编译后留用，或参考一二；编译出LineSub.exe之后，执行LineSub A.txt B.txt C.txt即能满足你的要求，不提供参数运行，则显示用法。

program lineSub;

$APPTYPE CONSOLE

uses Classes, SysUtils, DateUtils;

procedure ShowUsageAndExit;
const
C_sUsageFormat : string =
'用法：%s 文本文件#1(输入) 文本文件#2(输入) 结果文件(输出) [ 选项参数]'#$0D#$0A +
'说明：求两个文本文件的差集，结果另外保存到一个文件'#$0D#$0A +
'原理：模仿二路归并排序......'#$0D#$0A +
'选项：支持以下5种选项参数，均有缺省值，可被忽略或任意组合'#$0D#$0A +
' -S 0|1——是否需要先对两个文本文件进行排序'#$0D#$0A +
' 缺省为1，即需要排序之预处理；'#$0D#$0A +
' 若确保输入文件均已按照UTF-16LE编码排序，可设为0以提高效率'#$0D#$0A +
' 若不能确认文件已排序，则应采用缺省配置，以保证结果的准确性'#$0D#$0A +
' -K 0|1——处理过程保持原始文件中的行顺序'#$0D#$0A +
' 缺省为“是”，即差集行的顺序同其原来在文本文件#1中的顺序'#$0D#$0A +
' -U 0|1——保存结果为UTF-16LE编码格式'#$0D#$0A +
' 缺省为“否”，即保存为系统当前字符集格式'#$0D#$0A +
' -Q 0|1——是否静默模式，静默将不显示处理消息。缺省为“是”'#$0D#$0A +
' -P 数字——每处理多少行输出一次进度。缺省为“否”，即不显示进度';
var
s : string;
begin
s := ChangeFileExt( ExtractFileName( ParamStr(0) ), '' );
s := Format( C_sUsageFormat, [ s ] );
Writeln( ErrOutput, s );
Halt;
end;

function GetCmdArguments(
var sFN1, sFN2, sFN_Save : string;
var nLC_ShowProgress : Integer;
var bNeedSort : Boolean;
var bKeepOrder : Boolean;
var bSaveAsUTF16LE : Boolean;
var bDisplayMessage : Boolean
) : Boolean;
var
i : Integer;
m : Integer;
n : Integer;
s : string;
C : Char;
begin
Result := False;
n := ParamCount;
if n < 3 then
Exit;
sFN1 := '';
sFN2 := '';
sFN_Save := '';
nLC_ShowProgress := 0;
bNeedSort := True;
bKeepOrder := True;
bSaveAsUTF16LE := False;
bDisplayMessage := False;
m := 0;
for i := 1 to n do
begin
s := ParamStr(i);
处理选项参数
if ( s[1] = '-' ) or ( s[1] = '/' ) then
begin
// 选项参数字符串格式为：[-/][PKS]数字，最短三个字符，不足的一定不正确
if Length( s ) < 3 then
Exit;
// 获取参数种类
C := s[2];
// 只保留参数值
Delete( s, 1, 2 );
根据参数种类，检查相应的参数值是否合格，不合格则忽略，以采用缺省值
case C of
'K', 'k':
begin
if s[3] = '0' then
bKeepOrder := False;
end;
'P', 'p':
begin
nLC_ShowProgress := StrToIntDef( s, 0 );
end;
'Q', 'q':
begin
if s[3] = '0' then
bDisplayMessage := True;
end;
'S', 's':
begin
if s[3] = '0' then
bNeedSort := False;
end;
'U', 'u':
begin
if s[3] <> '0' then
bSaveAsUTF16LE := True;
end
else // 参数种类不对，直接退出
Exit;
end;
Continue;
end;
处理文件名
Inc( m );
case m of
1: sFN1 := s;
2: sFN2 := s;
3: sFN_Save := s;
end;
end;
// 必要参数不足，返回失败
if m < 3 then
Exit;
if not FileExists( sFN1 ) then
Exit;
if not FileExists( sFN2 ) then
Exit;
Result := True;
end;

procedure ShowProgress( nCount1, nCount2, nStep : Integer; bLast : Boolean = False );
const
C_sProgressFormat : string = #$0D' 进度：%d, %d';
var
s : string;
begin
if nStep <= 0 then
Exit;
if bLast or ( nStep = 1 ) or ( ( nCount1 + nCount2 ) mod nStep = 0 ) then
begin
s := Format( C_sProgressFormat, [ nCount1, nCount2 ] );
Write( ErrOutput, s );
if bLast then
Writeln( ErrOutput );
end;
end;

function CompareByString( SL : TStringList; I, J : Integer ) : Integer;
begin
if I = J then
Result := 0
else
Result := CompareStr( SL[I], SL[J] );
end;

function CompareByNumber( SL : TStringList; I, J : Integer ) : Integer;
begin
if I = J then
Result := 0
else
Result := Integer( SL.Objects[I] ) - Integer( SL.Objects[J] );
end;

将负整数、0、正整数归一到-1、0、1，方便用case语句处理分支
function UnifySignedInteger( N : Integer ) : Integer; inline;
begin
if N < 0 then
Result := -1
else
if N > 0 then
Result := 1
else
Result := 0;
end;

字符串比较大小，返回-1、0、1，用于排序的回调函数
function StrCompResult( S1, S2 : string ) : Integer;
begin
Result := UnifySignedInteger( CompareStr( S1, S2 ) );
end;

procedure PrintEllapsed( t0 : TDateTime ); inline;
const
C_sEF : string = ' 耗时：%.0n 毫秒';
begin
Writeln( ErrOutput, Format( C_sEF, [ MillisecondSpan( Now, t0 ) ] ) );
end;

设置字符串列表中各个字符串的顺序
procedure SetStringOrder( SL : TStringList );
var
i : Integer;
begin
for i := 0 to SL.Count - 1 do
SL.Objects[i] := TObject( i );
end;

计算字符串列表的行差集
procedure ComputeSubStrings( SL1, SL2, slSave : TStringList; nLC_Progress : Integer );
var
I, J : Integer;
begin
I := 0;
J := 0;
while ( I < SL1.Count ) and ( J < SL2.Count ) do
begin
ShowProgress( I, J, nLC_Progress );
case StrCompResult( SL1[I], SL2[J] ) of
-1:
begin
slSave.AddObject( SL1[I], SL1.Objects[I] );
Inc( I );
end;
0:
begin
Inc( I );
Inc( J );
end;
1:
begin
Inc( J );
end;
end;
end;
输出第一个文件中的剩余部分
while I < SL1.Count do
begin
ShowProgress( I, J, nLC_Progress );
slSave.AddObject( SL1[I], SL1.Objects[I] );
Inc( I );
end;
// 最后一次显示进度
ShowProgress( I, J, nLC_Progress, True );
end;

var
t0 : TDateTime;
t00 : TDateTime;
iProcessStep : Integer;
nLC_Progress : Integer;
sFN_Text1 : string;
sFN_Text2 : string;
sFN_Save : string;
slText1 : TStringList;
slText2 : TStringList;
slSave : TStringList;
bNeedSort : Boolean;
bKeepOrder : Boolean;
bSaveAsUTF : Boolean;
bShowHint : Boolean;

begin
获取命令行参数，如不正确，则显示用法后立即退出...
if not GetCmdArguments(
sFN_Text1, sFN_Text2, sFN_Save,
nLC_Progress,
bNeedSort, bKeepOrder, bSaveAsUTF, bShowHint
) then
ShowUsageAndExit;

t00 := Now;

if bShowHint then
begin
Writeln( ErrOutput, Format( '文本文件#1：[%s]', [ sFN_Text1 ] ) );
Writeln( ErrOutput, Format( '文本文件#2：[%s]', [ sFN_Text2 ] ) );
Writeln( ErrOutput, Format( '保存文件 ：[%s]', [ sFN_Save ] ) );
Writeln( ErrOutput );
end;

slText1 := TStringList.Create;
slText2 := TStringList.Create;
slSave := TStringList.Create;

iProcessStep := 1;
t0 := Now;
try
装载原始文本文件...
if bShowHint then
Write( ErrOutput, Format( '%d 装载文件', [ iProcessStep ] ) );
slText1.LoadFromFile( sFN_Text1 );
slText2.LoadFromFile( sFN_Text2 );
if bShowHint then
begin
PrintEllapsed( t0 );
Inc( iProcessStep );
end;

如果需要保持原有顺序，则预先设置原顺序标记...
if bKeepOrder then
begin
if bShowHint then
begin
Write( ErrOutput, Format( '%d 预设原始行的顺序标记', [ iProcessStep ] ) );
t0 := Now;
end;
SetStringOrder( slText1 );
SetStringOrder( slText2 );
if bShowHint then
begin
PrintEllapsed( t0 );
Inc( iProcessStep );
end;
end;

如原始文本未排序，则首先排序，以便大幅提高处理性能...
if bNeedSort then
begin
if bShowHint then
begin
Write( ErrOutput, Format( '%d 对原始文件排序', [ iProcessStep ] ) );
t0 := Now;
end;
slText1.CustomSort( @CompareByString );
slText2.CustomSort( @CompareByString );
if bShowHint then
begin
PrintEllapsed( t0 );
Inc( iProcessStep );
end;
end;

根据归并排序原理，输出第一个文件中有而第二个文件中无的行...
if bShowHint then
begin
Writeln( ErrOutput, Format( '%d 求文本行之差集', [ iProcessStep ] ) );
t0 := Now;
end;
ComputeSubStrings( slText1, slText2, slSave, nLC_Progress );
if bShowHint then
begin
PrintEllapsed( t0 );
Inc( iProcessStep );
end;

如需保持原有顺序，则恢复之...
if bKeepOrder then
begin
if bShowHint then
begin
Write( ErrOutput, Format( '%d 恢复差集行的原有顺序', [ iProcessStep ] ) );
t0 := Now;
end;
slSave.CustomSort( @CompareByNumber );
if bShowHint then
begin
PrintEllapsed( t0 );
Inc( iProcessStep );
end;
end;

保存结果文件...
if bShowHint then
begin
Write( ErrOutput, Format( '%d 保存文件', [ iProcessStep ] ) );
t0 := Now;
end;
if bSaveAsUTF then
slSave.SaveToFile( sFN_Save, TEncoding.Unicode )
else
slSave.SaveToFile( sFN_Save );
if bShowHint then
begin
PrintEllapsed( t0 );
Writeln( ErrOutput, Format( '--- 总计耗时：%.2n 秒', [ SecondSpan( Now, t00 ) ] ) );
end;

finally
slSave.Free;
slText2.Free;
slText1.Free;
end;
end.追问

集合法，是一条路子，暂时不结题，看有没有更好的路子。

追答

个人以为，这个方法已经是很高效的了。
经实测10万行与50万行的差集总共耗时4秒，其中排序的预处理占3.5秒，求差集的步骤耗时不到总耗时的10%。当然了，这两个测试文件的行比较短（是通过如下命令产生的），对于长一些的行，估计也只能慢一点儿而已。
FOR /L %A IN (100000,-1,1) DO @ECHO %A>>A.txt
FOR /L %A IN (1,3,1500000) DO @ECHO %A>>B.txt
执行linesub A.txt B.txt C.txt -Q0将会在完成任务的同时，显示各个分步骤的耗时和总计耗时。
再经实测，将上述A.txt和B.txt的每行分别复制10份，即行长扩大为原来的10倍，总计耗时6.41秒。

追问

今天把您的代码运行了一下，的确如您所说，飞快，但可惜的是，它是一个控制台程序，dos窗口让用户难以接受。怎样才能把改成有操作窗口的文件。
另外，代码直接复制到DELPHI之后，编译运行之后，并不工作。
对代码作了此修改之后才正常工作，输出结果文件。
万分感谢您的无私奉献。

追答

嘿，就当是给了你一些启示和参考吧。
咱是用惯了命令行操作了，很看重其准确性和快捷性，命令行工具很容易包装成批处理之类的自动化处理方案，图形界面程序的交互自动化要繁琐得多，故而建议控制台程序你也可留用，这还算是个较为常见的需求解决方案吧。

参考技术A 如果可以的话，把A,B发过来，测试一下
我没试过这么大数据量的比较，几万条记录的我试过，几秒钟就可以追问

如果是取出A文件中的一条,然后与B文件中的每一条比较,如果B中没有,就写入C文件,这种办法我已经做过了,2万*29万等于58亿次,耗时超过200分钟,内存为2G,CPU双核,频率2G.你的办法是什么,能告诉我吗?

追答

集合的概念你知道吧：把A和B做为两个集合进行比较，取出在A中且不在B中的数据，写入C中
太具体的我也说不清，你可以网上搜搜，共同探讨

追问

集合也只能逐行对比，不能整块整块的比较，这和取字符串对比没有什么区别。

追答

我是把A，B看做两个表，用SQL实现的：
insert into c select vol from a where not exists (select vol from b where a.vol=b.vol)

我的电脑酷睿双核2.8G 内存2G，A,B各3万行左右，每行均为8位长的纯数字

delphi 汉字字符串怎么比较

a是tstrngs
name是输入的中文
a.DelimitedText := Memo1.Lines.Strings[k];
a.Delimiter := ' ';
能不能这么比较name > a[0]
memo1的内容如下
杜晓燕 6
卢婵娟 3
卢平波 5
唐桂军 0
唐琴琴 2
王永兴 1
竺柯科 4

参考技术A 这样肯定不行的，汉字比较它是根据拼音来比较的。我觉得还是根据序列号比较吧！追问

序列号是无法解决这个问题的，嗯。上面说了 用WideCompareText这方法就行

追答

哦，我其实很久没用Delphi了，至于高手，别提了。

参考技术B 如果你是想数组中包含某字符串的话不如使用
if pos(name,a[0]) >0 then 这样的语句追问

问题是假如不包含，用的是2分查找，是往上找，还是往下找，总得有个比较吧

追答

2分查找是什么呢?

追问

我想你是个高手，你不会不知道二分查找这方法吧。。 现在这个问题我解决了，用WideCompareText这个函数就行了

参考技术C 这样比较有什么意义呢？追问

就是按名字排序的 然后想用2分查找 找出这个名字 其中必定用到了比较