3

21 個の変数について次の不等式があります。

http://pastebin.com/raw.php?i=FTU970Em

これに対して「Reduce[ineq,Integers]」を実行すると、Mathematica が長時間ハングします。

これは理にかなっています: 不等式を満たす x[1]..x[21] の値のセットは多数あります。

私が本当に欲しいのは、各変数の境界です (たとえば、「2 <= x[i] <= 7」は各 i に対して)。

Mathematica でこれを効率的に取得するにはどうすればよいですか? これのためのより良いプログラムはありますか？

注: これはより大きなプロジェクトの一部です。

不完全なログ ファイルに基づいてリスクのようなゲームを部分的に再作成する

不等式の恐ろしいリスト全体: http://pastebin.com/CyX9f70J

上記で "Reduce[ineq,Integers]" を実行すると "false" が返されるため、おそらく間違って翻訳しました: http://conquerclub.barrycarter.info/ONEOFF/7460216.html

4

4 に答える 4

3

私は他のスレッドで与えられたCLP（FD）の提案を2番目にしています。SWI-Prolog 5.10の使用：

:- use_module(library(clpfd)).

vars([X0,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18,
      X19,X20,X21]) :-
        X0 #= 3, X1 #>= 1, X1 #=< X0, X2 #>= 1, X2 #=< X1,
        X3 #>= 1, X3 #=< X2, X4 #>= 1, X4 #=< X3, X5 #=< X4 + 3,
        X5 #>= 1, X6 #>= 1, X6 #=< X5, X7 #>= 1, X7 #=< X6,
        X8 #>= 1, X8 #=< X7, X9 #>= 1, X9 #=< X8, X10 #>= 1,
        X10 #=< X9, X11 #>= 1, X11 #=< X10, X12 #>= 1, X12 #=< X11,
        X13 #>= 1, X13 #=< X12, X14 #=< X13 + 4, X14 #>= 1, X15 #>= 1,
        X15 #=< X14, X16 #>= 1, X16 #=< X15, X17 #=< X16 + 6, X17 #>= 1,
        X18 #>= 1, X18 #=< X17, X19 #>= 1, X19 #=< X18, X20 #>= 1,
        X20 #=< X19, X21 #>= 1, X21 #=< X20, X21 #= 1.

クエリの例：

?- vars(Vs), maplist(fd_dom, Vs, Ds).
Ds = [3..3, 1..3, 1..3, 1..3, 1..3, 1..6, 1..6, 1..6, ... .. ...|...]

?- vars(Vs), label(Vs).
Vs = [3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] ;
Vs = [3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1] ;
Vs = [3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1] ;
etc.
于 2010-10-03T00:06:47.220 に答える
0

