drakma使ってプログラム

drakmaの使い方をチョコッとだけ覚えたので、それを使ったプログラムを書いてみました。
読み込んで(count_fineday)を実行すると雨が降っていない日数を返します。
drakmaは気象庁のページに行ってページを持って来てくれています。
make_address関数内にあるアドレスにある数字を変えてやれば他の地域にも対応可。

その他にも色々と注意点はあるんですが・・・あんまり実用的なプログラムでもないでしょうから省きます。

あんまりライブラリを多用したくなかったので使わなかったのですが、CL-PPCREを使えばもっと楽にできたのかな。


(ql:quickload "drakma")
(ql:quickload "closure-html")
(ql:quickload "local-time")

(defparameter  *result* nil)
(defparameter  *ex_month_result* nil)
(defparameter  *tmp* nil)
(defparameter  *ex_tmp* nil)



;気象庁の該当べーじアドレスを返す
;引数はnilなら当月分。数値を指定すればその数値分だけ前の月。
(defun make_address (&optional (xi nil)) 
  (concatenate 'string 
               "http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=34&block_no=47590&year=" 
               (if xi
                 (princ-to-string (local-time:timestamp-year (local-time:timestamp- (local-time:today) xi :month))) 
                 (princ-to-string (local-time:timestamp-year (local-time:today)))) 
               "&month=" 
               (if xi
                 (princ-to-string (local-time:timestamp-month (local-time:timestamp- (local-time:today) xi :month)))
                 (princ-to-string (local-time:timestamp-month (local-time:today)))) 
               "&day=&view=a1")) 


;引数で指定されたアドレスのhtmlを構文チェックした後でlhtmlに変換して返す
(defun to_lhtml (address)
  (chtml:parse ;lhtmlに変換
    (chtml:parse ;構文チェック 
      (drakma:http-request address) (chtml:make-string-sink)) 
    (chtml:make-lhtml-builder)))


;引数で指定されたlhtml形式の中から条件に合った部分をリストで返す
;返ってくるのは日付毎の詳細データ
(defun kiritori (lhtml)
  (labels ((rec (x)
                ;冗長な書き方だが意味理解のためifと別けた
                (when (consp x) 
                  (if (and (equal (car x) :tr) (equal (length (nth 1 x)) 2)) ;目的箇所を示す条件
                    (list x) ;あとで参照しやすいように括弧でパッキング
                    (mapcan #'rec x))))) 
    (mapcan #'rec lhtml)))


;日付毎の詳細データが記されたlhtmlから降雨量のリストを返す
(defun make_rainfall_list (lhtml)
  (labels ((rec (x)
               (nth 2 (nth 7 x)))) ;降雨量が記されている場所
    (mapcar #'rec lhtml)))


;降水量のリストを受け取り、要素を数値に変換して返す
(defun change_to_num (lst)
  (mapcar #'(lambda (x) (cond ((equal x "--") 0.0) ;雨が降らなかった日を0.0にする
                              ((null x) -1.0) ;未調査日付を-1.0と表記させる
                              (t (read-from-string x)))) lst)) ;雨が降った日はその量を文字列から数値に変換

;降水量のリストに日付を加える
(defun add_day (lst)
  (loop for day
        from 1
        for i
        in lst
        collect (list i day))) 

;引数で与えられたlhtmlから(降水量 日付)の要素を持つ1か月分のリストを作り、返す
;自作のkiritori,make_rain_list,change_to_num,add_dayを使用
(defun make_rain_list (lhtml)
  (reverse ;末日からの表示にする
    (add_day ;降雨量リストの要素を(降雨量 日付)にする
      (change_to_num ;降雨量リストの要素を数値に変換
        (make_rainfall_list ; 降雨量リストを返す
          (kiritori lhtml)))))) ;日付毎の詳細データを切り取る


;(降水量 日付)を要素として持つ一か月分のリストを受け取って
;(雨の降らなかった日数 最後に雨が降った日付)を返す
(defun rain (lst &optional (ass 0)) ;assは降らなかった日数を格納しておく変数
  (cond
    ((null lst) (list ass -100)) ;月始めまで雨が降らなかった場合は(日数 -100)を返す
    ((= (car (car lst)) -1) (rain (cdr lst))) ;未調査日の処理 
    ((= (car (car lst)) 0) (rain (cdr lst) (incf ass))) ;降水量0の日の処理
    ((> (car (car lst)) 0) (setq ass (list ass (cadr (car lst))))))) ;降った日を見つけた時の処理(結果を返す)

;(降水量 日付)を要素に持つリストを受け取り、最新の調査日を返す。

;最新の調査日が無ければ、先月のリストを呼び出して調査。
(defun newest_date_of_day (lst)
  (cond 
    ((equal (caar lst) nil) (newest_date_of_day *ex_tmp*)) ;調査を先月に遡る
    ((= (caar lst) -1.0) (newest_date_of_day (cdr lst)));-1.0は未調査日の印
    (t (cadar lst))))


;main部分
(defun count_fineday ()

  (setq *tmp* (make_rain_list (to_lhtml (make_address))))

  ;(雨の降らなかった日数 最後に雨が降った日付)をリストで受け取る
  (setq *result* (rain *tmp*))

  (cond ((> (cadr *result*) 0) (format t ;当月分だけで完結した場合 
                                       "~&~a日間降っていません。~%最後に降ったのは~a日(最新データは~a日です)。" 
                                       (car *result*) 
                                       (cadr *result*)
                                       (newest_date_of_day *tmp*)))
        ; ((= (cadr *result*) -100) (setq *ex_month_result* ;当月だけで完結しなかった場合
                                        ; (rain (make_rain_list (to_lhtml (make_address 1)))))
        ((= (cadr *result*) -100) (setq *ex_tmp* (make_rain_list (to_lhtml (make_address 1))))
                                  (setq *ex_month_result* (rain *ex_tmp*)) 
                                  (format t 
                                          "~&~a日間降っていません。~%最後に降ったのは先月の~a日です(最新データは~a日です)。" 
                                          (+ (car *ex_month_result*) (car *result*))
                                          (cadr *ex_month_result*)
                                          (newest_date_of_day *tmp*)
                                          ))) 

  ) 

初めて関数型プログラミングを意識して書いてみましたが、何だか冗長で上手くできなかったです。
とはいえ下手なりにも関数型に入れて貰えるかなと。
もっと精進せねば。