有趣的找数字游戏问题

[lotto]

有一个数字序列，是个二维数组，如：
1 2 3 4 5 6 7 8
3 4 2 1 9 8 1 1
3 8 0 1 8 3 9 1
8 9 2 2 8 3 1 3
3 8 9 7 1 3 3 0
2 9 7 9 7 9 1 3
3 4 5 2 1 4 4 2
......

要求输入一个数字串，如1234，能在上面的数字序列中找出该特征的数字串，要求无论是横的、竖的，拐弯的、十字型的，还有乱七八糟形状的都能找出来，只要连在一起就行，各位有什么好的办法？

[ygflydream]

up!

[merkey2002]

倒，這可難倒我啦

[gemouzhi]

先横找，再竖找，再拐弯找，再十字型的找
十字型的找我给你关键算法，有点意思，呵呵。
function (i,j:integer):boolean
最左最右最上最下这四列不用遍历，不可能实现十字的形状。
if ((NumberArray[i-1,j]-NumberArray[i,j-1] = 1) and (NumberArray[i-1,j]-NumberArray[i,j+1] = 3) and (NumberArray[i-1,j]-NumberArray[i+1,j] = 2)) then
result := true else
result := false;
当然十字还有这种情况：
if ((NumberArray[i-1,j]-NumberArray[i,j-1] = ３) and (NumberArray[i-1,j]-NumberArray[i,j+1] = １) and (NumberArray[i-1,j]-NumberArray[i+1,j] = 2)) then
result := true else
result := false;

[lotto]

谢谢gemouzhi(gemouzhi) ，关键还有些不规则形状的要找出来

[YOHOYOHO]

只要找出每个数字的身边的八个数字和字符串中的一个数字比对就可以了吧。
array[x,y] array[x+1,y] array[x+2,y]
array[x,y+1] 比对的数字 array[x+2,y+1]
array[x,y+2] array[x+1,y+2] array[x+2,y+2]

[ToBeABetterMan]

这个应该不难，主要是个相邻元素的寻找。

假设一个元素N[i][j],如果它是1，那么将它的所有相邻元素找出来（对于边界上面的元素和非边界上面的元素会不同）,遍历所有的相邻元素，如果是2的继续找此元素的相邻元素，如此一直到4；

利用i,j循环

[lotto]

就是寻找相邻元素的比较麻烦啊，比如拿寻找4位数来说，目标正方型上的第一个点，和它相邻的区域有横1-4，竖1-4，斜1-4，还有以它为正方型左上角的1243，就是不同的点，不同的数字长度的相邻区域都是不一样的。

[lotto]

没讨论的了吗？

[Kshape]

关键是你的不规则应该不规则到什么地步呢？
如果是简单的横、竖、斜等
可以根据数组下标的改变来查找
这个应该不复杂

[Cipherliu]

这显然是一个应该用回朔法求解的问题
先看看八皇后问题后,再来解决这个问题
不同之处在于:
先找第一个能匹配的字符,然后用它的相邻字符去匹配第二个字符,依此类推.
但要注意,找相邻字符时,要排除已经被用来匹配上的字符,所以必须维护一个当前已经匹配的字符列表.
另外,找相邻字符可以直接根据坐标去找,并不困难.只要(X1-X2)^2+(Y1-Y2)^2<=2时,(X1,Y1)和(X2,Y2)这两个点就是相邻的

[squall23504136]

听不懂

[王集鹄]

//具不可靠消息，楼主已经失踪！
http://community.csdn.net/Expert/topic/3766/3766864.xml?temp=.797024

//就是走迷宫的算法～～
//把每一个位置做为起点测试～～
//参考如下代码～～
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure ListBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
cRowCount = 20; //高度
cColCount = 20; //宽度

const
cMoveOffsets: array[0..3] of TPoint = ( //偏移参数
(X: 00; Y: -1), //上
(X: +1; Y: 00), //右
(X: 00; Y: +1), //下
(X: -1; Y: 00) //左
);

var
vPointList: array[0..cColCount - 1, 0..cRowCount - 1] of Char; //矩阵
vPassList: array[0..cColCount - 1, 0..cRowCount - 1] of Boolean; //是否处理过

procedure pInit; //初始化
var
I, J: Integer;
begin
Randomize;
for I := 0 to cColCount - 1 do
for J := 0 to cRowCount - 1 do
vPointList[I, J] := Char(Byte('0') + Random(10));
FillChar(vPassList, SizeOf(vPassList), 0);
end;

procedure pCalc( //计算所有路径
mStr: string; //源字符串
mOutput: TStrings //输出
);
var
I, J: Integer;
vLength: Integer;

procedure fCalc( //计算一步
mIndex: Integer; //序号
mCol, mRow: Integer; //起始坐标
mStep: string //步骤
);
var
I: Integer;
begin
if (mCol < 0) or (mRow < 0) or
(mCol >= cColCount) or (mRow >= cRowCount) then Exit; //非法坐标
if vPassList[mCol, mRow] then Exit; //已经路过
if mIndex > vLength then Exit; //下标越界
if mStr[mIndex] <> vPointList[mCol, mRow] then Exit; //不是相应的字符
vPassList[mCol, mRow] := True;
mStep := Format('%s;%d-%d', [mStep, mCol, mRow]);
if mIndex < vLength then
for I := Low(cMoveOffsets) to High(cMoveOffsets) do
fCalc(
mIndex + 1,
mCol + cMoveOffsets[I].X,
mRow + cMoveOffsets[I].Y,
mStep
)
else mOutput.Add(Copy(mStep, 2, MaxInt));
vPassList[mCol, mRow] := False;
end;

begin
if mStr = '' then Exit;
if not Assigned(mOutput) then Exit;
vLength := Length(mStr);
mOutput.BeginUpdate;
try
mOutput.Clear;
for I := 0 to cColCount - 1 do
for J := 0 to cRowCount - 1 do
fCalc(1, I, J, '');
finally
mOutput.EndUpdate
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.RowCount := cRowCount;
StringGrid1.ColCount := cColCount;
StringGrid1.FixedCols := 0;
StringGrid1.FixedRows := 0;
StringGrid1.DefaultColWidth := 12;
StringGrid1.DefaultRowHeight := 12;
Edit1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
I, J: Integer;
begin
pInit;

for I := 0 to cColCount - 1 do
for J := 0 to cRowCount - 1 do
StringGrid1.Cells[I, J] := vPointList[I, J];
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
pCalc(Edit1.Text, ListBox1.Items);

ListBox1.ItemIndex := 0;
StringGrid1.Repaint;
end;

type
TStringGridEx = class(TStringGrid);

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
I: Integer;
begin
if ListBox1.ItemIndex < 0 then Exit;
I := Pos(Format(';%d-%d;', [ACol, ARow]),
Format(';%s;', [ListBox1.Items[ListBox1.ItemIndex]]));
case I of
0: Exit;
1: TStringGridEx(Sender).Canvas.Brush.Color := clRed;
else TStringGridEx(Sender).Canvas.Brush.Color := clGreen;
end;
TStringGridEx(Sender).OnDrawCell := nil;
try
TStringGridEx(Sender).DrawCell(ACol, ARow, Rect, State);
finally
TStringGridEx(Sender).OnDrawCell := StringGrid1DrawCell;
end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
StringGrid1.Repaint;
end;

end.

[lotto]

谁说我失踪了，我看没人讨论了，最近回来看看，发现热闹起来了，谢谢各位：）