Haskell の sum と product を Scheme で実装
sum takes a list of numbers and returns their sum.
product takes a list of numbers and returns their product.
ghci> sum [5,2,1,6,3,2,5,7]
31
ghci> product [6,2,1,2]
24
ghci> product [1,2,5,6,7,9,2,0]
0
をSchemeで書くと
(define (sum lnum) (cond ((null? lnum) 0) (else (+ (car lnum) (sum (cdr lnum)))) ) ) (define (prod lnum) (cond ((null? lnum) 1) ((zero? (car lnum)) 0) (else (* (car lnum) (prod (cdr lnum)))) ) )
でいいのかな? 以下実験。
> (sum '(5 2 1 6 3 2 5 7))
31
> (prod '(6 2 1 2))
24
> (prod '(1 2 5 6 7 9 2 0))
0
いいみたいだ。でも(prod '())とすると
> (prod '())
1
となってしまうのが気になる。ここは0かエラーを返すべきかとも思うが、GHCでも
Prelude> product[]
1
となるので、別にいいのか。
空リストはアトムかリストか?
() もアトムの一種である。
とのことだが、Racketで
> (list? '())
とやると
#t
と評価される。空リストはアトムかリストか、結局どっちだ?
ちなみにThe Little SchemerではS式がアトムかどうか判別する関数として
(define (atom? x) (and (not (pair? x)) (not (null? x))))
を読者に定義させている。これによるとアトムの定義は
- ドット対でない かつ 空リストでない
となり、空リストはアトムから除外しているようだ。
よく分からないが、The Little Schemerで勉強している都合上、当面この定義に従うことにする。
SpringerLink eBooks ダウンローダー
SpringerLinkのebookは1章ずつしかダウンロードできないので面倒。全章ダウンロードして1つのPDFファイルに結合するまで自動で行うプログラムを作った。
#!/usr/bin/perl # slinkdown.pl use strict; use warnings; use Getopt::Long; use Web::Scraper; use WWW::Mechanize; use CAM::PDF; my $baseURL = 'http://www.springerlink.com/content/'; my $contentsPageURL; # 引数がISBNならそれからcontents page URLを作成 # 引数がcontents page URLならそれをそのまま使用 if($ARGV[0] =~ /^[0-9]/){ $contentsPageURL = $baseURL . $ARGV[0] . "/contents"; }else{ $contentsPageURL = $ARGV[0]; } # -t, -cオプションを取得 my $opt_title = 0; my $opt_concat = 0; GetOptions('title=s' => \$opt_title, 'concat' => \$opt_concat); # -tオプションでタイトルを明示できる # さもなくば自動で取得 my $title; if($opt_title){ $title = $opt_title; }else{ my $scraper = scraper { process '//h1[@class="title"]', 'title' => 'text'; }; my $uri = new URI("$contentsPageURL"); my $res = $scraper->scrape($uri); $title = $res->{title}; $title =~ s/^\s+//; $title =~ s/\s+$//; } # タイトル名のフォルダを作る mkdir "./$title"; chdir "$title"; # 各章のURLを配列に記憶 my $mech = WWW::Mechanize->new( agent => "" ); $mech->get("$contentsPageURL"); my @pdfURLs = $mech->find_all_links( text_regex => qr/Download PDF/ ); # リネームしながらダウンロード my $chapterNum = 1; foreach(@pdfURLs){ $chapterNum = sprintf "%02d", $chapterNum; my $pdf = $_->url_abs(); `wget -U "" -O ${chapterNum}.pdf $pdf`; $chapterNum++; sleep 5; } # -cオプションで結合 if($opt_concat){ `pdftk *.pdf cat output "${title}.pdf"`; }
使い方:perl slinkdown.pl
↓ISBNで指定する場合。
% perl slinkdown.pl 978-1-59059-239-7 -c
↓SpringerLink上のURLで指定する場合。ドイツ語のタイトルを英語に変更してみた。
% perl slinkdown.pl http://www.springerlink.com/content/978-3-642-04717-6/contents/ -t "Haskell-intensive course -- A compact introduction to functional programming (German)" -c
参考:
http://milianw.de/code-snippets/download-script-for-springerlinkcom-ebooks
http://c-aurich.de/wordpress/software/springerlink-batchcreator/
アドレスの埋まる順番
今読んでいる教科書中の実行結果と、自分の環境下での実行結果が違ったのでメモ。
#include<stdio.h> //tes5.c int main() { int i; int num; int ary[5]; printf("The address of a is %p\n", &num); printf("The address of ary is %p\n", &ary); for(i=0;i<5;i++){ printf("The address of ary[%d] is %p\n", i, &ary[i]); } return 0; }
% tes5.exe
The address of a is 0012FF88
The address of ary is 0012FF74
The address of ary[0] is 0012FF74
The address of ary[1] is 0012FF78
The address of ary[2] is 0012FF7C
The address of ary[3] is 0012FF80
The address of ary[4] is 0012FF84
- 先に宣言された変数ほど、大きいアドレスが割り当てられる。
- 配列は、最後の要素に一番大きいアドレスが割り当てられる。
Twitter ダウンローダー
指定したTwitterアカウントのツイートを、指定した数だけテキスト形式でダウンロードするプログラム。
#!/usr/local/bin/perl # tdown.pl use strict; use warnings; use LWP::Simple; use Time::Piece(); # 本日の日付を名前にしたフォルダを作成 my $localTime = Time::Piece::localtime(); my $yymmdd = $localTime->strftime('%y%m%d'); mkdir "./$yymmdd"; # -tオプションを取得 my $opt = shift || 'n/a'; # 取得したいアカウント名(キー)とツイート数(値)のペアを取得 # 何ペアでも一度に入力可 # 入力例:masason 120 kazuyo_k 55 kenichiromogi 89 my %h = split /\s/, <STDIN>; # 各アカウントにつき、指定した数のツイートをダウンロード # ただしツイート数の増分単位は20で、端数は切り上げ my $user; my $cont; my $pmax; my $retweet; my $fragment; my $tweetTime; while (($user, $cont) = each(%h)) { # 端数切り上げ if ($cont % 20 != 0) { $pmax = int($cont/20)+1; } else { $pmax = $cont/20; } print "Downloading latest $cont tweets of \@$user\n"; unlink "$yymmdd/$user.txt"; for (1..$pmax) { print "$_/$pmax\n"; getstore("http://twitter.com/$user?page=$_", "temp.txt"); open FILE, "<temp.txt"; while(<FILE>) { open OUT, ">>$yymmdd/$user.txt"; # 公式RTのアイコンを取得 if ( /<strong><a href="http/ ) { $_ =~ /class="tweet-url screen-name">(.+)<\/a>/; print OUT "[*R* $1] "; $retweet = 1; # 本文を取得(改行があれば「 = NL = 」に変換) } elsif ( /<span class="entry-content">(.*?)<\/span>/ ) { &replace; print OUT "$_\n\n"; } elsif (/<span class="entry-content">(.*?)\n/){ &replace; print OUT "$_ = NL = "; $fragment = 1; } elsif ( (/^(.*?)<\/span>\n/) and ($fragment) ){ &replace; print OUT "$_\n\n"; $fragment = 0; } elsif ( (/^(.*?)\n/) and ($fragment) ){ &replace; print OUT "$_ = NL = "; # -tオプションで日時を取得 } elsif (( /<span class="published timestamp"/ ) and ( $opt eq '-t')) { $_ =~ /data="{time:'([^']+)'/; $tweetTime = Time::Piece::localtime(); $tweetTime = Time::Piece->strptime($1, '%a %h %e %T %z %Y'); # UTC(協定世界時)+9時間 $tweetTime += 32400; # 月、日、時間、分、秒、曜日をそれぞれ変数に格納 my $month = $tweetTime->mon; my $mday = $tweetTime->mday; my $hour = $tweetTime->hour; my $minute = $tweetTime->minute; my $second = $tweetTime->sec; my @week_names = ('日', '月', '火', '水', '木', '金', '土'); my $wday = $tweetTime->wdayname(@week_names); print OUT " == $month月$mday日($wday)$hour:$minute:$second =="; print OUT "\n\n" if !$retweet; # 公式RTの数を取得 } elsif ( /<span class="shared-content">/ ) { $_ =~ /<\/a>[^\d]+([0-9+]+)[^\d]+/; $_ = $1 || 0; print OUT " $_ others retweeted ==\n\n" if $opt eq '-t'; print OUT " == $_ others retweeted ==\n\n" if $opt ne '-t'; $retweet = 0; } } close OUT; } } # 本文中のHTMLタグを削除 # 文字はエスケープしない sub replace { $_ = $1; s/<[^>]+>//g; s/&\#123;/{/g; s/&\#125;/}/g; s/&/&/g; s/"/"/g; s/>/>/g; s/</</g; }
例えば孫正義のツイートを最新から120件、勝間和代を55件、茂木健一郎を89件取得したい場合はコマンドラインで
% perl tdown.pl [-t]
masason 120 kazuyo_k 55 kenichiromogi 89
カレントディレクトリに日付名のフォルダができて、その中にmasason.txt, kazuyo_k.txt, kenichiromogi.txt というファイルが作られる。オプション -t で各ツイートの日付・時刻も取得できる。
文字列から前後の空白を削除する
#!/usr/bin/perl $str = " aaa bbb ccc "; print "With spaces: >>>", $str, "<<<\n"; $str =~ s/^\s+//; $str =~ s/\s+$//; print "Without spaces: >>>", $str, "<<<\n";
With spaces: >>> aaa bbb ccc <<<
Without spaces: >>>aaa bbb ccc<<<
はては記法のせいで正しく表現されていないが、最初のprintの結果は前後に4つずつスペースが付く。
s/// 演算子に区切り文字を使わない
区切り文字を使わず、前後の PATTERN 部分をかっこ類で括るだけでよいみたいだ。
#!/usr/bin/perl $str1 = $str2 = "aaa425bbb586ccc"; $str1 =~ s/[0-9]/_/g; print "区切り文字を使う:$str1\n"; $str2 =~ s{[0-9]}{_}g; print "区切り文字をわない:$str2\n";
区切り文字を使う:aaa___bbb___ccc
区切り文字をわない:aaa___bbb___ccc
参考:http://www.rfs.jp/sb/perl/02/09.html#s///%20%E6%BC%94%E7%AE%97%E5%AD%90