-----------------大虾请进,关于数值计算的函数如何写?------------------
本帖最后由 cowbo 于 2013-08-05 22:07:42 编辑
偶有一组数据,是坐标点(图片像索点)的..这些坐标点并不是连续的...(例如下面列表)
现在如何写一个函数,将以下像索点相邻(上,下,左,右)的汇到一个
PList1:array of TStringList;,
就是第一组相连的坐标,按StringList添加按到PList1[0],第二组相连的到PList1[1]........以此类推..
请问如何写?
11,36
11,37
11,38
11,39
11,40
12,34
12,35
12,36
12,37
12,38
12,40
13,33
13,34
13,35
13,36
13,40
14,32
14,33
14,34
14,35
14,40
15,31
15,32
15,33
15,34
15,40
16,30
16,31
16,32
16,39
17,29
....
[解决办法]
//处理代码
//界面含TMemo(mmo1), button
unit Unit15;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, rtlconsts;
type
TForm15 = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form15: TForm15;
implementation
type
TCustomGroup = class
private
type
TRes = record
X, Y, Sum : integer;
end;
PRes = ^TRes;
private
FArr : array of TRes;
FFileName : string;
FCount : integer;
procedure Fill;
procedure FillRes(const Value : string; ARes : PRes);
procedure Sort;
procedure Output(ALst : TStrings);
public
constructor Create(const AFileName : string);
function Exec(ALst : TStrings) : Boolean;
end;
{$R *.dfm}
procedure TForm15.btn1Click(Sender: TObject);
begin
mmo1.Clear;
with TCustomGroup.Create('c:\test.txt') do
try
if Exec(mmo1.Lines) then
begin
mmo1.SelStart := 0;
mmo1.SelLength := 0;
ShowMessage('Ok')
end
else
ShowMessage('Error');
finally
Free;
end;
end;
{ TCustomGroup }
constructor TCustomGroup.Create(const AFileName: string);
begin
FFileName := AFileName;
end;
function TCustomGroup.Exec(ALst: TStrings): Boolean;
begin
Result := false;
try
Fill;
Sort;
Output(ALst);
Result := True;
except on E: Exception do
Result := false;
end;
end;
procedure TCustomGroup.Fill;
var
i: Integer;
sLst : TStringList;
begin
sLst := TStringList.Create;
try
sLst.LoadFromFile(FFileName);
if sLst.Count < 2 then
Exit;
FCount := sLst.Count;
SetLength(FArr, FCount);
for i := 0 to sLst.Count - 1 do
begin
FillRes(sLst.Strings[i], @FArr[i]);
end;
finally
slst.Free;
end;
end;
procedure TCustomGroup.FillRes(const Value: string; ARes: PRes);
var
idx : integer;
begin
idx := Pos(',', value);
ARes.X := StrToInt(Copy(Value, 1, idx - 1));
ARes.Y := StrToInt(Copy(Value, idx + 1, Length(Value)));
ARes.Sum := ARes.X + ARes.Y;
end;
procedure TCustomGroup.Output(ALst : TStrings);
var
vRes : TRes;
procedure Extract(const idx: integer);
begin
if (idx < 0) or (idx >= FCount) then
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
ALst.Add(Format('%d,%d', [FArr[Idx].X, FArr[Idx].Y]));
Dec(FCount);
if Idx <> FCount then
begin
vRes := FArr[Idx];
Move(FArr[Idx + 1], FArr[Idx], (FCount - Idx) * SizeOf(TRes));
FillChar(FArr[FCount], SizeOf(TRes), 0);
end;
end;
begin
FCount := Length(FArr);
vRes := FArr[Low(FArr)];
while FCount > 0 do
begin
if Abs(FArr[0].Sum - vRes.Sum) > 2 then
begin
ALst.Add('');
Extract(0);
end
else
if Abs(FArr[0].Sum - vRes.Sum) < 2 then
begin
Extract(0);
end
else
if (Abs(FArr[0].x - vRes.x) = 1) and (Abs(FArr[0].y - vRes.y) = 1) then
begin
Extract(0);
end
else
begin
ALst.Add('');
Extract(0);
end
end;
end;
procedure TCustomGroup.Sort;
var
i, j : integer;
vRes : TRes;
begin
for i := low(FArr) to High(FArr) - 1 do
begin
for j := i + 1 to High(FArr) do
begin
if FArr[i].X > FArr[j].X then
begin
vRes := FArr[i];
FArr[i] := FArr[j];
FArr[j] := vRes;
end
else
if (FArr[i].X = FArr[j].X) and (FArr[i].Y > FArr[j].Y) then
begin
vRes := FArr[i];
FArr[i] := FArr[j];
FArr[j] := vRes;
end;
end;
end;
end;
end.
test.txt
11,38
11,36
11,37
11,39
11,40
12,34
12,35
12,36
12,37
12,38
12,40
13,33
13,34
13,35
13,36
13,40
14,32
14,33
14,34
14,35
14,40
15,31
15,32
15,33
15,34
15,40
16,30
16,31
16,32
16,39
17,29
1,1
2,0
2,1
2,3
2,4
3,1
处理结果
1,1
2,0
2,1
2,3
2,4
3,1
11,36
11,37
11,38
11,39
11,40
12,34
12,35
12,36
12,37
12,38
12,40
13,33
13,34
13,35
13,36
13,40
14,32
14,33
14,34
14,35
14,40
15,31
15,32
15,33
15,34
15,40
16,30
16,31
16,32
16,39
17,29