Rではてダラ用のファイルの検索システム作ったよー!!

昔Rubyではてダラのファイル検索みたいなのを作ったんですが、なんかもっと高機能にしたいと思った。正規表現とか使いたいじゃないですか!!そんなわけでPerlとかでやろうかなあと考えてたんですが、「データ構造がこういう感じになってたら、mapplyをかませば…ってmapplyはRじゃん!!」とかいう状態になっていたので*1、Rで作ることにしました。Rだって正規表現とかできるんだからね…!!

まず、エントリーをRのリスト形式に落します。

e <- unlist(lapply(list.files("/Users/yasuhisa/hatena/syou6162/diary",pattern="[0-9]{4}-[0-9]{2}-[0-9]{2}\\.txt$",full.names=TRUE),function(file){make.entries(file)}),recursive=FALSE)

で、クエリーにwakutekaと入れて、tagに"Tsukuba.R"と"R"を入れて検索するとこんな感じで見ることができる!!簡単すぎる!!

> invisible(lapply(search(e,"wakuteka",tags=c("Tsukuba.R","R")),print.entry))
Title::Tsukuba.R 第一回勉強会について
Day::2008-06-25
Tags::R,Tsukuba.R
Detail::Tsukuba.Rがどういうことやりたいものなのかについては[http://d.hatena.ne.jp/syou6162/20080624/1214212893:title=書いた]ので、最初の活動…
Title::Tsukuba.R#1をやってきたよ!!
Day::2008-07-27
Tags::R,Tsukuba.R,勉強会
Detail::当日の朝まで資料を作ったりとか、名刺刷ったりとか、リハーサルしたりでどたばたしてたんですが、なんとか無事終了することができました。会場の芝浦工大のid:negaton、id:t_yamazaki021…
Title::もうちょっと高度なグラフィックス特集
Day::2008-09-14
Tags::R,Tsukuba.R
Detail::**Rのグラフィックス特集
**はじめに
-ここの焼き回しっぽい感じですwww
-[http://d.hatena.ne.jp/syou6162/20071024/1193287322:title]
…
Title::Tsukuba.R#2をやってきました
Day::2008-09-15
Tags::R,Tsukuba.R
Detail::今回は"つくば"でやってきました。国外からこられた皆さんは遠いところまでお疲れ様でした。
**お昼兼Hackathon
夜のHackathonはちょっとむりぽ!ということでお昼にやりました。Tsuku…

これを実現するための関数も全部合わせても50行以下。素晴らしい!!

split.entry <- function(file){
  f <- scan(file,what=character(0),sep="\n",quiet=TRUE,blank.lines.skip=FALSE)
  g <- grep("\\*([0-9]+)\\*",f,perl=TRUE)
  mapply(function(g1,g2){list(f[(g1:(g2-1))])},g,c(g[-1],length(f)))
}

extract.tags <- function(str){
  extract.tags.intern <- function(str){
      reg <- "\\[.*?\\]"
      r <- regexpr(reg,str,perl=TRUE)
      if(r != -1){
        return(c(substr(str,r,r+attr(r,"match.length")-1),
                 extract.tags.intern(substr(str,r+attr(r,"match.length"),nchar(str)))))
      }else{
        return(NULL)
      }
    }
  sapply(extract.tags.intern(str),function(x){gsub("(\\[|\\])","",x)})
}

extract.title <- function(x){
  gsub("\\*([0-9]+)\\*(\\[.*?\\])*(.*?)","\\3",grep("\\*([0-9]+)\\*",x,perl=TRUE,value=TRUE))
}

make.entries <- function(file){
  lapply(split.entry(file),
         function(x){list(title=extract.title(x[1]),
                          tags=extract.tags(x[1]),
                          day=gsub(".*?([0-9]{4}-[0-9]{2}-[0-9]{2})\\.txt","\\1",file),
                          detail=paste(x[-1],collapse="\n"))})
}

search <- function(entries,query,tags){
  #検索語でヒット
  q <- unlist(lapply(entries,function(x){ifelse(regexpr(query,x$detail,perl=TRUE) > 0,TRUE,FALSE)}))
  #タグでヒット
  t <- unlist(lapply(entries,function(x){
    all(is.element(tags,x$tags))
  }))
  entries[q & t]
}

print.entry <- function(entry){
  cat(paste("Title::",entry$title,sep=""),fill=TRUE)
  cat(paste("Day::",entry$day,sep=""),fill=TRUE)
  cat(paste("Tags::",paste(entry$tags,collapse=","),sep=""),fill=TRUE)
  cat(paste("Detail::",substr(entry$detail,1,100),"…",sep=""),fill=TRUE)
}