m*n矩阵的每个分量只填"0"或"1"---- 0-1矩阵
求解所有包含i个"1"的这样的0-1矩阵[max(m,n)-1< i < mn+1 的整数]
要求所求得的矩阵不能出现某行或某列出现全"0"现象
500分，求解！
注：我使用"回溯"算法实现，对于5*5，计算的时间就让我等的不耐烦了！
：lccc 时间：00-11-2 2:16:37 ID:383253
假设矩阵为m行n列：
A11 , A12 , ..., A1n
...................
Am1 , Am2 , ..., Amn
设 Ci表示第i行之和(1<=i<=m)， Di表示第i列之和(1<=i<=n)，
Sx表示所有Ci之积，Sy表示所有Di之积。
我想，对于任何一个给出的矩阵，计算Ci、Di、Sx、Sy是
很容易、快速的，如果Sx*Sy=0排除即可。(Sx<>0，排除有
一行全为0的情况,Sy<>0排除有一列全为0的情况。)
供君参考，若可以，希望能告诉我你用它的作用
请大家注意:
求出所有的矩阵是关键,至于是不是要求不存在全"0"行或列并不是主要的.
正如cheka所说的,有点想八后问题,所以最先我就是用了"回溯"算法,可惜对于
5*5的矩阵,就有点受不了了(其实,需要运算的还有一层:对于给定整数N, (m,n)
是满足m+n=N(m>0,n>0)的一组分解,对于每种分解,都要求出所有可能的0-1矩阵.)
回头我把握的弱智算法贴上来,请各位帮忙想想能不能有更好的解法.我的Pascal
解法在N=10时,PIII667+128MB上的机器,就求了10多分钟,要是N=100,岂不是要100年?
我的弱智算法，请大家帮忙看看，由没有问题（Delphi5环境下，Filename=tp.dpr）
Program tp;
{$APPTYPE CONSOLE}
uses SysUtils;
const
MAXN = 10;
type
TMAX = 1..MAXN;
TMAX2= 1..(MAXN div 2)*(MAXN div 2);
TAset= array[1..MAXN] of shortint;
PSet = ^TSet;
TSet = Record
row,col:TAset;
next:PSet;
End;
var
i,j,m,n,max: TMAX;
A: array[1..MAXN,1..MAXN] of shortint;
num: longint;
PHead: PSet;
///////////////////////////////////////////////
procedure printA(m,n:TMAX; e:TMAX2);
var
i,j:TMAX;
begin
for i:=1 to m do
begin
for j:=1 to n do
write(A[i,j]);
writeln;
end;
inc(num);
writeln(m,'*',n,' array ',e,' edges. (',num,')');
writeln;
end;
///////////////////////////////////////////////
function IsSafe(x,y:TMAX; ce,e:TMAX2):Boolean;
var
i,j:TMAX;
s:shortint;
begin
IsSafe := TRUE;
A[x,y] := 1;
if (m-x)*n+(n-y)ox then oy:=1;
for y:=oy to n do
if IsSafe(x,y,ce,e) then
begin
A[x,y]:=1;
if ceox then oy:=1;
for y:=oy to n do
if IsSafe(x,y,ce,e) then
begin
A[x,y]:=1;
if ce
--------------------------------------------------------------------------------
来自：愚夫 时间：00-11-3 12:30:07 ID:384870
为什么剩下的一段程序粘不上去？
--------------------------------------------------------------------------------
来自：wjiachun 时间：00-11-3 12:33:20 ID:384876
我来帮你贴上去！
function IsSafe(x,y:TMAX; ce,e:TMAX2):Boolean;
var
i,j:TMAX;
s:shortint;
begin
IsSafe := TRUE;
A[x,y] := 1;
if (m-x)*n+(n-y)ox then oy:=1;
for y:=oy to n do
if IsSafe(x,y,ce,e) then
begin
A[x,y]:=1;
if ce<e then
search(x,y+1,ce+1,e,m,n)
else
printA(m,n,e);
A[x,y]:=0;
end;
end;
end;
///////////////////////////////////////////////
Begin
num:=0;
PHead:=nil;
for i:=1 to MAXN do
for j:=1 to MAXN do
A[i,j]:=0;
for i:=1 to (MAXN div 2) do
begin
m:=i; max:=m;
n:=MAXN - m;
if max<n then max:=n;
for j:=max to m*n do // max(m,n)
begin
search(1,1,1,j,m,n); // search(ox,oy,ce,e,m,n)
end;
end;
writeln('you get ',num:10,' array(s)');
readln;
End.
：KentKing 时间：00-11-4 4:56:44 ID:385548
愚夫兄，当你求得i（在你程序中是j）=Max(m,n)时的一个解时，除了这i个填"1"的位置外
其它位置随便填"0"、填"1"不都是你的解吗？
犯得着加一层循环>> for j:=max to m*n do 去逐个搜索吗？:)
另外如果你还想提高一下求解速度的话，建议你直接把m*n的0-1矩阵看成是m*n位的二进制
数。这样问题就转化为求解0..2^(m*n)-1整数区间内特定Max(m,n)位为1的数。
Step1. 用回溯法解得i=Max(m,n)时的k个解, 暂存为 R[1..k]；
Step2. i := 2^(m*n)-1；
while i > 0 do
begin
for j := 1 to k do
begin
if (i and R[j]) = R[j] then
begin // i 为 解
将i转化为m*n矩阵输出;
break;
end;
end;
i := i + 1;
end;
当然，如果m*n太大(超过32)，你不得不用浮点数表示i和R[j]时。就必须再写个函数实现将
浮点数转换为 ((m*n+7) div 8) 个字节存贮的整数。比较 (i and R[j])=R[j] 时也得逐字
节运算了。不过我想应该还是比用二维数组快多了吧。
以上意见， 仅供参考。希望各位高手多多指正。
--------------------------------------------------------------------------------
来自：KentKing 时间：00-11-4 5:04:56 ID:385549
哈哈， 笔误笔误
Step2 中应为 i := i - 1
--------------------------------------------------------------------------------
来自：愚夫 时间：00-11-6 15:28:17 ID:387852
TO KentKing:
解释一下，主程序中的for j:=max to m*n 是为了求解组合（m,n)时，
分别放入max个"1"、max+1个"1"、max+2个"1"... m*n个"1"的
所有0-1矩阵的种类。实际上，整个问题是要求解对于给定整数MAXN，
在所有满足m+n=MAXN的组合(m,n)下，有j个"1"（j取max(m,n)到m*n)
的所有0-1矩阵，我不知道我的程序是否有问题，请您务必指教。谢谢！
--------------------------------------------------------------------------------
来自：KentKing 时间：00-11-7 12:37:48 ID:388618
Sorry, 我想我没说清楚我的意思。
>> 当你求得i（在你程序中是j）=Max(m,n)时的一个解时，除了这i个填"1"的位置外
>> 其它位置随便填"0"、填"1"不都是你的解吗？
>> 犯得着加一层循环>> for j:=max to m*n do 去逐个搜索吗？:)
我的意思是：求解j=(max+1..m*n)这个区间内的解时可以在j=max的解的基础上用更简单
的方法(参见我上个帖子的Step2)求得。而不必对每一个j(max> for i:=1 to (MAXN div 2) do 这个外层循环应该是没什
么问题的。另外由于你的程序好象是没有贴完(我没有找到 search), 我也就没有仔细读
你代码的其它部分了。
--------------------------------------------------------------------------------
来自：KentKing 时间：00-11-7 12:43:31 ID:388620
Sorry, 我想我没说清楚我的意思。
>> 当你求得i（在你程序中是j）=Max(m,n)时的一个解时，除了这i个填"1"的位置外
>> 其它位置随便填"0"、填"1"不都是你的解吗？
>> 犯得着加一层循环>> for j:=max to m*n do 去逐个搜索吗？:)
我的意思是：求解j=(max+1..m*n)这个区间内的解时可以在j=max的解的基础上用更简单
的方法(参见我上个帖子的Step2)求得。而不必对每一个j(max> for i:=1 to (MAXN div 2) do 这个外层循环应该是没什
么问题的。另外由于你的程序好象是没有贴完(我没有找到 search), 我也就没有仔细读
你代码的其它部分了。
来自：KentKing 时间：00-11-7 12:48:54 ID:388628
（kao!!为什么老出错，再贴一次 )
****************************************************************
Sorry, 我想我没说清楚我的意思。
>> 当你求得i（在你程序中是j）=Max(m,n)时的一个解时，除了这i个填"1"的位置外
>> 其它位置随便填"0"、填"1"不都是你的解吗？
>> 犯得着加一层循环>> for j:=max to m*n do 去逐个搜索吗？:)
我的意思是：求解j=(max+1..m*n)这个区间内的解时可以在j=max的解的基础上用更简单
的方法(参见我上个帖子的Step2)求得。而不必对每一个j( max< j <=m*n )都采用j=max
时的方法来求解。(Understand? 我觉得这几句话读起来是有些拗口 :)
至于求解整个问题，我想 >> for i:=1 to (MAXN div 2) do 这个外层循环应该是没什
么问题的。另外由于你的程序好象是没有贴完(我没有找到 search), 我也就没有仔细读
你代码的其它部分了。
来自：KentKing 时间：00-11-7 13:53:13 ID:388684
槽糕，槽糕，我的方法是错的。无法求得j=(max+1..m*n)时的所有解。
不过我有了个新的方法。实现后，晚上再贴上来吧。
白天访问大富翁实在是太慢太慢了...!!!
我真命苦!我真命苦!我真命苦!我真命苦!我真命苦!我真命苦!我真命苦!我真命苦!
来自：KentKing 时间：00-11-7 21:30:19 ID:388961
程序如下：
program KK;
uses
SysUtils;
const
MAXN = 10;
ITEMCOUNT = (MAXN div 2)*(MAXN-(MAXN div 2));
var
Num,Num0, v: Longword;
m, n: Integer;
s0,s: String;
///////////////////////////////////////////////
// 转化v为二进制字串s, 返回值为s中'1'的个数
function ToBinaryStr(v: Longword): Integer;
var
v0: Longword;
p: Integer;
begin
s := s0;
p := 0;
Result := 0;
while (v > 0) do
begin
Inc(p);
v0 := v shr 1;
if (v0 shl 1) <> v then
begin
s[p] := '1';
Result := Result + 1;
end;
v := v0;
end;
end;
// 检查是否为解
function IsValid: Boolean;
var
i, j: Integer;
begin
Result := False;
// 此处按原题意应是比较 ToBinaryStr(v) < Max(m, n)
// 考虑到m取值区间为1..(MAXN div 2),所以总有n=Max(m, n)成立
if ToBinaryStr(v) < n then Exit;
// 检查行
for i := 0 to m-1 do
begin
for j := 1 to n do
begin
if s[i*n + j] = '1' then break;
end;
if j > n then Exit;
end;
// 检查列
for j := 1 to n do
begin
for i := 0 to m-1 do
begin
if s[i*n + j] = '1' then break;
end;
if i = m then Exit;
end;
Result := True;
end;
// 按m*n(m行n列)的矩阵输出
procedure OutputMatrix;
var
i: Integer;
begin
for i := 0 to m-1 do
begin
writeln(Copy(s, i*n + 1, n));
end;
writeln;
end;
///////////////////////////////////////////////////
begin
writeln('Start Time: ', TimeToStr(Now));
writeln;
Num := 0;
s0 := '';
for m := 1 to ITEMCOUNT do s0 := s0 + '0';
for m := 1 to (MAXN div 2) do
begin
n := MAXN - m;
Num0 := Num;
for v := 1 to (1 shl (m*n))-1 do
begin
if IsValid then
begin
OutputMatrix;
Inc(Num);
end;
end;
writeln(m, '*', n, ': ', Num - Num0,' Solution(s)');
writeln;
end;
writeln('Total: ', Num,' Solution(s)');
writeln;
writeln('End Time: ', TimeToStr(Now));
end.
测试结果：
D4下编译，PII266, 96M内存，Win98
MAXN=9时：耗时17秒，共811252组解，重定向生成的输出文件22.7MB
为排除I/O耗时的影响，注释掉 OutputMatrix 后运行，耗时5秒
MAXN=10时：由于我的硬盘剩余空间只有600多MB，第一次运行中途因硬盘空间耗尽而退出
注释掉 OutputMatix 后运行，耗时3分13秒（193秒），共36745865组解
其它一些与测试有关的数字：
符号说明：N#(MAXN=#时解的数目)
T#(MAXN=#时算法耗时)
V#(MAXN=#时v的最大取值）
N10 / N9 = 36745865 / 811252 = 45.295
T10 / T9 = 193 / 5 = 38.6
V10 / V9 = (2^(5*5)-1) / (2^(4*5)-1) 约等于 2^5 = 32
按T9*(N10/N9)来粗略估计,MAXN=10时生成输出文件大概需耗时770秒(12分50秒)
单独考虑m=5,n=5时，5*5的0-1矩阵总的取值区间大小为2^(5*5) = 33554432
而此时的解为24997921个，占总取值区间的74.5%。这个数字能不能给我们一些
反向求解此问题的启发呢？
以上程序及结果，仅供参考, 欢迎探讨 :)