缺页问题 - 趣味题求解

shamohu

一本书被撕了某一页，余下的页码之和为1133，请问这本书共几页？

假定最大为500页，n为书页数，x为撕掉的页数：

Algorithm = DE1;
Parameter n=[3,500,0], x=[1,500,0];
StartProgram [Pascal];
Procedure MainModel;
var i, k: integer;
Begin
    k := 0;
    for i := 1 to n do  k := k + i;
    ObjectiveResult := sqr(k-x-1133);
    ConstrainedResult := x<=n;
End;
EndProgram;

结果：
目标函数值(最小): 0
n: 48
x: 43

即书共48页，43页被撕掉。

linyoujie

两个问题，1、这么简单的问题不需要用到编程，复杂化了！简单的试凑一下就出来了。1+2+＋...48=1176;1+2+....47 = 1128; 1176-1128=43=21+22;
     2、编程模式的语法和实例，1stopt中都语焉不详！对于本题，除了1stopt公司的人和发烧友外，多数人应该不知道其算法和语法，无法欣赏其优美。希望国产软件在用户手册上要花点心思。
    如要举编程例子，下面这道题可能更合适：
    四人年龄两两相加，分别为45，56，60，71，82，（有两人没有相加），请问年龄各是多少？

shamohu

趣味问题一般有多种解法，这里仅演示如何用1stOpt处理这些问题。1stOpt的用户手册是不太详细，通过这些简单的例子，使有兴趣者增加一些了解。下面是年龄问题的求解代码（应该还有更好的方法），用1stOpt 3.0求解，可100%得到唯一解（只是顺序不同）。

Algorithm = SM3;
Parameter x(4)=[1,100,0], p(10)=[1,4];
Constant L = [45,56,60,71,82];
StartProgram [Pascal];
Procedure MainModel;
var temb: double;
    j, n1, n2: integer;
    k1: integer;
    k: array[1..4] of integer;
    m: array[1..10] of integer;
Begin
    for j := 1 to 10 do m[j] := round(p[j]);       //转换成整数
    for j := 1 to 4 do k[j] := 0;
    for j := 1 to 10 do begin
        k1 := m[j];
        if k1 = 1 then k[1] := k[1] + 1
        else if k1 = 2 then k[2] := k[2] + 1
        else if k1 = 3 then k[3] := k[3] + 1
        else k[4] := k[4] + 1;
    end;
    temb := 0;
    for j := 1 to 5 do begin
        n1 := m[2*j-1]; n2 := m[2*j];
        temb := temb + sqr(x[n1]+x[n2]-L[j]);
    end;
    ObjectiveResult := temb;                            //目标函数：应为零
    ConstrainedResult := For(j=1:4)(k[j]>=2);  //约束条件：每人最少出现两次
    ConstrainedResult := For(j=1:4)(k[j]<=3);  //约束条件：每人最多出现三次
End;
EndProgram;

结果：
优化算法: 鲁棒简面体爬山法 + 通用全局优化法
目标函数值(最小): 0
x1: 28
x2: 17
x3: 43
x4: 39
p1: 1.45118368597213
p2: 2.02817945531538
p3: 3.80049059179586
p4: 1.78784872433298
p5: 1.6155817172149
p6: 2.50591559351723
p7: 1.40690829743886
p8: 3.27614114687388
p9: 3.69577126839416
p10: 2.68708826874321

即4人年龄分别为：28、17、43和39

linyoujie

如果半岁也可以的话，还有另一解：（生活中还是见过这么说的，特别是小孩，虽然不多，呵呵。。。）
11.5，22.5，33.5，48.5

从纯数学角度看，应该只有这两组解了（17、28、43、39）和（11.5、22.5、33.5、48.5）

shamohu

如果年龄允许非整数，1stOpt通用代码如下：

Algorithm = RGO1[100];
Parameter x(4)=[1,100], p(10)=[1,4];
Constant L = [45,56,60,71,82];
PassParameter H(5);
StartProgram [Pascal];
Procedure MainModel;
var temb: double;
    j, n1, n2: integer;
    k1: integer;
    k: array[1..4] of integer;
    m: array[1..10] of integer;
Begin
    for j := 1 to 10 do m[j] := round(p[j]);       //转换成整数
    for j := 1 to 4 do k[j] := 0;
    for j := 1 to 10 do begin
        k1 := m[j];
        if k1 = 1 then k[1] := k[1] + 1
        else if k1 = 2 then k[2] := k[2] + 1
        else if k1 = 3 then k[3] := k[3] + 1
        else k[4] := k[4] + 1;
    end;
    temb := 0;
    for j := 1 to 5 do begin
        n1 := m[2*j-1]; n2 := m[2*j];
        if n1 = n2 then temb := temb + 1000000
        else temb := temb + sqr(x[n1]+x[n2]-L[j]);
        H[j] := x[n1]+x[n2];
    end;
    ObjectiveResult := temb;                            //目标函数：应为零
    ConstrainedResult := For(j=1:4)(k[j]>=2);  //约束条件：每人最少出现两次
    ConstrainedResult := For(j=1:4)(k[j]<=3);  //约束条件：每人最多出现三次