おそらく多くの巧妙な削減があるのに十分遅いですが、これは機能します...

    ineq = {...};
    ピボットAt[set_、j_]：= Select [set、And [
            Not [FreeQ [＃、x [u_] /; u <= j]]、
                FreeQ [＃、x [u_] /; u> j]
        ]＆]
    triangleize [set_]：= Module [{left、i、new}、
        左=設定;
        刈り取り[
            For [i = 0、i <= 21、i ++、
                new =ivotAt [左、i];
                種をまく[新しい];
                left = Complement [left、new];
        ]] [[2、1]]
    ]
    モジュール[{
        トライ、
        workingIntervals、
        パーシャル、インクリメント、i
        }、

        tri = triangleize [ineq];

        workingIntervals [set_]：=set/。{{
            t_ <= c_：> {t、間隔[{-\ [無限]、最大[c]}]}、
            t_ == c_：> {t、Interval [{Min [c]、Max [c]}]}、
            t_> = c_：> {t、Interval [{Max [c]、\ [Infinity]}]}};

        パーシャル={};
        増分[スライス_]：=
            Rule [＃[[1、1]]、IntervalIntersection @@＃[[All、2]]]＆[
                workingIntervals[スライス/。パーシャル]];
        For [i = 1、i <= Length [tri]、i ++、
            パーシャル=Join[partials、{increment [tri [[i]]]}];
        ];
        パーシャル
    ]

変数間の相関（「この高いことは低いことを意味する」）が考慮されていないという点で許容されます。

- 編集 -

上記の結果はもちろんです

{x [0]->間隔[{3、3}]、x [1]->間隔[{1、3}]、
 x [2]->間隔[{1、3}]、x [3]->間隔[{1、3}]、
 x [4]->間隔[{1、3}]、x [5]->間隔[{1、6}]、
 x [6]->間隔[{1、6}]、x [7]->間隔[{1、6}]、
 x [8]->間隔[{1、6}]、x [9]->間隔[{1、6}]、
 x [10]->間隔[{1、6}]、x [11]->間隔[{1、6}]、
 x [12]->間隔[{1、6}]、x [13]->間隔[{1、6}]、
 x [14]->間隔[{1、10}]、x [15]->間隔[{1、10}]、
 x [16]->間隔[{1、10}]、x [17]->間隔[{1、16}]、
 x [18]->間隔[{1、16}]、x [19]->間隔[{1、16}]、
 x [20]->間隔[{1、16}]、x [21]->間隔[{1、1}]}
于 2010-11-04T03:54:25.410 に答える
0

不等式を満たす値のセットはたくさんありますか?

Mathematica で次のコマンドを実行しました。

In[14]:= ineqs = {x0 == 3, x1 >= 1, x1 <= x0, x2 >= 1, x2 <= x1, 
       x3 >= 1, x3 <= x2, x4 >= 1, x4 <= x3, x5 <= x4 + 3, x5 >= 1, 
       x6 >= 1, x6 <= x5, x7 >= 1, x7 <= x6, x8 >= 1, x8 <= x7, x9 >= 1, 
       x9 <= x8, x10 >= 1, x10 <= x9, x11 >= 1, x11 <= x10, x12 >= 1, 
       x12 <= x11, x13 >= 1, x13 <= x12, x14 <= x13 + 4, x14 >= 1, 
       x15 >= 1, x15 <= x14, x16 >= 1, x16 <= x15, x17 <= x16 + 6, 
       x17 >= 1, x18 >= 1, x18 <= x17, x19 >= 1, x19 <= x18, x20 >= 1, 
       x20 <= x19, x21 >= 1, x21 <= x20, x21 == 1};

In[15]:= vars = 
      Union[{x0, x1, x1, x2, x2, x3, x3, x4, x4, x5, x5, x6, x6, x7, x7, 
        x8, x8, x9, x9, x10, x10, x11, x11, x12, x12, x13, x13, x14, x14, 
        x15, x15, x16, x16, x17, x17, x18, x18, x19, x19, x20, x20, x21, 
        x21, x21}];

In[16]:= FindInstance[ineqs, vars]

そして結果を得ました：

Out[16]= {{x0 -> 3, x1 -> 1, x10 -> 1, x11 -> 1, x12 -> 1, x13 -> 1, 
  x14 -> 1, x15 -> 1, x16 -> 1, x17 -> 1, x18 -> 1, x19 -> 1, x2 -> 1,
   x20 -> 1, x21 -> 1, x3 -> 1, x4 -> 1, x5 -> 1, x6 -> 1, x7 -> 1, 
  x8 -> 1, x9 -> 1}}

Mathematica に別の一連の課題を提供するよう説得することはできませんでした.鉛筆と紙で少し作業しただけでは、別の一連の課題に向かうことはありません. しかし、ここで遅くなりました。明らかな何かを見逃している可能性があります。

于 2010-10-01T23:03:28.307 に答える
0

OK、いくつかの方程式を少し書き直せば、この特定の方程式セットを解くのは簡単であることがわかります。

x5 <= x4 + 3 becomes x5 - 3 <= x4 
x6 <= x5 becomes x6 - 3 <= x5 - 3

など、次のようになります。

x13 <= x12 becomes x13 - 3 <= x12 - 3 
x14 <= x13 + 4 becomes x14 - 7 <= x13 -3

これにより、{x0, x1, x2, x3, x4, x5-3, x6-3, ..., x13-3, x14-7, ..., x21} は、 3 で 1 で終了します。

実際、xi>=1 は簡単に満たされるため、そのプロパティを持つ任意のシーケンスが機能します。

ただし、これはこの特定の一連の不等式を解決するために機能しますが、一般的には機能しないため、完全な解決策とは考えていません。

于 2010-10-02T00:00:54.360 に答える