DouKaku? Language detail: R

π (Nested Flatten)

Rにはpiという組み込み変数がありますが、計算であればRらしくモンテカルロで。

1
2
3

pi.montecarlo <- function(n){
  mean(replicate(n, sum(runif(2)^2) < 1)) * 4
}

タブ区切りデータの処理 (Nested Flatten)

統計処理言語だけあって、Rでは、この手のデータ処理は非常に直感的です。

# タブ区切りのデータを読み込む
d <- read.delim("input.tsv")

# 第1カラムの値でデータを昇順にソートする。
d <- d[sort.list(d[,1]),]

# 第2カラムと第3カラムをヘッダを含めて入れ替える。
d[,c(2,3)] <- d[,c(3,2)]
colnames(d)[c(2,3)] <- colnames(d)[c(3,2)]

# 第4カラムの値にそれぞれ1を加える。
d[,4] <- d[,4] + 1

# 書き出す
write.table(d, "output.tsv", sep="\t", quote=F, row.names=F)

LL Golf Hole 9 - トラックバックを打つ (Nested Flatten)

RでHTTPリクエストを扱うには、Pure Rで実装されたhttpRequestとlibcurlを使ったRCurlがあるようです。

Pure Rには心引かれたのですが、POST先URLの扱いが簡単なRCurlを使いました。

library(RCurl)
print(postForm("http://ll.jus.or.jp/2008/blog/archives/38/trackback",
  title     = "LL Golf Hole 9 - トラックバックを打つ",
  excerpt   = "ニコニコ動画で拝見しました。あらためて解説付きで紹介されると面白いですね。自分のコードが紹介されててビックリしました。",
  url       = "http://ja.doukaku.org/207/",
  blog_name = "どう書く？org"))

文字列型日時ののN秒後時間取得 (Nested Flatten)

フォーマットが任意だと楽ちんでいいですね。

> DateEx("2008-09-02 00:00:00 JST", 30)
[1] "2008-09-02 00:00:30 JST"
> DateEx("2008-09-02 00:00:00 JST", -30)
[1] "2008-09-01 23:59:30 JST"

1
2
3

DateEx <- function(d1=Sys.time(), d2=0){
  as.POSIXct(d1) + d2
}

LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

正攻法で文字列処理をすると長くなってしまうので、

少し変則的に文字列処理をしない方向で書いてみました。

1 2	n <- 4+1 l=rep("*",n^2);l[cumsum(n-abs(-n:n))]="\n";cat(l)

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

R的にはループを使わない方向で。

bytes.pretty <- function(n){
  u <- c('', 'k', 'M', 'G', 'T')
  r <- 1024^(1:length(u)-1)
  i <- which.min(abs(512-n/r))
  sprintf("%.1f%s", n/r[i], u[i])
}

LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

出力フォーマットにこだわらなければintToBts()だけで変換可能です。

1	d2b <- function(n) paste(as.integer(rev(intToBits(n:n))), collapse="")

LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten)

ループより再帰の方がきれいに書けるかも？と思ったので試してみました。

もう少しうまく書けそうですが・・・

count <- function(n=300){
  if(n!=0) Recall(n - 10^(nchar(n-1)-1))
  print(n)
}

たしかに、数値しか入力されないから"."で十分なのですね。シンプルすぎる・・・

1	grep("^.0*$",0:300)-1

grepが一番シンプルかもですね。

1	count <- function(n) grep("^[0-9]0*$", 0:n, value=T)

α置換 (Nested Flatten)

substitute()を使って、Rのparserにお任せします。

お題の「一番外側の変数」というのは、「スコープ内の変数」という解釈でいいのでしょうか。例えば以下のようなコードでは、xの最終的な値は10になるので、スコープをさしているのであれば「一番外側」にこだわる必要はないと判断しました。

例では、変数"x"を"aaaa"に変更しています。リストの項目名である"x"や文字列中の"x"、別の変数名の一部に含まれる"x"など、置換するべきでないものは残されているようです。:

> alpha.replace("x", "aaaa")

(入力)
x   <- 1
y   <- list(x=10)
z   <- "w x y z"
xyz <- 1
zzz <- {
   x <- 10
}
x

