アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

A 回答 (15件中11~15件)

#2,4です。



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

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

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

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

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

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

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

#4,#8のwarumxです。


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

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

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

  

参考URL:http://www.mahoroba.ne.jp/~felix/Toolbox/Softwar …
    • good
    • 0

#11様



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

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

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

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

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

#2,7,11です。



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

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

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

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

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

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

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

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

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

※普通は"部分集合和問題"とは呼ばないようです。
 術語を振り回すなら、一般的な訳語を用いるべきだと思いますが、
 回答者によっては「日本語サイトがヒットしない方が都合が良い」のかもしれません。
http://www.google.com/search?hl=ja&client=opera& …
http://www.google.com/search?hl=ja&client=opera& …
---------------------------------------------
■#4でご紹介のあったREXXコード(DPS)について

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

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

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

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

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

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

B1セルに合計、D1セル以下に元リストを入力して起動すると、
毎分2万~5万件程度のペースで最適解をみつけて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
'=======================↑ ココマデ ↑=======================
    • good
    • 0

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



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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!