top
recent
プログラミング:企画もの:お題１
関連ページ
プログラミング
プログラミング:企画もの
目次
- お題「カレンダーを作る」...
- とりあえず２ゲット...
- Emacs Lisp 版...
- Scheme (Gauche) 版...
- 意図としては...
- PHP版...
- GikoForth版...
- 簡単 Ruby 版...
- 動けばいい Haskell 版...
- いまいちなFP:inRuby版...
- Squeak 3.2 版...
- Squeak 3.2 一行野郎版...
- collect:thenSelect: 疑惑...
- 解体その１...
- こんなのはセコイですかねえ。...
お題「カレンダーを作る」
入力：
- 年::Integer, 月::Integer
出力：
- "<TABLE>" の１行で始まり "</TABLE>" の１行で終わるHTMLのコード片
- 複数行の文字列
- HTML内の改行・インデントは任意
言語：
- 自由
形式：
- 関数、手続き、サブルーチン、クラスなどで、ひとまとまりの部品になっていること
[[id:961]] 2002-08-09 11:50:49
とりあえず２ゲット
cal | awk 'BEGIN{print "<TABLE>";getline;printf("<TR><TH COLSPAN=8>%s\n",$0)}{printf("<TR><TD ALIGN=\"right\" COLSPAN=%d>",8-NF);for(i=1;i<=NF;i++) printf("%s<TD ALIGN=\"right\">", $i)}{print ""}END{print "</table>"}'
‥‥‥え？ 一行野郎コンテストじゃないの？
[[id:962]] 2002-08-09 12:24:03
Emacs Lisp 版
昔 EmacsWiki 用に書いたやつをちょっと修正
- 今見ると非常にべったりとした手続き型のコードです。ループを(無理矢理)再帰に置き換えただけという。(^^;
(load-library "mhc-date.el")
(defun html-calendar (y m)
(interactive)
(let* ((from (list y m 1))
(to (ddate-mm-last-day from)))
(concat "<TABLE>\n"
"<CAPTION>" (ddate-yymm-s from) "</CAPTION>\n"
"<TR><TH>Su<TH>Mo<TH>Tu<TH>We<TH>Th<TH>Fr<TH>Sa\n"
"<TR>"
(let ((f
(lambda (n)
(if (> n 0)
(concat "<TD>"
(funcall f (- n 1)))))))
(funcall f (ddate-ww from)))
(let ((fn
(lambda (d)
(if (ddate<= d to)
(concat
(if (= 0 (ddate-ww d)) "\n<TR>")
(concat "<TD>" (ddate-dd-s d))
(funcall fn (ddate-inc d)))))))
(funcall fn from))
"\n</TABLE>")))
(html-calendar 2002 08)
==> "<TABLE>
<CAPTION>200208</CAPTION>
<TR><TH>Su<TH>Mo<TH>Tu<TH>We<TH>Th<TH>Fr<TH>Sa
<TR><TD><TD><TD><TD><TD>01<TD>02<TD>03
<TR><TD>04<TD>05<TD>06<TD>07<TD>08<TD>09<TD>10
<TR><TD>11<TD>12<TD>13<TD>14<TD>15<TD>16<TD>17
<TR><TD>18<TD>19<TD>20<TD>21<TD>22<TD>23<TD>24
<TR><TD>25<TD>26<TD>27<TD>28<TD>29<TD>30<TD>31
</TABLE>"
[[id:975]] 2002-08-13 21:59:08
Scheme (Gauche) 版
んーと、求められてる要素は
- カレンダの計算(与えられた月には何日あるのかとか、何曜日から始まるのかとか)
- カレンダのデータをhtmlのtableで出力
の2点、なんでしょうか。言語そのものより実装のライブラリの充実度がポイントになりそう。
Schemeにはsrfi-19ライブラリである程度のカレンダ計算が定義されているので使ってみました。月の日数を求めるのは自分でテーブルを持ったほうがわかりやすいかも。htmlにするところはGaucheのライブラリを使っちゃっています。
(use srfi-1) ; list library
(use srfi-19) ; time and date library
(use text.html-lite)
(use text.tree)
(define (cal year month)
(receive (next-month next-year)
(if (= month 12) (values 1 (+ year 1)) (values (+ month 1) year))
(let* ((start-date (make-date 0 0 0 0 1 month year 0))
(end-date (make-date 0 0 0 0 1 next-month next-year 0))
(num-days (inexact->exact
(- (date->modified-julian-day end-date)
(date->modified-julian-day start-date))))
(start-dow (date-week-day start-date))
(date-list (iota (+ start-dow num-days) (- 1 start-dow)))
;; weeksは週毎に区切った日付のリスト(範囲外は負数)
(weeks (let loop ((dates date-list)
(num-left (+ start-dow num-days))
(r '()))
(cond
((= num-left 7) (cons dates r))
((< num-left 7)
(cons (append dates (make-list (- 7 num-left) -1)) r))
(else
(loop (drop dates 7) (- num-left 7) (cons (take dates 7) r))))))
)
;; <tr>...</tr>を作る補助関数
(define (row dates)
(apply html:tr
(map (lambda (day)
(html:td (cond ((string? day) day)
((positive? day) (format #f "~2d" day))
(else " "))))
dates)))
;; 本体
(tree->string
(apply html:table
(html:caption #`",|year|/,|month|")
(row '("Su" "Mo" "Tu" "We" "Th" "Fr" "Sa"))
(map row (reverse weeks))))
)))
[[id:1013]] 2002-08-19 20:17:44
意図としては
Re: Scheme (Gauche) 版
(#4)
> 言語そのものより実装のライブラリの充実度がポイントになりそう。
いまどきの言語ならば日付やHTMLのライブラリは大抵探せば転がっていると思うのですが、それらの二つの要素をどう組み合わせるか、そこに言語やプログラミングスタイルで違いが出て来るかな、と思ってこういうお題にしてみました。
# 某ページで「[[糊]]」といっていたものですね。
いまのところ作例が偏りすぎていて、そういう違いは楽しめないのですが。(笑)
# SHIMADA
----
ははは＞作例が偏りすぎ
「糊」が主題なら、日付のリストを作る関数とHTML化する関数を分けた方が良かったかな。
で、これがSchemeだと一回中間構造としてのリストをアロケートしなくちゃならないわけっすが(Re: Scheme (Gauche) 版
(#4) では一度フラットな日付のリストを作ってから分割しているので2回アロケートしてます)、lazyなHaskellあたりだと出力が要求する毎にリストが作られるように出来るのかしらん。 --Schemer
[[id:1015]] 2002-08-19 23:06:07
PHP版
わざと関数内にHTMLモードを混ぜてみました。
これがPHPの「糊」かなと思うので。
でも文字列を返す、という仕様からは外れているなー。 --SHIMADA
-我ながら、二重ループがなんとも難解さをかもし出しているなぁ‥‥‥。
--カウンタなどの名前を役割に即したものにしてみた。でも row に7を掛けて col を足すというのも意味的にナニな感じがする。
--計算部分を別関数にしてみた。そういえば行や列じゃなくて第y週の第x曜日なら掛けたり足したりしてもおかしくないか。
--あ"、12月だと mlength の計算が狂うかも。Σ('o';
function calender($year, $month) {
$jd_first = GregorianToJD($month,1,$year);
$jd_next = GregorianToJD($month+1,1,$year);
$dow_first = JDDayOfWeek($jd_first, 0);
$mlength = $jd_next - $jd_first;
?>
<table>
<caption><?= $year ?>/<?= $month ?></caption>
<tr><th>Su<th>Mo<th>Tu<th>We<th>Th<th>Fr<th>Sa
<? for ($row = 0; $row < 6; $row++): ?>
<tr>
<? for ($col = 0; $col < 7; $col++): ?>
<td align="right"><?= cell_value($row, $col, $dow_first) ?>
<? endfor; ?>
</tr>
<? endfor; ?>
</table>
<?
}
function cell_value($row, $col, $dow) {
$cell = $row * 7 + $col - $dow + 1;
if ($cell > 0 && $cell <= $mlength)
return sprintf("%02d", $cell);
else
return " ";
}
[[id:1016]] 2002-08-24 00:07:08
GikoForth版
- カレンダは自前で簡易計算しました。
- そのかわりに作ったばかりのListComprehensionもどきを使用。（無理やり）
- calは日付リストのリスト(解体その１
(#14))を作成し、cal>htmlがそれを文字列に変換します。
- 「2002 8 cal cal>html」でスタックに文字列が返ります。 # ばしを
include lc
|[ "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" ]| value wdList
: DayOfWeek { yr mn dy -- n }
mn 2 <= IF -1 +-> yr 12 +-> mn THEN
yr yr 4 / + yr 100 / - yr 400 / + 13 mn * 8 + 5 / + dy + 7 mod
;
: LastDayOfMonth { yr mn -- n }
mn 1- |[ 31 28 31 30 30 31 31 31 30 31 30 31 ]| ::at
mn 2 = IF yr 4 mod 0= yr 100 mod 0= - yr 400 mod 0= + negate + THEN
;
: cal { yr mn | ls ds -- yr mn ls }
|[ ]|| -> ls
|[ -5 ... yr mn LastDayOfMonth ]| -> ds
6 yr mn 1 DayOfWeek - ds ::drop!
BEGIN 7 ds ::take ls ::add 7 ds ::drop! ds ::size 0= UNTIL
yr mn ls
;
: cal>html { yr mn ls | dy func ds -- str }
:[ swap -> dy dy 0 > IF dy 2 [char] 0 n>$ ::@ ELSE "" THEN swap ]: -> func
|[ "<table><caption>" yr n>s "-" mn n>s "</caption>" $n ]| :[ ::+ ]: ::foldl1
"<tr>" ::+ [; (_ _ _) ; |[ "<th>" ]| ; wdList ; |[ "</th>" ]| ;] ::flatten1
:[ ::+ ]: ::foldl1 ::+ "</tr>" ::+ $n ::+
:[ -> ds
"<tr>" [; func :. (_ _ _) ; |[ "<td>" ]| ; ds ; |[ "</td>" ]| ;] ::flatten1
:[ ::+ ]: ::foldl1 ::+ "</tr>" ::+ $n ::+ ::+
]: ls ::each "</table>" ::+
;
- あう、最後の日の計算を間違ってた(T-T)(恥
[[id:1023]] 2002-08-21 18:09:14
簡単 Ruby 版
誰かもっとましなの書くさ :-)
- 順番にデータ組み立ててる割に関数への分割すらしてない．
- 気を使っているようでいてそうでもない．
- HTML のテーブルなんて書いたことないから適当に他人のを写した．
- 最大の難点はそもそも日付けの配列を作る必要なんてないっていうあたりだろうか．
-- first.upto(last) {} のブロック内でカレンダー組み立てられるよね....
....しまった，ひとまとまりのプログラムになってる....
#!/usr/bin/env ruby
require "date"
year, month = ARGV.map {|s| s.to_i}
today = Date.today
year = today.year if year.nil?
month = today.month if month.nil?
list = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
first = Date.new(year, month, 1)
first.wday.times {list << " "}
month += 1
if month > 12
year += 1
month = 1
end
last = Date.new(year, month, 1)
last -= 1
first.upto(last) {|d| list << "%2d"%d.day}
(6-last.wday).times {list << " "}
cal = <<CALHEAD
<table>
<tr><th colspan="8">#{first.year}/#{first.month}</th></tr>
CALHEAD
while not list.empty?
week = list.slice!(0, 7)
cal << " <tr>"
week.each {|d| cal << %(<td align="right">%s</td>)%d}
cal << "</tr>\n"
end
cal << <<CALEND
</table>
CALEND
puts cal
[[id:1028]] 2002-08-29 10:16:05
動けばいい Haskell 版
作者が同じだけに Ruby 版 とアルゴリズムが全く同じ :-P
- day of week を求めるのに date.rb から julian date の計算とそこから dow を求める計算をもってきた．
- julian date の計算でやたらと "fromIntegral" って coerce してるのは作者が全然型推論まわりをちゃんと理解してないから．
- part なんて作らなくてもたぶんライブラリにあるはず....
part n [] = []
part n xs = [take n xs] ++ part n (drop n xs)
leap year
| year `mod` 4 /= 0 = False
| year `mod` 400 == 0 = True
| year `mod` 100 == 0 = False
| otherwise = True
lastday year month
| month `elem` [1, 3, 5, 7, 8, 10, 12] = 31
| month `elem` [4, 6, 9, 11] = 30
| leap year = 29
| otherwise = 28
jd year month day
= floor (365.25 * (fromIntegral y + 4716))
+ floor (30.6001 * (fromIntegral m + 1))
+ d + b - 1524
where
m | month <= 2 = month + 12
| otherwise = month
y | month <= 2 = year - 1
| otherwise = year
a = floor (fromIntegral y / 100)
b = floor (2 - fromIntegral a + (fromIntegral a / 4))
d = day
dow year month day
= (jd year month day + 1) `mod` 7
calstr year month
= ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
++ replicate (dow year month 1) " "
++ map show [1..lastday year month]
++ replicate (6 - (dow year month (lastday year month))) " "
calline list
= foldl (\p x -> p ++ "<td align=\"right\">" ++ x ++ "</td>") " <tr>" list ++ "</tr>\n"
cal year month
= "<table>\n <tr><th colspan=\"8\">"
++ show year ++ "/" ++ show month
++ "</th></tr>\n"
++ foldl (\p x -> p ++ x) "" (map calline (part 7 (calstr year month)))
++ "</table>"
[[id:1035]] 2002-08-23 19:31:25
アンチョコは関数プログラミング
(本棚)
----
#!/usr/local/bin/ruby
require "date"
require "FP"
def fstday(year, month)
Date.new(year,month).cwday
end
def mlength(yr, mn)
feb = leap(yr) ? 29 : 28
[31,feb, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][mn+1]
end
def leap(yr)
Date.new(yr).leap?
end
def entries(fd, ml)
FP.cons( %w(Su Mo Tu We Th Fr Sa),
FP.group(7, FP.map(lambda{|d| d>0 ? d.to_s : " "},days(fd, ml))))
end
def days(fd, ml)
FP.map(lambda{|d| day?(d,ml) ? d : 0}, ((1 - fd)..(42 - fd)))
end
def day?(d, ml)
0 < d && d <= ml ? true : false
end
def cal(yr, mn)
fd = fstday(yr, mn)
ml = mlength(yr, mn)
htmlTABLE( yr.to_s + "/" + mn.to_s, entries(fd, ml) )
end
def htmlTABLE(cptn, tbl)
"<TABLE>\n<CAPTION>#{cptn.to_s}</CAPTION>\n" +
htmlTR(tbl) +
"</TABLE>\n"
end
def htmlTR(tds)
FP.foldr(lambda{|x,y| "<TR>#{htmlTD(x)}</TR>\n" + y}, "", tds)
end
def htmlTD(xs)
FP.foldr(lambda{|x,y| "<TD ALIGN=\"right\">#{x.to_s}</TD>" + y}, "", xs)
end
if __FILE__ == "cal.rb" then
p "cal(2002,8)"
print cal(2002,8)
end
[[id:1036]] 2002-08-23 23:51:11
Squeak 3.2 版
- 使えそうなクラスを総動員してみました。--sumim
| aMonth aYear aWeek htmlCalendar dayOfWeekRow weekRow aDate |
"setting month and year for the calendar you need"
aMonth _ 8. aYear _ 2002.
"Is Sunday the start day of week?"
Week startMonday ifTrue: [Week toggleStartMonday].
"picking the week up, which includes the first day of the month you choose"
aWeek _ Week fromDate: (Date newDay: 1 month: aMonth year: aYear).
"preparing an empty table for your calendar"
htmlCalendar _ HtmlTable new.
"adding the day of the week index row"
dayOfWeekRow _ HtmlTableRow new.
#(Su Mo Tu We Th Fr Sa) do: [ :dayOfWeek |
dayOfWeekRow addEntity: (
HtmlTableDataItem new addEntity: (
HtmlTextEntity new text: dayOfWeek asString))].
htmlCalendar addEntity: dayOfWeekRow.
"adding day of month cells"
[weekRow _ HtmlTableRow new.
0 to: 6 do: [ :idx |
weekRow addEntity: (
HtmlTableDataItem new addEntity: (HtmlTextEntity new text: (
((aDate _ aWeek firstDate addDays: idx) monthIndex == aMonth)
ifTrue: [aDate dayOfMonth asString] ifFalse: [''])))].
htmlCalendar addEntity: weekRow.
(aWeek _ aWeek next) firstDate monthIndex == aMonth] whileTrue.
"generating HTML"
^ htmlCalendar asHtml
[[id:1037]] 2002-08-24 01:41:17
Squeak 3.2 一行野郎版
- 配列をこねくり回してみました。--sumim
-- 長っ！ 改行してインデントつけてみようと思ったら、本当につながってるんですね。右にどんどん深くなる…(^^; --SHIMADA
-- Week も使わなければもうちょっと短くできるような…、と後から気付きました(^_^;)。--sumim
| year month date | '<TABLE>', String cr, '<TR>', (#(Su Mo Tu We Th Fr Sa) collect: [ :dayOfWeek |
'<TD>', dayOfWeek asString, '</TD>' ]) asStringWithCr, '</TR>', (((0 to: 5) collect: [ :idx |
(Week startMonday ifTrue: [Week toggleStartMonday] ifFalse: [Week]) fromDate: ((Date fromString:
(month _ 8) asString, '/1/', (year _ 2002) asString) addDays: idx * 7)] thenSelect:[ :week | week
firstDate monthIndex <= month or: [week firstDate year < year]]) collect: [ :week | '<TR>', ((0
to: 6) collect: [ :idx | '<TD>', ((date _ week firstDate addDays: idx) monthIndex == month ifTrue:
[date dayOfMonth asString] ifFalse: ['']), '</TD>']) asStringWithCr, '</TR>']) asStringWithCr,
String cr, '</TABLE>'
----
Squeak-3.2.2 で探しているんですが、thenSelect: の implementors-of が見つからないんです。
このプログラム自体はprint-itできるのに‥‥‥、謎です。--SHIMADA
- collect:thenSelect: です。select:thenCollect: とかもあって一行野郎には重宝します（ぉ --sumim
- あと、セレクタを断片で探すとき(もしくはそうなってしまう可能性があるとき)は、implementors-of より MethodFinder を使うことをお薦めします。老婆心ながら。--sumim
- ここでは使っていませんが一行野郎必携メッセージとしては yourself ちゅうのがあります罠。OrderdCollection などは self を返さないので、こいつがないとお手上げです（ぉぉ --sumim
- 分かりました。しばらく触っていないともう文法を忘れかけてます。括弧がなければ続きなんでしたね。 --SHIMADA
----
- 期待したほど短く(シンプルに)はならなかった Week なし版です。--sumim
| date | '<TABLE>\<TR>' withCRs, (#(Su Mo Tu We Th Fr Sa) collect: [ :dayOfWeek | '<TD>',
dayOfWeek asString, '</TD>']) asStringWithCr, (((0 to: 5) collect: [ :idx | ((date _ Date
fromString: ("MONTH _" '8'),'/1/',("YEAR _" '2002')) previous: #Sunday) addDays: idx * 7]
thenSelect: [ :sun | sun firstDayOfMonth <= date dayOfYear]) collect: [ :sun | '</TR>\<TR>'
withCRs, (((0 to: 6) collect: [ :idx | sun addDays: idx ]) collect: [ :day | '<TD>', (day month =
date month ifTrue: [day dayOfMonth asString] ifFalse: ['']), '</TD>']) asStringWithCr ])
asStringWithCr, '</TR>\</TABLE>' withCRs
[[id:1039]] 2002-08-27 12:50:29
collect:thenSelect: 疑惑
Re: Squeak 3.2 一行野郎版
(#12)
一行野郎をつついて楽しませて頂いておりますが、
collect:thenSlect: の中で使っている date は
冒頭で定義された一時変数ですよね。
collect:thenSelect:は
(self collect: blockA) select: blockB
なので、blockB の中で date に入っているのはblockAのイテレートの最後に代入された値と
いうことで合っていますでしょうか？
collect: 一回につき select: が一回評価されて、それぞれの date
が受け渡しされてたらすごい！！と一瞬思ったのですが‥‥‥。
# SHIMADA
- 定義を見ないでありがたがって使っていましたが、たいしたことはないですね(^_^;)。そのまま一行で使えるじゃん…と。＞then〜。
- date は一行野郎としてはへたれの証です。細かいことは分かりませんが、おっしゃるとおりで大したことはしていないと思います。--sumim
[[id:1058]] 2002-08-27 21:32:12
解体その１
テーブルの各データをｎ列ｍ行の行列とみなし、
[[ A1, A2, A3, ...An ],
[ B1, B2, B3, ...Bn ],
:
:
[ M1, M2, M3, ...Mn ]]
というリストのリストで表現する。
このとき関数 htmlTable(caption, tabluer) は、
キャプションとなる文字列 <caption> と、
テーブルを表すリストのリスト <tabluer> を引数にとり、
"<TABLE>〜</TABLE>" で表現される文字列を返す。
-つまりこのお題は、htmlTableの逆関数を作れ、というお題ですか？
-そういうつもりじゃなかったんですが、そういう問題も面白いなと今思いました。:D --SHIMADA
[[id:1010]] 2002-08-19 21:46:45
こんなのはセコイですかねえ。
cal.sh:
cal $1 $2 | ruby cal.rb
cal.rb:
def print_line(arr)
print "<tr>" + arr.map {|str| "<td>" + str + "</td>"} + "</tr>\n"
end
print "<table>\n" + "<caption>" + gets.chomp.strip! + "</caption>\n"
print_line gets.split
arr = gets.split
print_line [""] * (7 - arr.length) + arr
while str = gets
break if str.length == 0
print_line str.split
end
print "</table>\n"
----
いや、セコイってことはないと思いますよ。非常に近親感を感じます。--とりあえず２ゲット
(#2)の作者 :D
2で既出の技だとは気付かずに早とちりしてしまった… y.h.
[[id:1296]] 2002-09-25 23:06:29
top
recent
HashedWiki version 3 beta
SHIMADA Keiki