zyzzy-lisp

listを平坦にする

• ソース

(defun flatten (lst)
  "listを平坦にする。再帰によるリストの処理"
  (if (null lst)
      nil
    (if (listp (car lst))
	(nconc (flatten (car lst))
	       (flatten (cdr lst)))
      (cons (car lst) (flatten (cdr lst))))))

• 結果

(flatten '(a (b c))) ⇒ (a b c)
(flatten '(a (b c (d e)))) ⇒ (a b c d e)
(flatten '((a) (b) (c) (d))) ⇒ (a b c d)

三角形を作る

• ソース

(defun triangle (num)
  "アスタリスクで三角形を作る"
  (interactive "*nサイズを奇数で: ")
  (if (= (rem num 2) 0)
      (message "奇数でないと出来ません")
    (dotimes (i (+ (floor (/ num 2)) 1))
      (dotimes (j (floor (/ (- num (* i 2)) 2)))
	(insert " "))
      (dotimes (j (floor (+ (* i 2) 1)))
	(insert "*"))
      (dotimes (j (floor (/ (- num (* i 2)) 2)))
	(insert " "))
      (insert #\LFD))))

• 結果

(triangle 7)
   *   
  ***  
 ***** 
*******
nil

野球の打撃成績チェッカ

• ソース

(defun check-baseball ()
  "打撃好調な人をチェック"
  (interactive)
  (let ((in)(name)(team))
    (with-open-stream (stream (connect "baseball.yahoo.co.jp" 80))
      (format stream "GET /npb/stats/ HTTP/1.0\n\n")
      (set-stream-encoding stream :binary)
      (while (setq in (read-line stream nil))
    (setq in (map-euc-to-sjis in))
	(if (string-match "player[^>]+>\\([^<]+\\)" in)
	    (progn
	      (setq name (match-string 1))
	      (setq in (read-line stream nil))
	      (setq in (map-euc-to-sjis in))
	      (string-match "teams[^>]+>\\([^<]+\\)" in)
	      (setq team (match-string 1))
	      (msgbox "~Aの~A、打撃好調" team name)
	      (return)))))))

• 結果