Archive for the ‘Utility’ Category
入れ子リストに 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ファイルはこちらに掲載しています。
以上、如何でしょうか？
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年に制定。" "尾崎紅葉祭（日本静岡県熱海市）尾崎紅葉の『金色夜叉』の中で、この日に熱海の海岸で主人公の貫一が恋人のお宮と別れる記述があることから。")
>
こんな感じ（１月１７日）。
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")
>
以上、如何でしょうか？
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 については、こちらでどうぞ。
以上、如何でしょうか？
日付関数の日本語化、解説編．．．または、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氏 もわかっていて、次回、訂正されるそうです。
それまで、ご注意を。
日付関数の日本語化
newLISP の日付関数には、date, date-list, date-parse, date-value, now 等がありますが、date 以外はグリニッジ標準時なので、日本時間で使うには補正が必要です。
また、date も
> (date) "Tue Mar 15 16:00:19 2016" >
こんな風に、英語表記です。
そこで、日本語表記、日本時間用の日付関数を定義してみました。
(context 'MAIN:jdate)
(setq YEAR0 1900 EPOCH_YR 1970 SECS_DAY (* 24 60 60))
(define (calcDateValue year month day (hour 0) (int-min 0) (sec 0))
; Algorithm quoting from newLISP source.
(let (dateValue)
(setq dateValue (+ (* 367 year) (- (/ (* 7 (+ year (/ (+ month 9) 12))) 4)) (/ (* 275 month) 9) day 1721013))
(setq dateValue (+ (* dateValue 24 3600) (* hour 3600) (* int-min 60) sec -413319296))
(setq dateValue (& dateValue 0xFFFFFFFF))
(if (>= dateValue 4107596400) (-- dateValue 86400) dateValue)))
(define (leap (y ((now) 0)))
(if (and (zero? (% y 4))
(or (zero? (% y 400))
(not (zero? (% y 100))))) 1 0))
(define (yearsize year) (+ (leap year) 365))
(define _ytab '((31 28 31 30 31 30 31 31 30 31 30 31)(31 29 31 30 31 30 31 31 30 31 30 31)))
(define (gmtime tm)
; Algorithm quoting from common C-library source.
(letn (year EPOCH_YR
dayclock (% tm SECS_DAY)
dayno (/ tm SECS_DAY)
tm_sec (% dayclock 60)
tm_min (/ (% dayclock 3600) 60)
tm_hour (/ dayclock 3600)
tm_wday (% (+ 4 dayno) 7))
(while (>= dayno (yearsize year))
(-- dayno (yearsize year))
(++ year))
(let (tm_year (- year 0); YEAR0
tm_yday dayno
tm_mon 0
tm_mday 1)
(while (>= dayno (_ytab (leap year) tm_mon))
(-- dayno (_ytab (leap year) tm_mon))
(++ tm_mon))
(++ tm_mday dayno)
(if (= tm_wday 0) (++ tm_wday 7))
(list tm_year (++ tm_mon) tm_mday tm_hour tm_min tm_sec (++ tm_yday) tm_wday))))
(define (jdate:now (offset 540) idx)
(if idx (MAIN:now offset idx) (MAIN:now offset)))
(define (jdate:value)
(if (args) (- (apply calcDateValue (args)) (* 9 60 60))
(date-value)))
(define (jdate:list (sec (jdate:value)) idx)
(letn (offset (* 9 60 60)
lst (gmtime (+ sec offset)))
(if idx (idx lst) lst)))
(define (jdate:jdate (value (jdate:value)))
(let (lst (jdate:list value)
str (if utf8 '(227 128 63 230 156 136 231 129 171 230 176 180 230 156 168 233 135 145 229 156 159
230 151 165)
'(129 64 140 142 137 206 144 133 150 216 139 224 147 121 147 250)))
(append (join (map string (0 3 lst)) "/") " "
(join (map string (3 3 lst)) ":") " "
(if utf8 ((* 3 (lst 7)) 3 (pack (dup "b" (length str)) str))
((* 2 (lst 7)) 2 (pack (dup "b" (length str)) str))))))
(define (jdate:parse dateStr formatStr , res)
(if (= formatStr "%c") (setq formatStr "%m/%d/%y %H:%M:%S"))
(let (specs (find-all "(%.)" formatStr)
regStr (replace "(%.)" (replace "." formatStr "\\.") "(.+)" 0)
months '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
Months '("" "January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December")
dateLst '(1900 1 1 0 0 0))
(setq res (regex regStr dateStr))
(when res
(setq res (rest (filter string? res)))
(when (= (length specs) (length res))
(dolist (i (transpose (MAIN:list specs res)))
(case (i 0)
("%b" (setf (dateLst 1) (find (i 1) months 1)))
("%B" (setf (dateLst 1) (find (i 1) Months 1)))
("%d" (setf (dateLst 2) (int (i 1) 0 10)))
("%H" (setf (dateLst 3) (int (i 1) 0 10)))
("%m" (setf (dateLst 1) (int (i 1) 0 10)))
("%M" (setf (dateLst 4) (int (i 1) 0 10)))
("%S" (setf (dateLst 5) (int (i 1) 0 10)))
("%Y" (setf (dateLst 0) (int (i 1) 0 10)))
("%y" (setf (dateLst 0) (int (string "20" (i 1)))))
(true )))))
(if-not (find nil dateLst) (apply jdate:value dateLst))))
(context MAIN) 使える関数は、jdate, jdate:list, jdate:parse, jdate:value, jdate:now で、それぞれ date, date-list, date-parse, date-value, now に対応します。
使い方は、
> (jdate) "2016/3/16 17:8:15 火" > (jdate:list) (2016 3 16 17 8 23 75 2) > (jdate:value 2016 3 16) 1458054000 > (jdate:now) (2016 3 15 17 8 48 630885 75 2 600 -60) > (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M") 1287352800 > (jdate:list (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M")) (2010 10 18 7 0 0 291 1) >
こんな感じ、解説は次回に、、、
追記：2020/ 7/13
関数 gmatime 修正(tm_wday)
関数 parse 修正(months)
FOOP で DAG する、その２
前回の FOOP で DAG する は如何だったでしょうか？
今回は、DAG (Directed acyclic graph) で a 地点から b 地点までの経路を検索するスクリプトを追加してみます。
ということで、コードは、
(define (DAG:search a b (res '()))
(let (connects (DAG:search-pre b))
(if (= connects "start") nil
(dolist (c connects)
(let (tmp (append (list c) res))
(if (= (c 0) a) (push tmp DAG:result -1)
(DAG:search a (c 0) tmp)))))))
(define (DAG:search-a2b a b)
(setq DAG:result '())
(DAG:search a b)
DAG:result)
何と DAG データの引き渡しらしき箇所がない（笑）、、、FOOP ですから。
これを前回のスクリプトに追加して実行します。
使い方は、
> (setq mydag2 (DAG '((a b) (b c) (b d) (b e) (g d) (c e) (d e) (e f)))) (DAG ((a b) (b c) (b d) (b e) (g d) (c e) (d e) (e f))) > (:search-a2b mydag2 'g 'f) (((g d) (d e) (e f))) > (:search-a2b mydag2 'a 'f) (((a b) (b e) (e f)) ((a b) (b c) (c e) (e f)) ((a b) (b d) (d e) (e f))) >
こんな感じ。
以上、如何でしょうか？
FOOP で DAG する
前回の DAG スクリプトは如何だったでしょうか？
search-XXX なんて関数名は有りがちな名前。そんな時、関数名の衝突を避けるには FOOP（Functional-Object Oriented Programming ）なんてもってこい。
とは言え、newLISP の目玉でもある FOOP を使ってこなかった私。この辺で覚書きでも作っておこうかと、、、
ということで、コードは、
(new Class 'MAIN:DAG)
(define (DAG:DAG lst)
(list DAG lst))
(define (DAG:nodes)
(self 1))
(define (DAG:search-pre)
(letex (_x (args 0))
(if (find-all '(? _x) (self 1)) $it "start")))
(define (DAG:search-next)
(letex (_x (args 0))
(if (find-all '(_x ?) (self 1)) $it "end")))
(define (DAG:search-all)
(letex (_x (args 0))
(local (res)
(dolist (x (self 1))
(if (match '(? _x) x) (push x res -1)
(match '(_x ?) x) (push x res -1)))
res)))
ポイントは、オブジェクト・データ部分のアクセスが self になること。
とわかっていても、私には慣れが必要かも。引数の扱いが、、、
さて、使い方は、
> (set 'mydag (DAG '((a c) (b c) (c d) (c g) (d e) (d f)))) (DAG ((a c) (b c) (c d) (c g) (d e) (d f))) > (:nodes mydag) ((a c) (b c) (c d) (c g) (d e) (d f)) > (:search-all mydag 'd) ((c d) (d e) (d f)) > (:search-pre mydag 'd) ((c d)) > (:search-next mydag 'd) ((d e) (d f)) > (:search-pre mydag 'a) "start" > (:search-next mydag 'g) "end" >
こんな感じ。
以上、如何でしょうか？
newLISP で DAG する．．．または、match な find-all
DAG (Directed acyclic graph) とは有向非巡回グラフのことらしい。
といっても、DAG が何かわからずにコードを書いた私。
きっかけは、newLISP Foram の投稿から。
これは簡単にコード化はできそうだと思い、書いて投降したのですが、、、
何か、しっくりこなかったのです。newLISP らしくないというか、、、
同投稿で rickyboy 氏が find に match を使っているのを見て、思い出しました。 find-all がリストに対して match になる（第二構文）ことを。
(if (replace nil (map (fn (x) (match '(? _x) x true)) lst)) $it "start")
なんて、長ったらしいコードは、find-all を使えば、
(if (find-all '(? _x) lst) $it "start")
ああ、すっきり。
前にも、こんなことがあったのを思い出し、忘れないよう blog に（笑）
先に newLISP Foram に投降したコードは、こんな感じに変わります。
(define (search-pre lst)
(letex (_x (args 0))
(if (find-all '(? _x) lst) $it "start")))
(define (search-next lst)
(letex (_x (args 0))
(if (find-all '(_x ?) lst) $it "end")))
(define (search-all lst)
(letex (_x (args 0))
(local (res)
(dolist (x lst)
(if (match '(? _x) x) (push x res -1)
(match '(_x ?) x) (push x res -1)))
res)))
ついでに newLISP らしく、if の cond 的な使い方も（笑）
以上、如何でしょうか？
新リスプな日々 