挑战编程高手!两个小问题(递归和幂集)。(100分)

  • 主题发起人 主题发起人 sphix
  • 开始时间 开始时间
S

sphix

Unregistered / Unconfirmed
GUEST, unregistred user!
问题的简单描述:
1:给定一个集合A={a,b},求该集合的幂集,如
A的平方为{aa,ab,ba,bb},A的立方为
{aaa,aab,aba,abb,baa,bab,bba,bbb}.
2:用递归的方法将1,2,。。。19,20放在一个
环上,使得任何两个相邻的元素之和为素数。
 
很简单得问题 
随便查查资料
递归 都可以用 无限循环来代替
 
问题1的解答:
function GenABStr(SL:TStringList;
N:Integer):String;
var
Count:Integer;
StrList:TStringList;
procedure Deep(Level:Integer);
var
i,j,c:Integer;
begin
if Level=N then
begin
for i:=0 to Count-1do
StrList.Add(SL);
end
else
begin
c:=StrList.Count;
for j:=1 to Count-1do
for i:=0 to c-1do
StrList.Add(StrList);
for j:=0 to Count-1do
for i:=0 to c-1do
StrList[i+j*c]:=SL[j]+StrList[i+j*c];
end;
if Level>1 then
Deep(Level-1);
end;
begin
StrList:=TStringList.Create;
Count:=SL.Count;
Deep(N);
Result:=StrList.Text;
StrList.Free;
end;

procedure TfrmAB.Button1Click(Sender: TObject);
var
SL:TStringList;
N:Integer;
begin
SL:=TStringList.Create;
SL.CommaText:=Edit1.Text;
//Edit1.Text为 ‘a,b’
N:=SpinEdit1.Value;
//SpinEdit1.Value为 3
Memo1.Text:=GenABStr(SL,N);
SL.Free;
end;
 
问题2:因为是环形,可以令第一个元素为1
函数如下:
function GetSequence:Integer;
const
N=10;
PrimeTable: Array [0..4*N-1] of Boolean=(
// 0 1 2 3 4 5 6 7 8 9
False, False, True , True , False, True , False, True , False, False,
False, True , False, True , False, False, False, True , False, True ,
False, False, False, True , False, False, False, False, False, True ,
False, True , False, False, False, False, False, True , False, False);
OrdTable: Array [0..N-1] of Byte=(1,3,5,7,9,11,13,15,17,19);
EvenTable: Array [0..N-1] of Byte=(2,4,6,8,10,12,14,16,18,20);
var
Ords,Evens: Array [0..N-1] of Byte;
FreeOrd,FreeEven: Array [0..N-1] of Boolean;
procedure FetchEven(Start:Byte);
forward;
procedure FetchOdd(Start:Byte);
var i: Byte;
begin
for i:=1 to N-1do
if FreeOrd then
begin
FreeOrd:=False;
if PrimeTable[Evens[Start-1]+OrdTable ] then
begin
Ords[Start]:=OrdTable;
FetchEven(Start);
end;
FreeOrd:=True;
end;
end;
procedure FetchEven(Start:Byte);
forward;
var i:Byte;
begin
for i:=0 to N-1do
if FreeEven then
begin
FreeEven:=False;
if PrimeTable[EvenTable+Ords[Start] ] then
if Start=N-1 then
begin
Events[Start]:=EvenTable;
if PrimeTable[Events[Start]+1]
then
Inc(Result);
//将该语句替换成输出语句就可以看到结果
end else
begin
Events[Start]:=EvenTable;
FetchOrd(Start+1);
end;
FreeEven:=True;
end;
end;
begin
Result:=0;
FillChar(FreeOrd,N,1);
FillChar(FreeEven,N,1);
Ords[0]:=1;
FreeOrd[0]:=False;
FetchEven[0];
end;
 
说明:
GetSequence返回符合条件排列的个数.
其中左旋和右旋被认为是不同的排列.(我没有利用左,右旋来加快回溯).
在满足条件时,Ords,Evens分别按顺序保存奇数和偶数.
 
creation-zy:
你的解答不正确,请再检查一下吧
 
ftop1:
既然简单,为何不见你的解法?你觉得你的解法是最优解吗?
贴出来,大家观摩观摩如何?
别见怪,在下末学后进,资质愚钝,请耐心指教!
 
第一个问题已经解决。第二个也快了:)
 
zjczxd:
你的解法也不正确,我足足等了N分钟,屏幕一片空白!
 
这是第一个问题的解答,BP7。
program Jihemult;
const max=10;
type LineTable=array[1..max] of char;
var i,n,Len,count:integer;
A,P:LineTable;
temp:string;
procedure multSet(t,n:integer;var P,A:LineTable);
var i:integer;
begin
if(n<0) then
begin
writeln('n<0,error!');
exit;
end;
if(n=0) then
begin
writeln(P);
Inc(count);
end
else
begin
for i:=1 to Lendo
begin
P[t]:=A;
multSet(t+1,n-1,P,A);
end;
end;
end;
begin
count:=0;
writeln('enter string A(* to end):');
readln(temp);
Len:=Length(temp);
for i:=1 to Lendo
A:=Temp;
writeln('enter multiple n:');
read(n);
multSet(1,n,P,A);
writeln(Len,'^',n,'=',count);
end.

 
这是第二个问题的解答,不过是用穷举而非递归,哪位朋友把它改为递归?
program Prime;
uses crt;
const Max=20;
type iarray=array[1..20] of integer;
function IsPrime(m:integer):boolean;
var i,k:integer;
begin
isprime:=True;
k:=Round(sqrt(m));
for i:=2 to kdo
if m mod i=0 then
begin
isPrime:=False;
break;
end;
end;
function Exist(m,n:integer;a:iarray):boolean;
var i:integer;
begin
Exist:=False;
for i:=1 to ndo
if a=m then
begin
Exist:=True;
break;
end;
end;
function f(m,n:integer;a:iarray;var b:iarray;var have:boolean):integer;
var i,j,k:integer;
begin
i:=1;j:=1;a:=m;
k:=1;
b:=a;have:=false;{write(a:3);}
repeat
while (not (IsPrime(a+j)) or Exist(j,Max,a)) and (j<=n)do
Inc(j);
if j<=n then
begin
Inc(i);a:=j;
b:=a;
{Inc(j);
write(a:3);}
end;
j:=1;
if (i=Max) and (IsPrime(a+a[1])) then
have:=true;
Inc(k);
until (k>Max);
f:=i;
end;
procedure iswap(var m,n:integer);
var t:integer;
begin
t:=m;m:=n;n:=t;
end;

var i,j,m:integer;
a,b:iarray;
have:boolean;
begin
clrscr;
writeln;
for i:=1 to Maxdo
begin
m:=f(i,20,a,b,have);
if (m=Max) and (have=true) then
begin
writeln;
writeln('Prime Number is :',m);
for j:=1 to Maxdo
write(b[j]:3);
end;
end;
end.
 
开玩笑,我的P4 1.8大约要十秒.总共有六百多万种排列方式.
你如何调用这个程序的?
你的那个程序效率很低的,而且只求一种结果.
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部