プレゼント交換 再び…


仕切り直しで 鍋あり谷あり - あなたならどうお書きになります1.0 に再チャレンジ。 今度は大丈夫だと思うのですが…(^_^;)。 ウリは、大人数の場合、たとえば 100 人参加のパーティでも、平均 0.5 秒程度 @ 1 GHz PenMruby 1.8.5 (2006-08-25) [i386-cygwin])で適切かつ毎回ランダムな交換パターンの提示が可能…である一方で、全パターンの列挙や保持が必要ならそれについても、ブロック付き呼び出しのブロックを差し替えることにより対応可能(もちろんこちらは組み合わせの数に相応のコストがかかりますが)…としたところです。

#((a1 a2) (b) (c) (d)) generateGiftExchangePattern
=> {#a1->#b . #a2->#c . #b->#d . #c->#a2 . #d->#a1}
World findATranscript: nil.
#((a1 a2) (b) (c)) generateGiftExchangePatternsDo: [:result | Transcript cr; show: result. false]
{#a1->#c . #a2->#b . #b->#a1 . #c->#a2}
{#a1->#b . #a2->#c . #b->#a1 . #c->#a2}
{#a1->#c . #a2->#b . #b->#a2 . #c->#a1}
{#a1->#b . #a2->#c . #b->#a2 . #c->#a1}


以下は SqueakSmalltalk での定義。メタ情報を除いた加工コード(ファイルイン不可。ブラウザへのコピペが必要)にて。ファイルイン用はこちらに置きました。(追記404 Blog Not Found:Math - プレゼント交換 で指摘されている組み合わせが見つからない場合にも対処しました。書き換えついでに #flatten も前のより少しまじめに実装したものに差し替えました。)

SequenceableCollection >> flatten   " converting "
   | array |
   array := Array streamContents: [:ss |
      self do: [:each |
         (each isKindOf: self species)
            ifTrue: [ss nextPutAll: each flatten]
            ifFalse: [ss nextPut: each]]].
   ^ array as: self species
SequenceableCollection >> selectGiftTakersRestOf: resultArray thenDo: aBlock   " private "

   | giver takerGroups takers allButFirstPair modifiedGroups taker shouldFail newResult |
   
   self size < 2 ifTrue: [^ aBlock value: resultArray sort].
   giver := self first.
   takerGroups := self second.
   takers := takerGroups flatten.
   allButFirstPair := self allButFirst: 2.
   modifiedGroups := OrderedCollection new.

   [takers notEmpty] whileTrue: [
      taker := takers remove: takers atRandom.
      takerGroups do: [:group |
         (group includes: taker) ifTrue: [
            modifiedGroups add: group.
            group remove: taker]].
      shouldFail := false.
      allButFirstPair pairsDo: [:memb :cands |
         cands flatten isEmpty ifTrue: [shouldFail := true]].
      (shouldFail not and: [
            newResult := resultArray copyWith: giver -> taker.
            allButFirstPair selectGiftTakersRestOf: newResult thenDo: aBlock])
         ifFalse: [
            modifiedGroups do: [:group | group add: taker].
            modifiedGroups := OrderedCollection new]].
   ^ false
SequenceableCollection >> generateGiftExchangePatternsDo: aBlock   " enumerating "

   | groups table |

   groups := self collect: [:group | group asOrderedCollection].
   groups := groups asOrderedCollection.
   
   table := groups flatten shuffled inject: #() into: [:tbl :mbr |
      tbl, {mbr. groups reject: [:group | group includes: mbr]}].
   
   table selectGiftTakersRestOf: #() thenDo: aBlock
SequenceableCollection >> generateGiftExchangePattern
   self generateGiftExchangePatternsDo: [:result | ^ result].
   ^ self error: 'There is no pattern for such groups.'

上のコードを Ruby に直訳っぽく変換。ただし、Smalltalk で与えたブロック内の ^ の挙動を Ruby でどう書いていいのか分からなかったので、本来ブロックで与えるべき列挙の振る舞いを、ハードコードしてごまかしています。あしからず。(←いや。書けました)

class Array
  def at_random; self[rand(size)] end
  def all_but_first(n=1); self[n,size-n] end
  def each_pairs; (1..size).step(2){|i| yield(self[i-1],self[i])} end

  def select_gift_takers_rest_of(result_array, &block)
    if size < 2 then return block.call(result_array.sort) end

    giver = self[0]
    taker_groups = self[1]
    takers = taker_groups.flatten
    all_but_first_pair = all_but_first(2)
    modified_groups = []

    while (!takers.empty?) do
      taker = takers.delete(takers.at_random)
      taker_groups.each do | group | 
        modified_groups << group if !group.delete(taker).nil?
      end

      should_fail = false
      all_but_first_pair.each_pairs do | memb, cands |
        should_fail = true if cands.flatten.empty?
      end

      if !(!should_fail && (
        new_result = result_array + [[giver, taker]]
        all_but_first_pair.select_gift_takers_rest_of(new_result, &block)))
      then
        modified_groups.each{ | group | group << taker }
        modified_groups = []
      end
    end

    return false
  end

  def generate_gift_exchange_patterns_each(&block)
    table = flatten.sort_by{rand}.inject([]) do | tbl, mbr |
      tbl + [mbr, reject { | group | group.include?(mbr) }]
    end
    table.select_gift_takers_rest_of([], &block)
  end

  def generate_gift_exchange_pattern
    generate_gift_exchange_patterns_each{ | result | return result }
    raise("There is no pattern for such groups.")
  end
end
[["a1","a2"],["b"],["c"]].generate_gift_exchange_pattern
=> [["a1", "c"], ["a2", "b"], ["b", "a1"], ["c", "a2"]]
[["a1","a2"],["b"],["c"]].generate_gift_exchange_patterns_each { | result | p result }
[["a1", "b"], ["a2", "c"], ["b", "a1"], ["c", "a2"]]
[["a1", "b"], ["a2", "c"], ["b", "a2"], ["c", "a1"]]
[["a1", "c"], ["a2", "b"], ["b", "a1"], ["c", "a2"]]
[["a1", "c"], ["a2", "b"], ["b", "a2"], ["c", "a1"]]