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


http://learnyouahaskell.com/starting-out#an-intro-to-lists

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 [-t Title] [-c]

↓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/&amp;/&/g;
	s/&quot;/"/g;
	s/&gt;/>/g;
	s/&lt;/</g;
}

例えば孫正義のツイートを最新から120件、勝間和代を55件、茂木健一郎を89件取得したい場合はコマンドライン

% perl tdown.pl [-t]
masason 120 kazuyo_k 55 kenichiromogi 89

とすると、進捗を示しながらダウンロードしてくれる。

カレントディレクトリに日付名のフォルダができて、その中にmasason.txt, kazuyo_k.txt, kenichiromogi.txt というファイルが作られる。オプション -t で各ツイートの日付・時刻も取得できる。


参考:http://www.moonmile.net/blog/archives/860

文字列から前後の空白を削除する

#!/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