End;
EndProgram;

随机运算，可得四组结果：
1：（39，43，28，17）
2：（24.5，35.5，46.5，9.5）
3：（11.5，22.5，33.5，48.5）
4：（20.5，24.5，35.5，46.5）

不知是否有误，大家可验证一下。

linyoujie

用了穷举法，算了720（6！）个方程组。也得出了上述4组解（顺序不同，也算一组解），如下：
不知道对于这类题目有没有简便的方法？
shamohu 的程序太复杂了点，能不能解释一下。
x1=17       x2=28      x3=39       x4=43      
x1=20.5    x2=24.5    x3=35.5    x4=46.5   
x1=11.5    x2=22.5    x3=33.5    x4=48.5   
x1=9.5     x2=24.5     x3=35.5    x4=46.5

shamohu

shamohu 的程序太复杂了点，能不能解释一下。
linyoujie 发表于 2009-6-24 08:38

实际上不论代码多复杂，最终目的就是求目标函数值和约束函数。对于优化问题，将其转化成数学模型，即何为目标函数，何为约束函数，是非常重要的步骤。参考最顶的缺页问题，不是很复杂，只有目标函数和一个约束，比较好理解了。

fighter-11

1# shamohu
Pascal的看不懂，不过大概思路应该能大概猜出来吧。

介绍一个新算法来算缺页问题，只能应用于一张缺页哦。
求取n，使得
(n-1)*n/2<1133<(n+1)*n/2
则n为总页数，(n+1)*n/2-1133为所缺页数。

shamohu

楼上的算法很妙！下面的1stOpt代码可求解这样的不等式方程：

Parameter n=[1,500,0];
PassParameter (n+1)*n/2-1133;
MinFunction n;
                  (n-1)*n/2<1133<(n+1)*n/2;
结果：
目标函数值(最小): 48
n: 48

传递参数(PassParameter):
(n+1)*n/2-1133: 43

约束函数:
   1: 1133-((n-1)*n/2) = 5
   2: 1133-((n+1)*n/2) = -43

看看年龄问题有无好的算法？

zhuofeng

8# fighter-11
这个应该和二楼是一个思路

linyoujie

5# shamohu

请问你的随机运算要算多长时间？

用你的程序，在我的机子Cpu 2.66GHz，内存760MHz上运行了40分钟，还未见结果。
软件版本为1stOpt 3.0(加密狗企业版)，请问哪方面出了问题？

我用穷举法，算了720（6！）个方程组在其它软件中也花不到1分钟的时间！

shamohu

40分钟？有点不对吧！我的配置比你还低，计算时间也就两秒的样子。

linyoujie

不知道怎么回事，准备再试一下手册上的编程例子，不行的话我要问问七维高科了。

flame0510

5# shamohu  

请问你的随机运算要算多长时间？

用你的程序，在我的机子Cpu 2.66GHz，内存760MHz上运行了40分钟，还未见结果。
软件版本为1stOpt 3.0(加密狗企业版)，请问哪方面出了问题？

我用穷举法，算 ...
linyoujie 发表于 2009-7-1 17:09

我觉得很有可能是你的程序出错了。

FreddyMusic

最近忙着写书，都没咋的玩。拿你的书页玩一玩。

Mathematica 大概只要 0.2 秒出答案。穷举法。

1. 
   
2. 
   
3. Timing[
   
4. x=1;
   
5. While[x<50,y=x;
   
6. Do[If[Sum[i,{i,x}]-y==1133,Print[{x,y}]];y--,{x}];
   
7. x++];
   
8. ]
   
9. 
   
10. In[2]:= {48,43}
    
11. Out[2]= {0.147,Null}
    
12. 
    

复制代码

fighter-11

10# zhuofeng

我只是利用了第一个题目的数学特征而已，和穷举法并无二致，只是采用了解析表达，算得自然比楼主的算法快多了。第二个问题？还在想，肯定也有比较好的数学特征。

smarten

也用Mathematica玩了一下，

1. Reduce[{n (n + 1)/2 > 1133 > (n - 1) n/2,
   
2.   n (n + 1)/2 - x == 1133}, {n, x}, Integers]

复制代码

得到：n == 48 && x == 43
或者

1. Reduce[{n > x >= 1, n (n + 1)/2 - x == 1133}, {n, x},
   
2.   Integers] // Timing

复制代码