左に書いてある数字から（その数字は一回しか使えません）選び、足した値が 220,103にできるだけ近くする数式はありますか？

質問

1,890　左に書いてある数字から（ただしその数字は一回しか使えません）選び、足した値が　220,103にできるだけ近くする数式はありますか？
2,100
2,000
3,000
3,203
1,597
5,642
2,834
5,228
4,336
5,953
500
3,358
5,000
2,268
2,944
1,130
4,000
2,706
1,643
1,000
2,947
500
3,835
1,955
3,540
2,866
2,843
3,705
2,421
500
3,000
300
6,143
3,876
2,000
3,425
1,000
4,220
3,260
4,323
3,837
3,518
2,000
2,284
2,563
4,274
2,000
1,000
5,105
1,000
4,200
1,000
2,000
2,091
4,770
4,085
3,265
4,160
3,636
4,109
4,417
4,526
3,706
3,500
1,000
500
5,141
10,000
6,016
3,000
2,000
4,707
4,330
2,000
3,946
3,993
680
501
4,268
6,201
5,000
3,200
4,020
4,916
3,472
2,000
5,000
4,627
1,000
2,278
4,234
1,483
4,198
3,000
5,000
1,000
4,131
2,000
5,617
4,043
8,820
4,331
4,327
4,258
978
3,559
2,000
1,000
1,000
3,829
2,000
5,000
4,628
2,234
2,310
4,118

回答No.15

warumx

4#,8#,12#の者です。

>解１の答えを今回はつかわさせていただきました。

そうですか。お役に立ったようで良かったです。
今度は数値98個の問題を解かれるようですが、
どんなものでしょう。

回答No.14

_Kyle

#2,7,11です。

テクニカルタームやURLが随分飛び交った割に
「数式でも実現可能な打鍵猿よりも速いアルゴリズム」とか
「毎分100万件！　目からウロコの超高速VBAコード」とか
具体的な解決方法が出てくる気配は一向にありませんね。

おそらく質問者さんはもういらっしゃらないと思いますので、
私も最終的な見解を述べてそろそろ消えたいと思います^^;;

以下、「解決には直接寄与しないであろう技術的なハナシ」が多くなりますが、
#5様のお言葉をお借りすれば
「常連としてては、ご質問者さんだけの問題でもないので」(ママ)
どうかご容赦ください。（私は『常連』ってわけでもないけど）

なお、私はあくまで文系事務屋なので、
計算複雑性理論やプログラミング技術に関して
一般常識以上の知識や理解は持ち合わせていません。
概念や術語の理解や用法に誤りがありましたら、是非ご指摘ください。

特に、#4様は『何かの専門家』でいらっしゃるようなので、
『専門家』のお立場からいろいろと仰りたいこともあろうかと思いますが
「一般的な解法は知られていない難問」というような
ミスリードに類する言葉遣いは避けたつもりですので
ご寛恕を乞いたいと思います。
---------------------------------------------
■#8でご紹介のあったVBAコード(subsetsum)について

【どれほど尊大で無精な人でも簡単に試せるよう】
少し直してみました。(subsetsum2)

A1セル以下に元リスト、B1セルに合計を入力して起動すれば、
C列以降に最適解を順次書き出します。

あのコードは、部分和問題※を再帰的アルゴリズムで解く方法としては
【総当りの次に原始的な】形で、『やさしくわかるVBA入門』レベルのコードですが、
探すだけであれば、毎分１万件以上の最適解を見つけます。

また、読み込み・書出し機能を加えたsubsetsum2は、
最小限の変更で動作するよう、間抜けな書出し方をしているため、
探索時間の十倍以上の時間を書出しのために要しますが
それでも、質問文の課題であれば、毎分千件ほどのペースで最適解を発見します。