(出力)
{
   aaaa <- 1
   y <- list(x = 10)
   z <- "w x y z"
   xyz <- 1
   zzz <- {
       aaaa <- 10
   }
   aaaa
}

alpha.replace <- function(from, to){
   script <- c("substitute({",readLines(),"}, list(",from,"=quote(",to,")))")
   eval(parse(text=script))
}

echoクライアント (Nested Flatten)

こんな感じでしょうか。

echo.client <- function(host.name="localhost", port.number=9999){
  sock <- socketConnection(host=host.name, port=port.number)
  repeat{
    writeLines(readLines(), sock)
    writeLines(readLines(sock, n=1))
  }
}
argv <- commandArgs(trailingOnly=T)
echo.client(argv[1], argv[2])

ウィンドウの表示 (Nested Flatten)

いまさらですが、お題の「画面中央に」を満たしていなかったので直しました。

library(tcltk)
w  <- 100
h  <- 75
tt <- tktoplevel(width=w, height=h)
g <- paste("+", c(round((as.integer(tkwinfo("screenwidth", tt)) - w)/2),
                  round((as.integer(tkwinfo("screenheight", tt)) - h)/2)),
           sep="", collapse="")
tkwm.geometry(tt, g)
tkwm.title(tt, "こんにちは、GUI！")

出力の一時停止と再開 (Nested Flatten)

R的にはちょっと難しいお題ですね。

キーイベントを取得するにはgetGraphicsEvent()という関数がありますが、実行中はR本体の処理がブロックされてしまって、肝心の"a"を出す処理が実行できないようです。

代わりにR TclTkを使うことにしました。相変わらずWindowsのRguiはコンソール入出力がよろしくないので、Rtermから実行してください。

library(tcltk)

tt <- tktoplevel()
pause.flag <- FALSE
quit.flag <- FALSE

tkbind(tt, "<Key>", function(K){
  switch(K,
    q = {quit.flag <<- TRUE; },
    p = {pause.flag <<- !pause.flag}
)})

repeat{
  if(!pause.flag){
    writeLines("a")
  }
  if(quit.flag){
    tkdestroy(tt)
    quit(save="no")
  }
  Sys.sleep(1)
}

HTTPでGET　その2 (Nested Flatten)

タイムアウトはtimeoutというオプション、プロキシサーバーはhttp_proxyという環境変数でそれぞれ指定します。

http_proxyは、起動後初回のダウンロード処理を実行する前に、一度だけ設定可能です。その後は設定可・不可の切り替えはできますが、プロキシサーバーのホストを変更することはできません(These environment variables must be set before the download code is first used: they cannot be altered later by calling Sys.setenv)。

タイムアウトを1秒にすると、大抵のGETは失敗してしまうみたいですね。

http.get <- function(url, proxy='', timeout.value=1){
  options(timeout=timeout.value)
  Sys.setenv(http_proxy=proxy)
  readLines(url)
}

除算・余剰を使わずに閏年 (Nested Flatten)

Dateクラスをそのまま使うというのは思いつきませんでした。コロンブスの卵すぎる・・・！

一応正攻法も載せておきますね。

is.leap.year1 <- function(y){
    !is.na(ISOdate(y,2,29))
}

is.leap.year2 <- function(y){
    y %in% union(setdiff(seq(0,y,4), seq(0,y,100)), seq(0,y,400))
}

LL Golf Hole 4 - 文章から単語の索引を作る (Nested Flatten)

ちょっと短くしました。

1 2	f <- 'http://www.gnu.org/licenses/gpl.txt' sapply(unique(unlist(strsplit((l<-readLines(f)),"\\W+"))),grep,l)

コード内にURLが出るかでないかで長さがだいぶ違ってくるのでは・・・。

とりあえず普通に。

1 2	f <- 'http://www.gnu.org/licenses/gpl.txt' sapply(names(table(unlist(strsplit((l<-readLines(f)),"\\W+")))), function(s) grep(s,l))

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

短くしてみました。

1	l=Sys.Date():16070;class(l)="Date";length(print(l[format(l,"%d%w")==135]))

2013年と都合よく解釈しました。

私にはこのくらいが限度のようです。

1	with(as.POSIXlt(l<-(seq(Sys.Date(),as.Date("2013-12-31"),"d"))), length(print(l[mday==13 & wday==5])))

DouKaku?

Language detail: R

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq