newLISP で祝祭日を計算する(改3)

 東京オリンピックが延期になったので、、、

(define WeekDays '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))

 (define (vernal year)   ; 春分の日
   (if (and (<= 2000 year) (< year 2100))
       (- (add 20.69115 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
 (define (autumnal year) ; 秋分の日
   (if (and (<= 2000 year) (< year 2100))
       (- (add 23.09 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4)))) 
(define (anniversary year month)
   (let (i (find (0 3 (date (date-value year month 1))) WeekDays)
         res '())     (case month       ( 1 (push (list year  1 1 '元日) res -1)    ; 元日
           (if (= i 0) (push (list year  1 2 '振替休日) res -1)) 
          (push (if (< i 2)                 ; 成人の日 : 1月第2月曜日
                     (list year  1 (-  9 i) '成人の日) ;  2 + 1 * 7
                   (list year  1 (- 16 i) '成人の日))  ;  2 + 2 * 7
                 res -1) )
       ( 2 (push (list year  2 11 '建国記念の日) res -1)   ; 建国記念の日
           (if (= i 4) (push (list year  2 12 '振替休日) res -1))
           (when (> year 2019) (push (list year 2 23 '天皇誕生日) res -1)   ; 天皇誕生日
           (if (= i 6) (push (list year 2 24 '振替休日) res -1))) )
       ( 3 (push (list year  3 (vernal year) '春分の日) res -1)   ; 春分の日
           (if (= i (- 22 ((res -1) 2))) (push (list year 3 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
       ( 4 (push (list year  4 29 '昭和の日) res -1)     ; 昭和の日
           (if (= i 0) (push (list year 4 30 '振替休日) res -1))
           (when (= year 2019)
               (push (list year  4  30 '特別振替休日) res -1)
            ) )
       ( 5 (push (list year  5  3 '憲法記念日) res -1)   ; 憲法記念日
           (push (list year  5  4 'みどりの日) res -1)   ; みどりの日
           (push (list year  5  5 'こどもの日) res -1)   ; こどもの日
           (if (and (< 2 i) (< i 6)) (push (list year  5  6 '振替休日) res -1))
           (when (= year 2019)               (push (list year  5  1 '天皇即位の日) res -1) 
              (push (list year  5  2 '特別振替休日) res -1)            ) )
       ( 6 )
       ( 7 (if (= year 2021) (begin (push (list year 7 22 '海の日) res -1)
                                    (push (list year 7 23 'スポーツの日) res -1))
               (= year 2020) (begin (push (list year 7 23 '海の日) res -1)
                                    (push (list year 7 24 'スポーツの日) res -1))
             (push (if (< i 2)                 ; 海の日 : 7月第3月曜日
                     (list year  7 (- 16 i) '海の日) ;  2 + 2 * 7
                   (list year  7 (- 23 i) '海の日))  ;  2 + 3 * 7
                 res -1) ))
       ( 8 (if (= year 2021) (begin (push (list year  8  8 '山の日) res -1)    ; 2021年山の日
                                    (push (list year  8  9 '振替休日) res -1)) ; 山の日振替
               (= year 2020) (push (list year  8 10 '山の日) res -1)     ; 2020年山の日
               (> year 2015) (push (list year  8 11 '山の日) res -1))    ; 山の日
           (if (= i 4) (push (list year 8 12 '振替休日) res -1)))
       ( 9 (push (if (< i 2)                 ; 敬老の日 : 9月第3月曜日
                     (list year  9 (- 16 i) '敬老の日) ;  2 + 2 * 7
                   (list year  9 (- 23 i) '敬老の日))  ;  2 + 3 * 7
                 res -1)
           (push (list year  9 (autumnal year) '秋分の日) res -1) ; 秋分の日
           (if (= i (- 29 ((res -1) 2)) (push (list year 9 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
           (if (= 2 (- ((res 1) 2) ((res 0) 2)))
                 (push (list year  9 (- ((res -1) 2) 1) '国民の休日) res 1)) )
       (10 (if (< year 2000) (push (list year 10 10 '体育の日) res -1)
               (< year 2020)
                   (push (if (< i 2)                 ; 体育の日 : 10月第2月曜日
                     (list year 10 (-  9 i) '体育の日) ;  2 + 1 * 7
                   (list year 10 (- 16 i) '体育の日))  ;  2 + 2 * 7                 res -1)
               (> year 2021)
                   (push (if (< i 2)                 ; スポーツの日 : 10月第2月曜日
                     (list year 10 (-  9 i) 'スポーツの日) ;  2 + 1 * 7
                   (list year 10 (- 16 i) 'スポーツの日))  ;  2 + 2 * 7
                 res -1))
           (when (= year 2019) 
               (push (list year 10 22 '即位礼正殿の儀) res -1)) )
       (11 (push (list year 11  3 '文化の日) res -1)   ; 文化の日
           (if (= i 5) (push (list year 11  4 '振替休日) res -1))
           (push (list year 11 23 '勤労感謝の日) res -1)   ; 勤労感謝の日
           (if (= i 6) (push (list year 11 24 '振替休日) res -1)))
       (12 (when (< year 2019) (push (list year 12 23 '天皇誕生日) res -1)   ; 天皇誕生日
           (if (= i 6) (push (list year 12 24 '振替休日) res -1)) ))
       (true ))
     res))

 さて、これを使って VCSファイルを作るにはこちらのスクリプトをお使いください。
 2021年のVCSファイルはこちらに掲載しています。
以上、如何でしょうか?

newLISP で祝祭日を計算する(改2)

ようやく、2020年以降にも対応しました(汗)

(define (vernal year)   ; 春分の日
  (if (and (<= 2000 year) (< year 2100))
      (- (add 20.69115 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (autumnal year) ; 秋分の日
  (if (and (<= 2000 year) (< year 2100))
      (- (add 23.09 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (anniversary year month)
  (let (i (find (0 3 (date (date-value year month 1))) *WeekDays*)
        res '())
    (case month
      ( 1 (push (list year  1 1 '元日) res -1)    ; 元日
          (if (= i 0) (push (list year  1 2 '振替休日) res -1))
          (push (if ( year 2019) (push (list year 2 23 '天皇誕生日) res -1)   ; 天皇誕生日
          (if (= i 6) (push (list year 2 24 '振替休日) res -1))) )
      ( 3 (push (list year  3 (vernal year) '春分の日) res -1)   ; 春分の日
          (if (= i (- 22 ((res -1) 2))) (push (list year 3 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
      ( 4 (push (list year  4 29 '昭和の日) res -1)     ; 昭和の日
          (if (= i 0) (push (list year 4 30 '振替休日) res -1))
          (when (= year 2019)
              (push (list year  4  30 '特別振替休日) res -1)
           ) )
      ( 5 (push (list year  5  3 '憲法記念日) res -1)   ; 憲法記念日
          (push (list year  5  4 'みどりの日) res -1)   ; みどりの日
          (push (list year  5  5 'こどもの日) res -1)   ; こどもの日
          (if (and (< 2 i) (< i 6)) (push (list year  5  6 '振替休日) res -1))
          (when (= year 2019)
              (push (list year  5  1 '天皇即位の日) res -1)
              (push (list year  5  2 '特別振替休日) res -1)
           ) )
      ( 6 )
      ( 7 (if (= year 2020) (begin (push (list year 7 23 '海の日) res -1)
                                   (push (list year 7 24 'スポーツの日) res -1))
            (push (if ( year 2015) (push (list year  8 11 '山の日) res -1))    ; 山の日
          (if (= i 4) (push (list year 8 12 '振替休日) res -1)))
      ( 9 (push (if (< i 2)                 ; 敬老の日 : 9月第3月曜日
                    (list year  9 (- 16 i) '敬老の日) ;  2 + 2 * 7
                  (list year  9 (- 23 i) '敬老の日))  ;  2 + 3 * 7
                res -1)
          (push (list year  9 (autumnal year) '秋分の日) res -1) ; 秋分の日
          (if (= i (- 29 ((res -1) 2)) (push (list year 9 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
          (if (= 2 (- ((res 1) 2) ((res 0) 2)))  
              (push (list year  9 (- ((res -1) 2) 1) '国民の休日) res 1)) )
      (10 (if (< year 2000) (push (list year 10 10 '体育の日) res -1)
              (< year 2020)
                  (push (if ( year 2020)
                  (push (if (< i 2)                 ; スポーツの日 : 10月第2月曜日
                    (list year 10 (-  9 i) 'スポーツの日) ;  2 + 1 * 7
                  (list year 10 (- 16 i) 'スポーツの日))  ;  2 + 2 * 7
                res -1))
          (when (= year 2019) 
              (push (list year 10 22 '即位礼正殿の儀) res -1)) )
      (11 (push (list year 11  3 '文化の日) res -1)   ; 文化の日
          (if (= i 5) (push (list year 11  4 '振替休日) res -1))
          (push (list year 11 23 '勤労感謝の日) res -1)   ; 勤労感謝の日
          (if (= i 6) (push (list year 11 24 '振替休日) res -1)))
      (12 (when (< year 2019) (push (list year 12 23 '天皇誕生日) res -1)   ; 天皇誕生日
          (if (= i 6) (push (list year 12 24 '振替休日) res -1)) ))
      (true ))
    res))

 さて、これを使って VCSファイルを作るにはこちらのスクリプトをお使いください。
 2020年のVCSファイルはこちらに掲載しています。
以上、如何でしょうか?

newLISP 開発版マニュアル v.10.7.5 日本語訳公開

 久々の安定版。

 ということで、newLISP User Manual and Reference の全訳のリリースです。

newlisp_manual-10705
こちらからダウンロードしてください。

 目次も含め日本語併記にしてあります。

 Lutz氏のご好意によりこちらから見ることもできます。

 いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報ください。

 以上、如何でしょうか?

newLISP で祝祭日を計算する(改)

2019年と2020年の祝日は特例が多いようなので別掲載にしました。
と言っても、今回は2019年対応です(笑)

(define *WeekDays* '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
(define (vernal year)   ; 春分の日
  (if (and (<= 2000 year) (< year 2100))
      (- (add 20.69115 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (autumnal year) ; 秋分の日
  (if (and (<= 2000 year) (< year 2100))
      (- (add 23.09 (mul 0.242194 (- year 2000))) (/ (- year 2000) 4))))
(define (anniversary year month)
  (let (i (find (0 3 (date (date-value year month 1))) *WeekDays*)
        res '())
    (case month
      ( 1 (push (list year  1 1 '元日) res -1)    ; 元日
          (if (= i 0) (push (list year  1 2 '振替休日) res -1))
          (push (if ( year 2019) (push (list year 2 23 '天皇誕生日) res -1)   ; 天皇誕生日
          (if (= i 6) (push (list year 2 24 '振替休日) res -1))) )
      ( 3 (push (list year  3 (vernal year) '春分の日) res -1)   ; 春分の日
          (if (= i (- 22 ((res -1) 2))) (push (list year 3 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
      ( 4 (push (list year  4 29 '昭和の日) res -1)     ; 昭和の日
          (if (= i 0) (push (list year 4 30 '振替休日) res -1))
          (when (= year 2019)
              (push (list year  4  30 '特別振替休日(非確定)) res -1)
           ) )
      ( 5 (push (list year  5  3 '憲法記念日) res -1)   ; 憲法記念日
          (push (list year  5  4 'みどりの日) res -1)   ; みどりの日
          (push (list year  5  5 'こどもの日) res -1)   ; こどもの日
          (if (and (< 2 i) (< i 6)) (push (list year  5  6 '振替休日) res -1))
          (when (= year 2019)
              (push (list year  5  1 '特別祝日(非確定)) res -1)
              (push (list year  5  2 '特別振替休日(非確定)) res -1)
           ) )
      ( 6 )
      ( 7 (push (if ( year 2015)
            (push (list year  8 11 '山の日) res -1)     ; 山の日
            (if (= i 4) (push (list year 8 12 '振替休日) res -1))))
      ( 9 (push (if (< i 2)                 ; 敬老の日 : 9月第3月曜日
                    (list year  9 (- 16 i) '敬老の日) ;  2 + 2 * 7
                  (list year  9 (- 23 i) '敬老の日))  ;  2 + 3 * 7
                res -1)
          (push (list year  9 (autumnal year) '秋分の日) res -1) ; 秋分の日
          (if (= i (- 29 ((res -1) 2)) (push (list year 9 (+ 1 ((res -1) 2)) '振替休日) res -1)) )
          (if (= 2 (- ((res 1) 2) ((res 0) 2)))  
              (push (list year  9 (- ((res -1) 2) 1) '国民の休日) res 1)) )
      (10 (push (if (< i 2)                 ; 体育の日 : 10月第2月曜日
                    (list year 10 (-  9 i) '体育の日) ;  2 + 1 * 7
                  (list year 10 (- 16 i) '体育の日))  ;  2 + 2 * 7
                res -1)
          (when (= year 2019) 
              (push (list year 11 22 '即位礼正殿の儀休日(非確定)) res -1)) )
      (11 (push (list year 11  3 '文化の日) res -1)   ; 文化の日
          (if (= i 5) (push (list year 11  4 '振替休日) res -1))
          (push (list year 11 23 '勤労感謝の日) res -1)   ; 勤労感謝の日
          (if (= i 6) (push (list year 11 24 '振替休日) res -1)))
      (12 (when (< year 2019) (push (list year 12 23 '天皇誕生日) res -1)   ; 天皇誕生日
          (if (= i 6) (push (list year 12 24 '振替休日) res -1)) ))
      (true ))
    res))

 さて、これを使って VCSファイルを作るにはこちらのスクリプトをお使いください。
 2019年のVCSファイルはこちらに掲載しています。
以上、如何でしょうか?

newLISP 開発版マニュアル v.10.7.4 日本語訳公開

 今回は開発版のリリース。
 安定版のリリースが一年以上もありませんが、そろそろ近いのかも。

 ということで、newLISP 開発版の User Manual and Reference の全訳のリリースです。

newlisp_manual-10704
こちらからダウンロードしてください。

 目次も含め日本語併記にしてあります。

 いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報ください。

 以上、如何でしょうか?

DOS コマンド版 get-url を使ってみる。

 昨日紹介した 拙作 DOS コマンド版 get-url を newLISP で使ってみます。
 Wikipedia から今日の記念日・年中行事を取り出して見ましょう。
 先ずはスクリプトから、

(define (whatstoday (day (1 2 (now ((now) -2)))))
  (letn (str (apply append (exec (string "get-url http://ja.wikipedia.org/wiki/"
                              (day 0)
                              "%E6%9C%88"
                              (day 1)
                              "%E6%97%A5" " UTF8 "
                              (if utf8 "UTF8" "")
                              )))
         pos (find {id=".E8.A8.98.E5.BF.B5.E6.97.A5.E3.83.BB.E5.B9.B4.E4.B8.AD.E8.A1.8C.E4.BA.8B">} str)
         pos (find "" str 1 pos)
         pos (+ pos 5)
         kday (0 (find "<h" (pos str)) (pos str))
         kparse (xml-parse kday (+ 1 2 4 8))
         res '())
        (dolist (li-pos (ref-all 'li kparse))
          (setf (li-pos -1) (+ $it 1))
          (let (tmp "")
            (dolist (x (ref-all "TEXT" (kparse li-pos)))
              (setf (x -1) (+ $it 1))
              (push ((kparse li-pos) x) tmp -1))
              (unless (null? tmp)
                (push tmp res -1))))
        res))

 UTF8 版 newLISP での動作は、

> (whatstoday)
("防災とボランティアの日(日本)1995年に発生した阪神・淡路大震災(兵庫県南部地震)では、国や地方自治体の危機管理体制の不備をはじめとするさまざまな問題が浮き彫りにされた一方で、ボランティア活動が活発化し「ボランティア元年」とも言われた。俳句の世界では季語「阪神忌」が存在する。" 
 "おむすびの日(日本)JA等でつくる「ごはんを食べよう国民運動推進協議会」が2000年11月に制定。阪神大震災ではボランティアの炊き出しで被災者が励まされたことから。" 
 "ひょうご安全の日(日本兵庫県)兵庫県が2006年に制定。" "尾崎紅葉祭(日本静岡県熱海市)尾崎紅葉の『金色夜叉』の中で、この日に熱海の海岸で主人公の貫一が恋人のお宮と別れる記述があることから。")
> 

 こんな感じ(1月17日)。
 ansi 版 newLISP なら

> (whatstoday '(1 18))
("\131^\131C\137\164\141\145\140R\130\204\147\250\129i\131^\131C\129j" "\147s\131o\131X\130\204\147\250\129i\147\250\150{\129j1924\148N1\140\14218\147\250\130\201\147\140\139\158\142s\137c\143\230\141\135\131o\131X\130\170\137c\139\198\130\240\138J\142n\130\181\130\189\130\177\130\198\130\201\151R\151\136\130\181\129A\147\140\139\158\147s\140\240\146\202\139\199\130\170\144\167\146\232\129B" 
 "118\148\212\130\204\147\250\129i\147\250\150{\129j\139\217\139}\146\202\149\241\151p\147d\152b\148\212\141\134118\148\212\130\204\146m\150\188\147x\140\252\143\227\130\204\130\189\130\223\129A2011\148N1\140\14218\147\250\130\230\130\232\138C\143\227\149\219\136\192\146\161\130\170\144\167\146\232\129B")
> 

 以上、如何でしょうか?

newLISP マニュアル v.10.7.1 日本語訳公開

 ほぼ1年ぶりの安定版リリース。
 新規関数として、history が追加されています。

 ということで、newLISP の User Manual and Reference の全訳のリリースです。

newlisp_manual-10701
こちらからダウンロードしてください。

 目次も含め日本語併記にしてあります。
 Lutz氏のご好意によりこちらから見ることもできます。

 いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報ください。

 以上、如何でしょうか?

command-event で load を楽に

 以前、newLISP 組込関数の構文オンライン表示で使った command-event
 今回は、これを使って、ファイル名だけで lsp ファイルをロードします。

(command-event (fn (s)
  (let (x (read-expr s))
    (let (f (string x))
      (when (and (starts-with f "'") (ends-with f ".lsp"))
        (print "load ")
        (if (file? (1 f)) (load (1 f)) (println (1 f) "\nERR: no file")))))))

 末尾が “.lsp” の時、その lsp ファイルをロードします。
 ただし、ファイル名の先頭には、クォート(’)をつけます。
 使い方は、

C:\Language\newlisp>newlisp -n
newLISP v.10.7.0 32-bit on Windows IPv4/6 UTF-8 libffi, options: newlisp -h

>
(command-event (fn (s)
  (let (x (read-expr s))
    (let (f (string x))
      (when (and (starts-with f "'") (ends-with f ".lsp"))
        (print "load ")
        (if (file? (1 f)) (load (1 f)) (println (1 f) "\nERR: no file")))))))

$command-event
> $command-event
(lambda (s)
 (let (x (read-expr s))
  (let (f (string x))
   (when (and (starts-with f "'") (ends-with f ".lsp"))
    (print "load ")
    (if (file? (1 f))
     (load (1 f))
     (println (1 f) "\nERR: no file"))))))
> jdate
nil
> jdate.lsp
nil
> jdate
nil
> 'jdate.lsp
load jdate.lsp
> jdate
jdate
> (jdate)
"2016/9/28 20:59:45 水"
>

 こんな感じ。もちろん、フルパスも使えます。
 
 jdate については、こちらでどうぞ。
 
 以上、如何でしょうか?

projecteuler30

 projecteuler問題30は、自然数の各桁の 5 乗の和が、その自然数になるものを求め、その和を取るという問題。
 だから(汗)、スクリプトは力技で、

(define (pf i)
  (* i i i i i))
(let (lst)
  (for (i 2 999999)
   (if (= i (apply + (map pf (map int (explode (string i))))))
     (push i lst -1))
   )
  (println lst)
  (apply + lst)
)

 こんな感じ。
 これを実行すると

(4150 4151 54748 92727 93084 194979)
443839
> 

 と、自然数のリストとその和が出てきます。
 つまり、答えは 443839 。

 以上、如何でしょうか?

日付関数の日本語化、解説編...または、2038年問題対応?

 今回実装した関数 jdate, jdate:list, jdate:parse, jdate:value, jdate:now の内、list, parse, now は newLISP 組込関数と名前が同じです。通常、組込関数名は変数名にも関数名にも使えませんが、コンテキスト内でコンテキスト名を先付けして

jdate:list, jdate:parse, jdate:now

 とすれば、定義できます。
 また、これらを定義した場合、同名の newLISP 組込関数の呼び出しには、

MAIN:list, MAIN:parse, MAIN:now

 と書く必要もあります。
 それさえ気を付ければ、使いたい変数名や関数名が newLISP 組込関数名と同じだと嘆く必要はありません。まあ、そんなことは、無いでしょうけど(笑)
 この点が今回実装のポイントの一つです。
 さて、日付間の日本語化、前にも実装したことがあります。
 今回、敢えて実装したのは、前述のようにコンテキストにまとめたかったのと、2038年問題にも対応しておこうと思ったからです。
 newLISP は標準ライブラリを使って、あらゆるプラットフォームでの互換性を維持しています。そのため、日付に関する経過秒数を表現する型 time_t は、符号つき 32 ビットで 2038年1月19日3時14分7秒 までしか表現できません。これは、 64 ビット版 newLISP でも同じで、互換性維持のためだと思いますが、敢えて符号つき 32 ビットを使っています。
 だから、これは仕様です。まあ、あと20年はありますから、それまでに解決されるでしょうけど、、、
 それでも、20年くらい先はまだ生きていると思うので、その頃の予定を立てることがあるかもしれません。だから、取り敢えず、符号なし 32 ビット (2106年2月7日6時28分15秒相当)で実装してみました。本来なら、64 ビットで定義すべきですが、2100 年以降の予定なんて考えないから、これで十分かと(笑)
 calcDateValue と gmtime が、そのための関数です。
 一応、

> (jdate:value 2038 1 8)
2146489200
> (jdate:value 2106 2 6)
4294825200
> (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M")
4294848480
> (jdate:list (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M"))
(2106 2 6 6 28 0 37 6)
> 

 こんな感じで、使えます。

 以上、如何でしょうか?

追記:
 V10.7.0 の windoows 版で now を実行すると

> (now)
(2016 3 16 8 54 40 297940 76 3 600 -60)
> 

 このように、タイムゾーンのオフセット(分単位)が 600 となります。
 日本では 540 のはずなので、V10.7.0 の windoows 版のバグです。
 この点については Lutz氏 もわかっていて、次回、訂正されるそうです。
 それまで、ご注意を。