递归算法，程序开始计算后无响应

[大地精灵]

要生成1296个含0,1的2进制数据，规律头尾相接任意取11位都跟另外的不重复，而且要求是1296个数据里，0和1的个数相等，我现在的电脑只要运算程序就变成没响应，不知道是否是递归太深的缘故，希望有人能够帮忙提出解决办法，如果能够提供更好的方法生成也可以，我采用的是递归操作。我的QQ：106873730，邮箱：[e-mail].



分不够可以再加。我的运行的函数如下：


function TFrmMain.CharCount(s,c:string):Integer;
begin
Result := (Length(s) - Length(AnsiReplaceStr(s,c,''))) div (length(c));
end;

function TFrmMain.TestCode_IsPH(Test_Code:String):Boolean;
begin
if CharCount(Test_Code,'0') = CharCount(Test_Code,'1') then
Result := True
else
Result := False;

end;

function TFrmMain.TestByNum(TestCode,SourceCode:String;WS:Integer):Boolean;
var
Loop:Integer;
Flag :Boolean;
begin

Flag := True;
for Loop := 1 to length(SourceCode) - WS + 1 do
begin
if Copy(SourceCode,Loop,ws) = TestCode then
begin
Flag := False;
Break;
end;
end;

Result := Flag;

end;

//JZ--进制
//WS--位数
//TotalNum--个数
function TFrmMain.GetCodeByNum(MiddleCode:String;JZ,WS,TotalNum:Integer):String;
var
FirstCode:String;
CurrentCode:String;
Loop:Integer;
OverCode:String;
begin
self.StatusBar1.Panels[0].Text := IntToStr(StrToInt(self.StatusBar1.Panels[0].Text) + 1);
FirstCode := Copy(MiddleCode,1,Ws);
CurrentCode := Copy(MiddleCode,length(MiddleCode) - Ws + 2,Ws - 1);

if length(MiddleCode) = TotalNum + Ws - 1 then
begin

if (CurrentCode + Copy(MiddleCode,1,1) = FirstCode) then
begin
OverCode := copy(MiddleCode,1,length(MiddleCode) - WS + 1);

if TestCode_IsPH(OverCode) then
begin
GoalFlag := 1;
ListBox1.Items.Add(OverCode);

end;
end;
Exit;
end;

for Loop := 0 to Jz - 1 do
begin
if TestByNum(CurrentCode + IntToStr(Loop),MiddleCode,WS) then
begin
if GoalFlag <> 1 then
GetCodeByNum(MiddleCode + IntToStr(Loop),Jz,Ws,TotalNum);
end;
end;
end;

//调用
procedure TFrmMain.Button1Click(Sender: TObject);
begin
GetCodeByNum('00000000000',2,11,1296)
end;

[bdmh]

跟踪一下，看看是不是 if TestCode_IsPH(OverCode) then条件一直得不到满足，这样GoalFlag一直为0，就永远都在执行
if GoalFlag <> 1 then
GetCodeByNum(MiddleCode + IntToStr(Loop),Jz,Ws,TotalNum);
永远跳不出

[浩南_哥]

试试多线程看看，或是把递归的深度减小一点试试。

[大地精灵]

bdmh
(bdmh)

等　级：
19
更多勋章 #3楼 得分：0回复于：2011-07-16 16:15:25跟踪一下，看看是不是 if TestCode_IsPH(OverCode) then条件一直得不到满足，这样GoalFlag一直为0，就永远都在执行
if GoalFlag <> 1 then
GetCodeByNum(MiddleCode + IntToStr(Loop),Jz,Ws,TotalNum);
永远跳不出


这个不太清楚啊，不过在我设置6位编码，取50个的时候我运算出过结果，我现在是11位编码，如果取全了是2046，我现在只需要1296，理论上应该是没问题吧，



现在估计是递归太深，导致无法做下去，不知道DELPHI对这方面是否有限制，是否环C++结果会好点，不过好久没弄C++，有点不太会写了。

[littlestone08]

这个问题有点意思,分数了不少

[littlestone08]

发现一个死循环了

[littlestone08]

我了个,递归无限了,五星的那位说得不错

[大地精灵]

