Latest comments for language 'R' on doukaku.org

kkobayashi's comment on 漢数字で九九の表

outerかわいいです

number.lhs <- unlist(strsplit("　一二三四五六七八九", ''))
number.rhs <- unlist(strsplit("〇一二三四五六七八九", ''))
s <- length(NA)
e <- length(number.lhs) - s
number.tbl <- t(outer(number.lhs, number.rhs, paste, sep=""))
outer(s:e, s:e, function(x,y) number.tbl[x*y+s])

[ R ] [ download code ] ]

kkobayashi's comment on 世界時計

世界時計 (Nested Flatten)

色々やり方はあると思いますが、format.POSIXctを使ってみました。

1
2
3

paste("Local time", Sys.time(), sep=" : ")
paste("GMT", format(Sys.time(), tz="GMT"), sep=" : ")
paste("America/Los_Angeles", format(Sys.time(), tz="America/Los_Angeles"), sep=" : ")

[ R ] [ download code ] ]

kkobayashi's comment on π

π (Nested Flatten)

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

1
2
3

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

[ R ] [ download code ] ]

kkobayashi's comment on タブ区切りデータの処理

タブ区切りデータの処理 (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)

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 9 - トラックバックを打つ

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"))

[ R ] [ download code ] ]

kkobayashi's comment on 文字列型日時ののN秒後時間取得

文字列型日時のの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
}

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 8 - 横向きのピラミッドを作る

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

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

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

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

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 7 - バイト数を読みやすくする

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])
}

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 6 - 10進数を2進数に基数変換する

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

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

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

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

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

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

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

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

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

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

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

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

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

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

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

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

[ R ] [ download code ] ]

kkobayashi's comment on α置換

α置換 (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))
}

[ R ] [ download code ] ]

kkobayashi's comment on echoクライアント

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])

[ R ] [ download code ] ]

kkobayashi's comment on ウィンドウの表示

ウィンドウの表示 (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！")

[ R ] [ download code ] ]

kkobayashi's comment on 出力の一時停止と再開

出力の一時停止と再開 (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)
}

[ R ] [ download code ] ]

kkobayashi's comment on HTTPでGET　その2

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)
}

[ R ] [ download code ] ]

kkobayashi's comment on 除算・余剰を使わずに閏年

除算・余剰を使わずに閏年 (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))
}

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 4 - 文章から単語の索引を作る

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)

[ R ] [ download code ] ]

kkobayashi's comment on LL Golf Hole 4 - 文章から単語の索引を作る

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

コード内に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))

[ R ] [ download code ] ]

Latest comments for language 'R' on doukaku.org

kkobayashi's comment on 漢数字で九九の表

kkobayashi's comment on 世界時計

kkobayashi's comment on π

kkobayashi's comment on タブ区切りデータの処理

kkobayashi's comment on LL Golf Hole 9 - トラックバックを打つ

kkobayashi's comment on 文字列型日時ののN秒後時間取得

kkobayashi's comment on LL Golf Hole 8 - 横向きのピラミッドを作る

kkobayashi's comment on LL Golf Hole 7 - バイト数を読みやすくする

kkobayashi's comment on LL Golf Hole 6 - 10進数を2進数に基数変換する

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

kkobayashi's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

kkobayashi's comment on α置換

kkobayashi's comment on echoクライアント

kkobayashi's comment on ウィンドウの表示

kkobayashi's comment on 出力の一時停止と再開

kkobayashi's comment on HTTPでGET その2

kkobayashi's comment on 除算・余剰を使わずに閏年

kkobayashi's comment on LL Golf Hole 4 - 文章から単語の索引を作る

kkobayashi's comment on LL Golf Hole 4 - 文章から単語の索引を作る

kkobayashi's comment on HTTPでGET　その2