※普通は"部分集合和問題"とは呼ばないようです。
　術語を振り回すなら、一般的な訳語を用いるべきだと思いますが、
　回答者によっては「日本語サイトがヒットしない方が都合が良い」のかもしれません。
http://www.google.com/search?hl=ja&client=opera&rls=ja&hs=aZU&q=%22%E9%83%A8%E5%88%86%E5%92%8C%E5%95%8F%E9%A1%8C%22&btnG=%E6%A4%9C%E7%B4%A2&lr=
http://www.google.com/search?hl=ja&client=opera&rls=ja&hs=8Ep&q=%22%E9%83%A8%E5%88%86%E9%9B%86%E5%90%88%E5%92%8C%E5%95%8F%E9%A1%8C%22&btnG=%E6%A4%9C%E7%B4%A2&lr=
---------------------------------------------
■#4でご紹介のあったREXXコード(DPS)について

これも、VBAに書き直してみました(DPSforExcelVBA)
私と同じくらい暇な人がもしいたとして、
VBAに直してからがっくりきてはアレなので…。

基本的には「そのまんま」移したつもりですが
動作の仔細を追ったわけではありませんから
もしかすると無駄やミスがあるかもしれません。

また、2^117などという巨大数はExcelに馴染みませんから、
計算済みの組合せは整数ではなくString型で管理しています。

仕様としてはsubsetsum2と同様ですが
複数の最適解を見つけることは【原理的に困難】なため、
最初の最適解を書き出した時点で終了します。

私の書き方・環境だと、最初の解を見つけるのに10秒近く要しますね。
（コーディング次第でもっと速くなるのかもしれませんが…）

動的計画法自体は、部分和問題を解く方法としてよく知られたものですが、
この規模の課題を解くためのアプローチとしては今一つ利点が見えませんし、
「一つ見つければ良いのか／できるだけ沢山見つけたいのか」
がはっきりしない状況で提示するには潰しの効かないアプローチに思えます。
---------------------------------------------
■#7でご紹介したqa4528015について

B1セルに合計、D1セル以下に元リストを入力して起動すると、
毎分２万～５万件程度のペースで最適解をみつけてF列以降に書き出します。

アプローチとしては、上述subsetsumをもう少し利口にした程度のものです。
　・合計が大きい場合は反転して「使わないもの」を探す
　・残りすべてを使っても足りないなら戻る
　・残りのどれを使っても超えるなら戻る

計算量を減らす方法としては他にも幾つか思いつきますが、
「要素数100程度なら、計算量を減らすより判定を減らした方が全体として速い」
というのが当時私が得た結論でした。

アルゴリズムよりもむしろ、結果の管理方法など
コーディング部分を見直した方が速くなるかもしれません。

以上、ご参考…にはならんと思いますが、一応。

'=======================↓　ココカラ　↓=======================
'【どんな尊大で無精な人でもすぐに試せるよう】最低限直しただけです。
'私が書いたわけではありません。
'ソルバーよりはマシですが、実用するには素朴すぎます。
'-----------------------------
Dim solutions As Long
Dim flags() As Boolean
Dim numbers() As Long
Dim arraySize As Long

Sub findSolutions2(k As Long, targetSum As Long)
　Dim i As Long
　If targetSum = 0 Then
　　' we found a solution
　　solutions = solutions + 1
　　'■結果書出
　　For i = 0 To arraySize - 1
　　　If flags(i) Then
　　　　Cells(i + 1, solutions + 2).Value = numbers(i)
　　　End If
　　Next i
　　Exit Sub
　End If

　If k <= UBound(numbers) Then
　　If (targetSum >= numbers(k)) Then
　　　flags(k) = True
　　　' try first by subtracting numbers[k] from targetSum
　　　Call findSolutions2(k + 1, targetSum - numbers(k))
　　　flags(k) = False
　　End If

　　' now try without subtracting
　　Call findSolutions2(k + 1, targetSum)
　End If
End Sub

Sub subsetsum2()
　Dim targetSum As Long
　Dim i As Long

　arraySize = Cells(Rows.Count, 1).End(xlUp).Row
　ReDim numbers(0 To arraySize - 1)
　ReDim flags(0 To arraySize - 1)