if TestCode_IsPH(OverCode) then 肯定可以满足的，我在编码位数少的时候已经获得了编码，现在是编码位数多了以后，CPU资源只允许50%，这样导致运算无法进行下去，变成“未响应”。

[haitao]

【1296个含0,1的2进制数据】
每个数的范围是多少？也就是：它们是二进制多少位的？？

[mdejtod]

现在估计是递归太深，导致无法做下去
汗一个

[littlestone08]

楼主，我把你的代码复制了，我感觉你的代码不是你正式的代码，至少在界面上我不知道它计算的结果是什么。我连蒙再猜，自己加上些代码。判断递归居然达到了200,000次，而且还没有完....，你把你能运行的DEMO贴上来呗？

[littlestone08]

再次纳闷，那么深的递归，居然不溢出？怪了，我用的是XE，难道XE有过人之处。。

[大地精灵]

那几个函数是我正式运算用的，因为我的这个设计是没问题的。

[JJF]

我最近在算数独的递归，有时候也会失去响应，不知道有没有什么好的办法。 如果失去响应，不知道怎样可以退出递归呀

[yyfhz]

用Application.Postmessage来接受消息。
在消息处理函数中设置某一个标志位。
在算法中不停的检测标志位，若发现用户需要停止算法则直接退出。
另外，
就本题而言，其实就是将1296/2=648个1分配到围成1圈的1296个格子中并要求任意11个格子所组成的数字均不相同对吧？

[lm_whales]

把数据扩展到 1296+11位 后11 位和前11位相同 检查11次是否重复，即可，不需要递归

[lm_whales]

把数据扩展到 1296+11位 后11 位和前11位相同 检查1296次时间1296*1296 前面次数算错了。

[dreamning]

别让帖子沉了！我也来学习下，求大神解答

[kuangning]

要先确定生成的数字是多少位的

[kuangning]

如果是32位的 function check1count(const A : Word):Integer; var I:Integer; begin Result := 0; for I := 0 to 10 do if a and (1 shl I)= (1 shl I) then Inc(Result); end; function IntToBin(Value: LongInt;Size: Integer): String; var i: Integer; begin Result:=''; for i:=Size-1 downto 0 do begin if Value and (1 shl i)<>0 then begin Result:=Result+'1'; end else begin Result:=Result+'0'; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var I,J:Integer; B:Cardinal; count1,count2:Integer; ss,ss2,ss3:TStringList; begin count1 := 0; ss:= TStringList.Create; ss2:= TStringList.Create; for I := 1 to $7FF do begin B := (I shl (32-11)) or I ; count1 :=count1+ 2*check1count(I); ss.Add(IntTohex(2*check1count(I),2)+'='+inttostr(B)); end; ss.Sorted := True; Memo1.Lines.Text := ss.Text; count1 := 0; for I := ss.Count-1 downto ss.Count-1296 do begin ss2.Add(ss[i]); count1 := StrToInt('$'+ss.Names[i])+count1; end; Memo2.Lines.Text := ss2.Text; count1 := 1296*16-count1; Caption := IntToStr(count1) ; count2 := 0; for I := 11 to 20 do begin for J := 0 to ss2.Count - 1 do begin ss2.ValueFromIndex[j] := IntToStr(StrToInt64(ss2.ValueFromIndex[j]) or (1 shl I)); inc(count2); if count2=count1 then Break; end; if count2=count1 then Break; end; if count2<>count1 then ShowMessage(' 此方案无效') else begin for J := 0 to ss2.Count - 1 do begin ss2[j] := IntToBin(StrToInt64(ss2.ValueFromIndex[j]),32); inc(count2); if count2=count1 then Break; end; Memo2.Lines.Text := ss2.Text; end; ss.free; ss2.free; end;

[kuangning]

如果是11位貌似更简单 function IntToBin(Value: LongInt;Size: Integer): String; var i: Integer; begin Result:=''; for i:=Size-1 downto 0 do begin if Value and (1 shl i)<>0 then begin Result:=Result+'1'; end else begin Result:=Result+'0'; end; end; end; procedure TForm1.Button2Click(Sender: TObject); var I:Integer; n:Integer; begin for I := 1 to 1296 div 2 do begin N:= I; Memo1.Lines.Add(IntTobin(N,11)); N := $7FF xor N; Memo1.Lines.Add(IntTobin(N,11)); end; end;