入れ子リストに map する、、、または文字列のUTF8化

 clié のバッテリーがついに壊れ、palm から離れることに、、、
 とは言え、今までのデータを見るためのスクリプトは用意してあり、心配はないのですが、、、
 この辺でSJISコードをUTF8コードに変換することに。
 そこで、データ(入れ子リスト)中の文字列だけを操作するスクリプトを考えました。

(define (test x)
   (if (list? x) (map test x)
  (string? x) (sjis2utf8 x)
  x))

 ここで sjis2utf8 は前に作ったSJIS文字列をUTF8文字列に変換するスクリプト
 ん、これはもしかして、汎用化できるかも、、、
 と、考えたのが次のスクリプト

(define (map1all func x (pre? or))
  (if (list? x) (map (fn(x) (map1all func x pre?)) x)
  (pre? x) (func x)
  x))

 最初は map-all と名付けるつもりでしたが、1変数関数にしか使えないの map1all に(汗)
 使い方はこんな感じ、
 今回は文字列だけに適用したいので関数 map1all の第3変数に string? 述語が必要。

newLISP v.10.7.5 64-bit on Windows IPv4/6 libffi, options: newlisp -h

> category
((1 1 0 "\131r\131W\131l\131X" "\131r\131W\131l\131X") (2 2 0 "\131p\129[\131\\\131i\131\139" 
  "\131p\129[\131\\\131i") 
 (3 17 0 "\131e\131j\131X" "\131e\131j\131X") 
 (4 128 0 "\143\238\149\241" "\143\238\149\241") 
 (5 129 0 "\131J\131\129\131\137" "\131J\131\129\131\137") 
 (6 130 0 "\145\183\142q" "\145\183\142q") 
 (7 131 0 "BS" "BS") 
 (8 132 0 "\142\145\151\191" "\142\145\151\191") 
 (9 18 0 "LispMe" "LispMe") 
 (10 133 0 "\138i\140\190\129E\150@\145\165" "\138i\140\190\129E\150@") 
 (11 134 0 "\130\168\137\217\142q" "\130\168\137\217\142q"))
> (map1all sjis2utf8 category string?)
((1 1 0 "\227\131\147\227\130\184\227\131\141\227\130\185" "\227\131\147\227\130\184\227\131\141\227\130\185") 
 (2 2 0 "\227\131\145\227\131\188\227\130\189\227\131\138\227\131\171" "\227\131\145\227\131\188\227\130\189\227\131\138") 
 (3 17 0 "\227\131\134\227\131\139\227\130\185" "\227\131\134\227\131\139\227\130\185") 
 (4 128 0 "\230\131\133\229\160\177" "\230\131\133\229\160\177") 
 (5 129 0 "\227\130\171\227\131\161\227\131\169" "\227\130\171\227\131\161\227\131\169") 
 (6 130 0 "\229\173\171\229\173\144" "\229\173\171\229\173\144") 
 (7 131 0 "BS" "BS") 
 (8 132 0 "\232\179\135\230\150\153" "\232\179\135\230\150\153") 
 (9 18 0 "LispMe" "LispMe") 
 (10 133 0 "\230\160\188\232\168\128\227\131\187\230\179\149\229\137\135" "\230\160\188\232\168\128\227\131\187\230\179\149") 
 (11 134 0 "\227\129\138\232\143\147\229\173\144" "\227\129\138\232\143\147\229\173\144"))
> 

 これで、入れ子リスト中の文字列だけの操作はおてのもの(笑)
 以上、如何でしょうか。

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 。

 以上、如何でしょうか?