2章「ああ（そうか）！」アルゴリズム - 珠玉のプログラミング（Programming Pearls）

珠玉のプログラミングの2章。

2.6.1

順列を列挙して、辞書をリニアサーチ。
時間とメモリがあるなら辞書をあらかじめソートしておく。

2.6.2

ファイルをソートしてそのあと走査。

2.6.3

コード参照。

2.6.4

略。

2.6.5

abc -> bac ->bca -> cba かな？

2.6.6

AAA さんと BBB さんがおなじになってしまう。
あらかじめ電話帳の名前からボタン数字列を列挙してそれでソートしておく。

2.6.7

テープの物理構造が分からないので難しい。と思って答えを見たら感心した。
物理構造関係なかったな。

2.6.8

1<= j <= k ですべての部分配列の和を求めておいて、和でキーにしてソートしておく。
と思ったが答えは違った。考えが浅かったな。

2.6.9

N/(4 * log2(N))

N=100 で 3.7回。
N=1000 で 25回。
N=10000 で 188 回。

2.6.10

水で。

2.scm

;; Programming Pearls Chapter 2
(import (rnrs)
        (mosh)
        (mosh test)
        (mosh file))

;; question A
(define (split min max file)
  (let* ([middle (exact (truncate (inexact (/ (+ min max) 2))))]
         [gt-file (format "~a-~a" middle max)]
         [lt-file (format "~a-~a" min middle)])
    (call-with-input-file file
      (lambda (p)
        (let ([gt (open-output-file gt-file)]
              [lt (open-output-file lt-file)])
          (let loop ([num (read p)]
                     [gt-count 0]
                     [lt-count 0])
            (cond
             [(eof-object? num)
              (close-port gt)
              (close-port lt)
              (cond
               [(zero? gt-count)
                (display gt-file)
                (display "done\n")]
               [(zero? lt-count)
                (display lt-file)
                (display "done\n")]
               [(> gt-count lt-count)
                (split min middle lt-file)]
               [else
                (split middle max gt-file)])
              (delete-file gt-file)
              (delete-file lt-file)]
             [(> num middle)
              (write num gt)
              (newline gt)
              (loop (read p) (+ gt-count 1) lt-count)]
             [else
              (write num lt)
              (newline lt)
              (loop (read p) gt-count (+ lt-count 1))])))))))

;(split 0 (expt 10 7) "./1-data.txt")

;; question B
(define (rotate-left v diff)
  (define (ref index) (vector-ref v index))
  (define (set index value) (vector-set! v index value))
  (define len (vector-length v))
  (assert (> len 0))
  (let offset-loop ([offset 0]
                    [move-count 0])
  (let ([t (ref offset)])
    (let loop ([i 0])
      (let ([src-index (mod (+ (* (+ i 1) diff) offset) len)]
            [dst-index (mod (+ (* i diff) offset) len)])
        (cond
         [(zero? (- src-index offset))
          (set dst-index t)
          (if (= (+ i move-count 1) len) ;; moved len times
              v
              (offset-loop (+ offset 1) (+ move-count i 1)))]
         [else
          (set dst-index (ref src-index))
          (loop (+ i 1))]))))))

(test-equal '#(a b) (rotate-left (list->vector '(a b)) 0))
(test-equal '#(b a) (rotate-left (list->vector '(a b)) 1))
(test-equal '#(a b) (rotate-left (list->vector '(a b)) 2))
(test-equal '#(a b c) (rotate-left (list->vector '(a b c)) 0))
(test-equal '#(b c a) (rotate-left (list->vector '(a b c)) 1))
(test-equal '#(c a b) (rotate-left (list->vector '(a b c)) 2))
(test-equal '#(a b c d e f) (rotate-left (list->vector '(a b c d e f)) 0))
(test-equal '#(b c d e f a) (rotate-left (list->vector '(a b c d e f)) 1))
(test-equal '#(c d e f a b) (rotate-left (list->vector '(a b c d e f)) 2))
(test-equal '#(d e f a b c) (rotate-left (list->vector '(a b c d e f)) 3))

(define (rotate-left2 v diff)
  (define (vector-reverse! v start end)
    (define (swap i j)
      (let ([temp (vector-ref v i)])
        (vector-set! v i (vector-ref v j))
        (vector-set! v j temp)))
    (let ([middle (div (+ (- end start) 1) 2)])
      (let loop ([i start]
                 [j end])
        (cond
         [(= (+ middle start) i)
          v]
         [else
          (swap i j)
          (loop (+ i 1) (- j 1))]))))
  (vector-reverse! v 0 (- diff 1))
  (vector-reverse! v diff (- (vector-length v) 1))
  (vector-reverse! v 0 (- (vector-length v) 1)))

(test-equal '#(a b) (rotate-left2 (list->vector '(a b)) 0))
(test-equal '#(b a) (rotate-left2 (list->vector '(a b)) 1))
(test-equal '#(a b) (rotate-left2 (list->vector '(a b)) 2))
(test-equal '#(a b c) (rotate-left2 (list->vector '(a b c)) 0))
(test-equal '#(b c a) (rotate-left2 (list->vector '(a b c)) 1))
(test-equal '#(c a b) (rotate-left2 (list->vector '(a b c)) 2))
(test-equal '#(a b c d e f) (rotate-left2 (list->vector '(a b c d e f)) 0))
(test-equal '#(b c d e f a) (rotate-left2 (list->vector '(a b c d e f)) 1))
(test-equal '#(c d e f a b) (rotate-left2 (list->vector '(a b c d e f)) 2))
(test-equal '#(d e f a b c) (rotate-left2 (list->vector '(a b c d e f)) 3))

(define (find-anagram dictionary)
  (define (collect-duplicate lst equal-pred)
    (let loop ([lst lst]
               [prev #f]
               [pending? #f]
               [ret '()])
      (cond
       [(null? lst)
        (reverse (if pending? (cons prev ret) ret))]
       [(equal-pred prev (car lst))
        (loop (cdr lst) (car lst) #t (cons prev ret))]
       [else
        (loop (cdr lst) (car lst) #f (if pending? (cons prev ret) ret))])))
  (let ([sorted-words (vector-map (lambda (word) (list->string (list-sort char<? (string->list word)))) dictionary)])
    (let loop ([i 0]
               [ret '()])
      (cond
       [(= i (vector-length dictionary))
        (map car (collect-duplicate (list-sort (lambda (x y) (string<? (cdr x) (cdr y))) (reverse ret))
                                    (lambda (a b) (and a (equal? (cdr a) (cdr b))))))]
       [else
        (loop (+ i 1) (cons (cons (vector-ref dictionary i) (vector-ref sorted-words i)) ret))]))))


(display (find-anagram (list->vector (file->list "dict.txt"))))

(test-results)

珠玉のプログラミング—本質を見抜いたアルゴリズムとデータ構造

posted with amazlet at 09.07.11

ジョン ベントリー
ピアソンエデュケーション
売り上げランキング: 5607

Amazon.co.jp で詳細を見る