　'■課題読込
　'　って書いとかないと、
　'　「何のために必要なのか疑問が残る」とか言われるので。
　' initialize numbers array
　For i = 0 To arraySize - 1
　　numbers(i) = Cells(i + 1, 1).Value
　　flags(i) = False
　Next
　targetSum = Cells(1, 2).Value

　solutions = 0
　Call findSolutions2(0, targetSum)
　MsgBox "Found " + Str(solutions) + " solutions."
End Sub
'=======================↑　ココマデ　↑=======================

'=======================↓　ココカラ　↓=======================
'#4様が【わざわざ英字サイトから】拾ってきた他言語のコードを
'VBAに書き直しただけです。私ならこのアプローチは取りません。
'-----------------------------
Sub DPSforExcelVBA()

　'■宣言
　'　動的計画法は変数が多くなるのがやなのよね。
　'　…だからREXXなのか！(笑
　Dim itmAry()　As Long
　Dim itmCnt　　As Long
　Dim tgtSum　　As Long

　Dim tp1Cmb()　As String
　Dim tp2Cmb()　As String
　Dim tp1Sum()　As Long
　Dim tp2Sum()　As Long
　Dim bufSum　　As Long
　Dim nulCmb　　As String

　Dim i As Long
　Dim j As Long

　Dim p As Long
　Dim q As Long
　Dim r As Long
　Dim s As Long

　'■課題読込
　'　って書いとかないと、
　'　「何のために必要なのか疑問が残る」とか言われるので。
　itmCnt = Cells(Rows.Count, 1).End(xlUp).Row
　ReDim itmAry(1 To itmCnt)
　For i = 1 To itmCnt
　　itmAry(i) = Cells(i, 1).Value
　Next i
　tgtSum = Cells(1, 2).Value

　'■初期化
　ReDim tp1Cmb(0 To tgtSum)
　ReDim tp2Cmb(0 To tgtSum)
　ReDim tp1Sum(0 To tgtSum)
　ReDim tp2Sum(0 To tgtSum)

　nulCmb = String(itmCnt, "0")
　tp1Sum(1) = itmAry(1)
　tp1Cmb(0) = nulCmb
　tp1Cmb(1) = nulCmb
　Mid(tp1Cmb(1), 1, 1) = "1"
　s = 1

　'■主処理
　For i = 2 To itmCnt
　　If tp1Sum(s) = tgtSum Then Exit For
　　p = 0
　　q = 0
　　r = 1
　　bufSum = itmAry(i)
　　'↓ココちょっと不安
　　'　とにかく大きくしとけばいいんだろうけど…。
　　tp1Sum(s + 1) = tgtSum + 1
　　tp2Sum(0) = 0
　　tp2Cmb(0) = nulCmb
　　Do While bufSum <= tgtSum Or tp1Sum(r) <= tgtSum
　　　q = q + 1
　　　If tp1Sum(r) <= bufSum Then
　　　　tp2Sum(q) = tp1Sum(r)
　　　　tp2Cmb(q) = tp1Cmb(r)
　　　　r = r + 1
　　　Else
　　　　tp2Sum(q) = bufSum
　　　　tp2Cmb(q) = tp1Cmb(p)
　　　　Mid(tp2Cmb(q), i, 1) = "1"
　　　End If
　　　If tp2Sum(q) = bufSum Then
　　　　p = p + 1
　　　　bufSum = tp1Sum(p) + itmAry(i)
　　　End If
　　Loop
　　s = q
　　For j = 1 To s
　　　tp1Sum(j) = tp2Sum(j)
　　　tp1Cmb(j) = tp2Cmb(j)
　　Next j
　Next i

　'■結果書出
　'　これも書いとかないと「疑問が(以下ry
　For i = 1 To itmCnt
　　If Mid(tp1Cmb(s), i, 1) = "1" Then
　　　Cells(i, 3).Value = itmAry(i)
　　End If
　Next i

End Sub
'=======================↑　ココマデ　↑=======================

回答No.13

supermab

#11様

コメント、たいへん光栄です ^^;

