データっていうか高階関数なら使えます

データが扱える人を探せ！ - 象徴ヶ淵 経由 JAVA５．０でGO!! | プログラミングに自信があるやつこい！！

こないだ トランプを配 ったらトラックバックをもらったのでお礼？お返し？に、という建前で遊んでみた。こーゆーの楽しい。ついでに言うと他の人の見ると、「こんな書き方もあるかー」とか「みんなけっこー dolist とか loop とか使ってんだなー」とか面白いのでこーゆー遊びは流行ればいいと思うます。

;; 開始時刻の記録
(format-date-string "%Y-%H-%D %H:%M:%S")
=> 2009-07-D 13:07:28

;; ちょっと自信がなかったので確認
(split-string "foo bar baz" " ")
=> ("foo" "bar" "baz")

;; 問題の関数
(defun who-can-see (user-names allowed-data report-data)
  (mapcan (lambda (user allowed)
            (when  (every (lambda (x)
                            (find x allowed :test #'equal))
                     report-data)
              (list user)))
    user-names
    (mapcar (lambda (src) (split-string src " "))
      allowed-data)))
=> who-can-see

;; テスト
(who-can-see '("joe" "nick" "ted")
             '("clients products" "products orders" "clients")
             '("clients" "products"))
=> ("joe")

(who-can-see '("kathy" "john" "dan" "steve" "cheryl" "tony")
             '("users data" "data orders" "users permissions" "system users controls" "default" "admin users")
             '("users"))
=> ("kathy" "dan" "steve" "tony")

(who-can-see '("jim" "scott" "barbara")
             '("users order products" "products shipping" "tracking products orders")
             '("admin"))
=> nil

;; 終了
(format-date-string "%Y-%M-%D %H:%M:%S")
=> "2009-22-D 13:22:18"

とりあえず format-date-string は "%Y-%m-%d %H:%M:%S" な。%m が月で %d が日な。

時間は関数名/引数名が指定されてるのに後から気付いて書き直したとかテストケースの引数を typo ってびっくりしたとか含めてほぼ15分。ま、前回よりマシか。

何を考えて書いたのか思い出しながら説明をする試み

どっかで見ていいなと思ったのでパクる。

#1 allowed-datas の各要素を「" " 区切りの文字列」からふつーの list に

split-string すればなんてことはない。mapcar で全部まとめてやってしまえ。引数の与え方のためだけに lambda 書く羽目に。

(mapcar (lambda (src) (split-string src " "))
  allowed-data)

#2 user-names と result(#1) の構造が同じになってることに気付く

どっちも (nth n the-list) が user#n に関連するデータなので、mapcar なりに一緒に渡してしまえばおｋ。最初は hash-table か alist で {"userA": ("data1" "data3"), "userB": ("data2 data4") ...} みたいなことするようかなぁとか思ってたけど必要なかった。

;; この mapcar は n 周目で
;;    - (nth n user-names)
;;    - (nth n <split 済みの allowed-data>)
;; を lambda 式に与える
(mapcar (lambda (name allowed)
          ...)
  user-names
  (mapcar (lambda (src) (spilt-string src " "))
    allowed-data))

#3 lambda 式を仕上げる

えーと、そのユーザーが report-data を扱えるか調べて、扱えるなら name を返せばいーのかな。report-data の各要素が、全部 allowed に含まれてたらおｋなんだから...

report-data の各要素を持ってきて

(mapcar (lambda (name allowed)
          (every (lambda (x)
                   ...)
            report-data))
  ;;以下略

それが allowed に含まれてるか調べる

(mapcar (lambda (name allowed)
          (every (lambda (x)
                   (find x allowed :test #'equal))
            report-data))
  ;;以下略

report-data の全要素が allowed に含まれてるなら name を返す

(mapcar (lambda (name allowed)
          (when (every (lambda (x)
                         (find x allowed :test #'equal))
                  report-data)
            name))
  ;;以下略

これだとダメな人のとこで返ってくる nil が残っちゃうので mapcan + list で消す。

(mapcan (lambda (name allowed)
          (when (every (lambda (x)
                         (find x allowed :test #'equal))
                  report-data)
            (list name)))
  user-names
  (mapcar (lambda (src) (split-string src " "))
    allowed-data))

あとは関数にしてしまえばできあがり。

(defun who-can-see (user-names allowed-data report-data)
  (mapcan (lambda (name allowed)
            (when (every (lambda (x)
                           (find x allowed :test #'equal))
                    report-data)
              (list name)))
    user-names
    (mapcar (lambda (src) (split-string src " "))
      allowed-data))))

今こうしたほーがいいなと思いついた。mapcan に渡す前に mapcar で split-string してたのを mapcan の中でやるように変更。

(defun who-can-see (user-names allowed-data report-data)
  (mapcan (lambda (name allowed)
            (let ((allowed-list (split-string allowed " ")))
              (when (every (lambda (x)
                             (find x allowed-list :test #'equal))
                      report-data)
                (list name))))
    user-names
    allowed-data))

余談: 高階関数好きに送る indent の設定

mapcar とか mapcan とか remove-if-not とかのインデントを変えてある。たぶん良い子はまねしちゃダメ。

(mapcar (lambda (arg)
          ...)
        '(a b c)) ;フツーはこうなる

(mapcar (lambda (arg)
          ...)
  '(a b c)) ; こうしておくと

(mapcar (lambda (arg)
          ...)
  (mapcar (lambda (arg)
            ...)
    (mapcar (lambda (arg)
              ...)
      '(a b c d)))) ; とかやっても右に飛び出さない

やりかた

(mapc (lambda (sym)
        (setf (get sym 'lisp-indent-hook) 1))
  '(mapcar mapcan every notany some
    remove-if remove-if-not
    delete-if delete-if-not
    find-if find-if-not
    position-if position-if-not
    member-if member-if-not
    count-if count-if-not))