-----------------大虾请进,关于数值计算的函数如何写?------------------

Question

本帖最后由 cowbo 于 2013-08-05 22:07:42 编辑

Answer 1

数据是否有序？还有为什么用TStringList?不如TList..

Answer 2

1.数据是先从X 从小到大,再Y从小到大.2.用List也可以啊

Answer 3

是这样:比如(X,Y)列表中,如下:
1,1
2,0
2,1
2,3
2,4
3,1
...
(以上的坐标点有断开)要求结果如下:想像在一个坐标图形中,
取出第一组上,下,左,右相接的点,到数组PList1[0]:
1,1
2,0
2,1
3,1取出第二组相连的到PList1[1],:
2,3
2,4
...

Answer 4

是这样:比如(X,Y)列表中,如下:
1,1
2,0
2,1
2,3
2,4
3,1
...
(以上的坐标点有断开)要求结果如下:想像在一个坐标图形中,
取出第一组上,下,左,右相接的点,到数组PList1[0]:
1,1
2,0
2,1
3,1取出第二组相连的到PList1[1],:
2,3
2,4
...

Answer 5

//处理代码
//界面含TMemo(mmo1), buttonunit Unit15;interfaceuses
  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;implementationtype
  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,12,3
2,43,111,36
11,37
11,38
11,39
11,4012,34
12,35
12,36
12,37
12,3812,4013,33
13,34
13,35
13,3613,4014,32
14,33
14,34
14,3514,4015,31
15,32
15,33
15,3415,4016,30
16,31
16,3216,3917,29

Answer 6

刚才把分组条件理解错了, 修改如下.另外, 楼主说的"取出第一组上,下,左,右相接的点"是类似九宫格找相邻吧?!
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;
var
  idx, X, Y : integer;
begin
  repeat
    idx := Low(FArr);
    vRes := FArr[idx];    while FCount > idx do
    begin
      X := Abs(FArr[idx].x - vRes.x);
      Y := Abs(FArr[idx].y - vRes.y);      if (X in [0, 1]) and (Y in [0, 1]) then
      begin
        Extract(idx);
      end
      else
      begin
        inc(idx);
      end
    end;
    ALst.Add('');
  until FCount = 0;
end;处理结果
1,1
2,0
2,1
3,12,3
2,411,36
11,37
11,38
11,39
11,40
12,40
13,40
14,40
15,40
16,3912,34
12,35
12,36
12,37
12,3813,33
13,34
13,35
13,36
14,35
15,3414,32
14,33
14,34
15,33
16,3215,31
15,32
16,3116,30
17,29

Answer 7

谢谢,但还有个问题请教下,如果输出到Memo1是可以的,
但如果要输出到一个StringList为什么不行呢?
提示虚拟化错误?
改哪里?

Answer 8

实例化StringList即可
procedure TForm15.btn1Click(Sender: TObject);
var 
  sLst : TstringList;
begin
  sLst := TstringList.Create;   
  with TCustomGroup.Create('c:\test.txt') do
  try
    if Exec(sLst) then
    begin
      ShowMessage('Ok')
    end
    else
      ShowMessage('Error');
  finally
    sLst.Free;
    Free;    
  end;
end;