プレゼント交換 再び… 2


鍋あり谷あり - あなたならどうお書きになります1.0 経由で、{informa,computa,evolu}tion: プレゼント交換の手伝いMathematica 版がどんなふうに動いているのか興味を持ったので、それを調べる過程で SqueakSmalltalk で直訳…というか意訳ぎみにしたもの(ついでに SmalltalkRuby に変換したものも…)ができたので晒しておきます。

SqueakSmalltalk
| problem pos test deepen answer results |

problem := #((a1 a2) (b) (c) (d)).

pos := Array streamContents: [:ss |
   problem doWithIndex: [:group :gIdx |
      group doWithIndex: [:memb :idx | ss nextPut: {gIdx. idx}]]].

deepen := nil.
results := OrderedCollection new.
test := [:x1 |
   (((x1 collect: [:ary | ary first]) 
         with: ((pos first: x1 size) collect: [:ary | ary first])
         collect: [:aa :bb | aa ~= bb]) allSatisfy: [:bool | bool]) and: [
      x1 size = pos size
         ifTrue: [results add: x1. true]
         ifFalse: [deepen copy fixTemps value: x1]]].

deepen := [:x2 |
   ((pos reject: [:elem | x2 includes: elem]) collect: [:x3 |
      test copy fixTemps value: (x2 copyWith: x3)]) anySatisfy: [:bool | bool]].

answer := [(deepen copy fixTemps value: #())
   ifTrue: [results atRandom collect: [:pair | (problem at: pair first) at: pair second]]
   ifFalse: [false]].

^ answer value
Ruby
class Array
  def first(n=0); n==0 ? self[0] : self[0,n] end
  def second; self[1] end
  def at_random; self[rand(size)] end
end

problem = [["a1","a2"],["b"],["c"],["d"]]

pos = []
problem.each_with_index do | e, i | 
  e.each_with_index{ | e, j | pos << [i, j] }
end

deepen = nil
results = []
test = proc do | x1 |
  (x1.collect{ | ary | ary.first }.
      zip(pos.first(x1.size).collect{ | ary | ary.first }).
        collect{ | a, b | a != b }.all?{ | bool | bool }) &&
    if x1.size == pos.size then
      results << x1; true
    else
      deepen[x1]
    end
end

deepen = proc do | x2 |
  pos.reject{ | elem | x2.include?(elem) }.collect{ | x3 | test[x2+[x3]] }.any?{ | bool | bool }
end

answer = proc do
  if deepen[[]] then
    results.at_random.collect{ | pair | problem[pair.first][pair.second] }
  else
    false
  end
end

answer[]