DouKaku? 1670 shiro: 2分探索みたいな感じかな。境界値がnCr...(「組合せ型の最小完全ハッシュ関数」の逆関数)

Comment detail

2分探索みたいな感じかな。境界値がnCrで刻々と変わってゆくだけで。
コンパクトさを優先して書いてみました。nCrの計算が何度も行われるので
メモ化すると高速化できると思われます。

実行例:
gosh> (for-each (lambda (k) (print k " => " (rev-hash k 5 2))) (iota 10))
0 => (0 0 0 1 1)
1 => (0 0 1 0 1)
2 => (0 0 1 1 0)
3 => (0 1 0 0 1)
4 => (0 1 0 1 0)
5 => (0 1 1 0 0)
6 => (1 0 0 0 1)
7 => (1 0 0 1 0)
8 => (1 0 1 0 0)
9 => (1 1 0 0 0)

(define (nCr n r)
  (define (! n k) (if (<= n k) 1 (* n (! (- n 1) k))))
  (/ (! n (- n r)) (! r 0)))

(define (rev-hash k n m)
  (cond [(= m 0) (make-list n 0)]
        [(= n m) (make-list n 1)]
        [(<= (nCr (- n 1) m) k)
         (cons 1 (rev-hash (- k (nCr (- n 1) m)) (- n 1) (- m 1)))]
        [else
         (cons 0 (rev-hash k (- n 1) m))]))

メモ化をちょっと試してみた。
単純にnCrの引数だけでメモ化するのはあまり効果が無い。
同じ(n,r)の組み合わせは1回しか使わないから (上のrev-hashの
コードでは手抜きで2回使われる箇所もあるけど)。
nCr = n-1Cr + n-1Cr-1 を使えば、最初のnCrの計算で
その後に使う組み合わせは全て計算してしまうのでメモ化の
効果は出る。ただ、これは要するにpascalのテーブルを最初に
(ほぼ)全部計算するってことだから、まだ無駄なことをしている
感じはある。

gosh> (time (begin ((rev-hash-test nCr-memo) (expt 10 599) 2000 1000) (values)))
;(time (begin ((rev-hash-test nCr-memo) (expt 10 599) 2000 1000) (values)))
; real   7.703
; user   7.470
; sys    0.210
gosh> (time (begin ((rev-hash-test nCr) (expt 10 599) 2000 1000) (values)))
;(time (begin ((rev-hash-test nCr) (expt 10 599) 2000 1000) (values)))
; real  35.341
; user  34.710
; sys    0.500

もちろん2度目からはメモ化版は激速だけど。

gosh> (time (begin ((rev-hash-test nCr-memo) (expt 10 599) 2000 1000) (values)))
;(time (begin ((rev-hash-test nCr-memo) (expt 10 599) 2000 1000) (values)))
; real   0.014
; user   0.010
; sys    0.000

テストコードを貼り付けておく。

(define (nCr n r)
  (define (! n k) (if (<= n k) 1 (* n (! (- n 1) k))))
  (/ (! n (- n r)) (! r 0)))

(define nCr-memo
  (let1 tab (make-hash-table 'equal?)
    (define (memo n r v) (hash-table-put! tab (cons n r) v) v)
    (lambda (n r)
      (cond [(or (= n r) (= r 0)) 1]
            [(hash-table-get tab (cons n r) #f)]
            [(> r (quotient n 2)) (nCr-memo n (- n r))]
            [else (memo n r (+ (nCr-memo (- n 1) (- r 1))
                               (nCr-memo (- n 1) r)))]))))

(define (rev-hash-test nCr)
  (define (rev-hash k n m)
    (cond [(= m 0) (make-list n 0)]
          [(= n m) (make-list n 1)]
          [(<= (nCr (- n 1) m) k)
           (cons 1 (rev-hash (- k (nCr (- n 1) m)) (- n 1) (- m 1)))]
          [else
           (cons 0 (rev-hash k (- n 1) m))]))
  rev-hash)

そうか，n=kを見れば別に末端まで再帰する必要は無いな．
おれはまだまだ修行が足りなかったようだ．
下に自分のコードを書き直してみた，エンバグしてなきゃいいけど．

see:

def fact( n )
  if n == 0
    1
  else
    n * fact( n - 1 )
  end
end

def comb( n, k )
  fact( n ) / ( fact( k ) * fact( n - k ) )
end

def inv_comb_hash( x, n, k )
  if n == 0
    return []
  elsif n == k
    return [1] * n
  end
  nCk = comb( n - 1, k )
  if x >= nCk
    [1] + inv_comb_hash( x - nCk, n - 1, k - 1 )
  else
    [0] + inv_comb_hash( x, n - 1, k )
  end
end

う～ん，どうやら「どうかく.org」自体を参考URLに挙げることはできないようですね．
書き直したコードというのは，#1672です．

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq