scramble (The Seasoned Schemer)

;; scranmble

;; (scramble '(1 1 1 3 4 2 1 1 9 2))
;;  -> (1 1 1 1 1 4 1 1 1 9)
;; (scramble '(1 2 3 4 5 6 7 8 9))
;;  -> (1 1 1 1 1 1 1 1 1)
;; (scramble '(1 2 3 1 2 3 4 1 8 2 10))
;;  -> (1 1 1 1 1 1 1 1 2 8 2)

となるような手続き scramble 。

これが複雑というかなんというか、わかりにくい。「何をしているか」がまずわかりにくく、それがわかっても「目的」がよくわからないのです。。それはともかく「できるだけ見やすく」「できるだけわかりやすく」できないものか、いくつか書いてみました。

取りあえず named-let による末尾再帰版。

(define (scramble tup)
  (define (pick ls n)
    (list-ref ls (- n 1)))
  (let rec ((ls tup)(rev '())(acc '()))
    (if (null? ls)
        (reverse acc)
        (let* ((head (car ls))
               (rev (cons (car ls) rev))
               (ret (cons (pick rev (car ls)) acc)))
          (rec (cdr ls) rev ret)))))


(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

次いで、gauche.collection から map-accum を用いた版。

(use gauche.collection)

(define (scramble tup)
  (receive (ret rev)
      (map-accum (^ (e acc)
                    (let1 rev (cons e acc)
                      (values (list-ref rev (- e 1)) rev)))
                 '() tup)
    ret))

(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

次いで、gauche.sequence から map-with-index を用いた版。わざわざ反転したリストを内部で作る必要はないだろうということで書いてみました。が、厳密にはエラーケースが異なりそうです。

(use gauche.sequence)

(define (scramble tup)
  (map-with-index (^ (idx e)
                     (list-ref tup (- idx (- e 1))))
                  tup))

(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

オリジナル（に近い版？）は以前書いています。

• vallog: TSS scramble
• vallog: TSS scramble
• vallog: TSS letting, scramble, fold2