で、補足ですが
「あてずっぽう式」は、正しくは（？）「ラスベガス法」です。
回数を決めて試行して、近似解を得る「モンテカルロ法」が、「解の精度を賭ける」のに対し、
「ラスベガス法」は、最適解を得るまでの、「リソースを賭ける」方法です。
（Wikiによると、ですが・・・）

ですので、
解の分布が疎な場合（たとえば、この問題と同じ規模の問題において、解が「たった１億個しかない」などの場合）は、
（数億ｘ数億）年の処理時間（リソース）がかかる“可能性”がありますし、
最悪の場合（＝解が存在しなければ）、永遠に終了しません！

ですので、実用的には　C120 セルの式を、
=AND(220100 < C118 ,C118 < 220110)
のように条件を緩和して暫定解を求め、、別のアルゴリズムで
解の改善を行うなどの工夫が必要になると思います ^^;

#1様のおっしゃる、遺伝的アルゴリズムを使う場合、
上記のような近似解を複数求め、、遺伝子を生成した上で、
交配＆淘汰してゆくのが、効率的と思います ^^；

回答No.12

warumx

#4,#8のwarumxです。
◆＃5,＃10様
　Excel Solverも手軽で便利ですが能力不足は否めません。
　お薦めは、Lp_solveという世界的に有名な線形計画法のソルバー
　です。ベンチマークテストにも使用されるすぐれものです。
　しかもフリーソフトで、ExcelのAddInで使うことができます。
　これは当方もかなり使用しています。

　【入手方法】
　　下記のサイトからAddInを入手できます。
　　インストール方法と簡単な使用法の説明があります。

　誤解しやすいのですが、このサイトの方はAddInの制作者では
　なく、あくまでも紹介されているだけです。
　制作者は、Samuel E. Buttreyというアメリカの海軍大学の先生
　です。

参考URL：

http://www.mahoroba.ne.jp/~felix/Toolbox/Softwares/Lp_solve/

回答No.11

_Kyle

#2,4です。

#9様のご回答を拝見してちょっと目からウロコの思いでした^^

>カップラーメンが、食べごろになる頃には、解を得ます　^^；

そうですよねぇ。
これだけ解があるんだから、一つ見つけるだけなら、
ボゴソートならぬ「ボゴサーチ」でも用が足りちゃいますよね。

解の総数についてもナルホドと思いました。
「2^117(あるいは2^88)よりは少ないけど、とりあえず実務的には"無数"」
といった程度の認識しかなかったので、
統計的に推定するというのはまったく盲点でした^^;;
「参考」ボタン押しておきました^^

降順にソートして、上から10要素くらいを必ず使うものとして固定すれば、
少し速くなりますね。上位10要素固定の場合、10回試して、
最小8719、最大114863、平均52380トライで最適解を得ました。
毎分数件…悪くないペースです。

ただ、やはり、私の感覚では、
#8様ご紹介のVBAコードのように、「素朴に再帰処理」というのが、
Excelを使った実用上のアプローチとしては順当に思えます。
あんなコードでも、質問文のケースなら毎分１万以上見つけてきますから、
実用上は「瞬時」と言っても良いように思います。

もっとも、あのVBAコードは「反転」しませんから、
合計の数字が、リストの総和に比して大きい場合には本来の速度で動作しませんし、
VBAでやるなら正直もう一工夫二工夫欲しいところですが…。

回答No.10

Wendy02

5の回答者です。

質問者様の主旨から離れてはないとは信じますが、

#4,#8様、フォロー、ありがとうございます。
参考URLは読んでいます。
Solving the subset sum problem

確かにVBAコードは書かれていますが、ここの著者は、

I'm not at all proficient in VBA
と書いているように、

一体、何のために、numbers(i) = Int(1000 * Rnd + 1)
が必要なのかとか疑問が残り、それで、コードとしては試していません。

#9様の内容と同じことかな？
>=INT(2*RAND())

>連続して解いていく場合は計算時間も気になるところです。
ソルバーでは、なぜか、カップラーメンの時間では解けませんでしたね。（^^;

アドインのソルバーが、Ver.5 マクロで出来ていますから、良く出来てはいたものの、さすがに時代遅れで、Excel 2003以降は、バグは承知で使わなくてはなりませんし、間に合わせ程度かもしれません。せめて、中身だけは新しくしてほしいものだと思います。やはり、データ数32個以上は無理なのかと思いました。

>専用解法となると英語の専門書で勉強するしかないです。

解の数が多数あるのか、解が見つからないのかも、その解法の中にあるものだとは思いますが、VBAを学ぶなら、最終的には、やはり一度は自分の手で、アルゴリズムの流れを読みながら解かないといけないようです。大学の授業にあるようですから、ある程度は知られたものらしいのですが、私は不勉強のために知りません。ソルバーがもうちょっと精度が良ければ、こんな必要もないのですが。（今日、明日の仕事だったら、こんなことは間に合わないのですが……)

回答No.9

supermab

「あてずっぽう式」はいかがですか？

A列に、1890～4118 の提示された数値を入れます（A1 ～ A117)。
B列に、=INT(2*RAND()) と入れます（B1 ～ B117)。
C1 に、=A1*B1 と入れて、C117までコピーします。
C118 に =SUM(C1:C117) と入れて、C列の合計を取ります。
C120 に =C118=220103 と入れます。

で、
C120 が TRUE になるまで、F9 ボタンを押し続ける・・・
のは、指が疲れますので、
VBAで下記のコードを書いて、実行します。

Sub Try()
Do
ActiveSheet.Calculate
Loop While ActiveSheet.Range("C120") = False
End Sub

カップラーメンが、食べごろになる頃には、解を得ます　^^；

補足：
　提示された数値を使うか使わないかを、２値で表現すると
２＾117 ＝ 166153499473114484112975882535043072（36桁）通りあることがわかります。
で、上記のコードを５回ほど実行してみたところ、平均15万トライ（6桁）で、解を得ました。
ので、
求めたい解は、統計的に30桁（＝36-6）の数値で表されるほどの膨大な量とわかります。
これだけの解があれば、あてずっぽうも、バリバリ当たります。

お礼

早速、解答ありがとうございました。しかも複数回いただきまして。
ありがとうございます。
#1さんの参照URLよりも早く解答が得られてよいのですが、
近似値の回答がでない？
今回の答えはいただいておりますので、また別の数値98個＆もとめる総和数で実行しています。
初めてVBAを使った、とういうレベルです・・・。

回答No.8

warumx

＃４の者です。
質問された方からコメントがありませんが、自己解決され
たんでしょうか？
＃５様が当方の内容について触れていただいてますので
コメントを少々。

>Google 検索（英語)で、Excel 範囲内で今回の質問に回答に
>結びつきそうなものは、ほとんど見受けられませんでしたね。

確かにこの問題の情報は少ないですが、下記のものもあります。
一応VBAですが、コードの有効性等は確認してません。
質問者の方はワークシートの数式を希望されているので参考
程度でよいのではと思ってます。

>ソルバー(Solver)の利用です。試してみる価値はあるのではない
>でしょうか。

そうですね。このソルバーは数式ベースで利用できるので一度
試されるとよいと思います。アルゴリズム等難しいことは考え
なくてよいこともメリットが大きい。
変数の数が少ない場合はちょっと使うのに手頃で便利なので
使ってますが、変数が今回のように多いと難しいようです。
当方もソルバーでこの問題を解いてみましたが一部の変数は
実数解になり解けません。もちろんバイナリは指定してます。
本来、整数計画法は変数が多いと大変難しいので仕方ないでしょう。

それからこれを解くのが最終目標ならばソルバーでもよいのですが、
連続して解いていく場合は計算時間も気になるところです。
そういう場合は専用解法で解くのが本筋ですが、その辺は質問者
の方からの情報がないと判断しかねますね。
ただし専用解法となると英語の専門書で勉強するしかないです。

参考URL：

http://www.clausbrod.de/cgi-bin/view.pl/CoCreateModeling/MacroSubsetSum

回答No.7

_Kyle

#2です。

■#2まとめ

・複数ある数字の扱いが不明
・数式で解くのは無理
・VBAを使えば解ける
・最適解は"無数"にある（無論"無限"ではないけど）
・毎分万単位で最適解を発見できる、できあいのコードがある
--------------------------------
■#2補足

質問文のリストから重複を許さず選んで、
和が220103キッカリになる組合せ(最適解)の数ですが
48個使う場合(最少)は場合は前述の通り6437通り、
70個使う場合(最多)は129299通り【しか】ないのに対して
49個使う場合になるといきなり数千万以上のオーダーになりますね。

ご質問のような規模の課題の場合、
最適解の総数が全体で数億・数兆といった数になる一方で、
ExcelVBAでぢみ～に調べても
毎分数万通り以上のペースで最適解を見つけることができます。

そういうわけで、「数式で解くこと」にこだわらない場合、
【実用上の問題】は
「最適解を見つけることが困難(?)」とか
「多項式時間では解けない」とかいうことではなく
「解が多すぎる」点になるのではないかと思われます。

最適解をどれか一つ見つければよいのであれば、
(この程度の規模であれば)ほぼ瞬時に終わりますし、
必要であれば、そして【意味があれば】、
ユーザー定義関数にすることも難しくありません。

一方、すべての最適解を見つけたいということであれば、
「書き出す場所」「書き出しに要する時間」「書き出した後の処理」
が問題になります。

また、例えば、経理・会計実務で、
「合計額のみが判っている金額について、内訳を推定して消しこみたい」
というような目的であれば、
数億通りの候補を見つけることができたところで意味がありません。
-------------------------------------
■解法？

質問内容や質問カテゴリから総合的に判断して、
「一つ、あるいは一部の解を見つけたところで意味がないかもしれない」
というのが私の印象ですが、他の回答者さんの判断は違うようですね。

「解決」に役立つかどうかは疑問ですが、
以前(見た目の課題自体は)同様の質問でコードを書いたことがあるので、
参考までにご紹介しておきます（例によって素人マクロですが…）

オプションをがちゃがちゃ追加したので胡乱なことになってますが、
基本的なアプローチとしては、素朴に再帰させているだけです。

　□エクセルマクロの高速化をしたい
　http://bekkoame.okwave.jp/qa4528015.html

#2の時点で紹介するべきかどうか迷ったのですが、

・「できるだけ近くする」という表現からして、
　「最適解が無数にある」ということは質問者さんにとって想定外で、
　その事実だけで課題自体が消滅するかもしれない。

・元リストに複数個ある数字の扱いが不明
　(複数あっても1度しか使えないのか)
　(個数分使えるとして、「1つ目の5,000」と「2つ目の5,000」を区別するのか)

・特定の質問者のニーズに特化した仕様なので、
　ごちゃごちゃ追加したオプションが判りにくい

・そもそも「数式で」というご質問だし、
　要件がもう少し明らかになってから改めて書き直せば良い

という点を勘案して、参考画像で示唆するにとどめました。
-------------------------------------
■余談

私は「課題の解決に寄与すること」には関心がありますし、
解決に必要と判断した限りにおいて、情報や解法を提示しますが、
「解法を提示(誇示?）すること」自体にはさほど興味はありません。
知識やスキルを競っているわけではありませんし、
競うほどの知識もスキルはないので^^;;

以上ご参考まで。長乱文陳謝。

お礼

早速、詳細にたくさんの解答をありがとうございます。

・複数ある数字の扱いが不明
質問文の数字には、例えば5,000が５個あります。
この場合、5,000は5回までなら使ってよいということでしょうか？

そのとおりです

□エクセルマクロの高速化をしたい
　​http://bekkoame.okwave.jp/qa4528015.html​
を参照にはじめてマクロに挑戦しています。
答えが数秒で出るのはありがたいです。

今回の答えはいただいておりますので、また別の数値98個＆もとめる総和の数値で実行しています。

回答No.6

Wendy02

#5の補足

A列
データ(A1:A117)

B列空白

C列(C1:C117)
=A1*B1

C118(目的セル)
=SUM($C$1:$C$117)