kohske’s gists

kohske / gist:1393952

Created November 25, 2011 16:47

example of RWeather and ggplot2

	library(plyr)
	library(ggplot2) # needs dev version of ggplot2 for the colorbar

	if(0){
	locs <- getCountriesFromGoogle(country="JP")
	weas <- llply(locs$name, function(l) {
	r <- NULL
	try(r <- getWeatherFromGoogle(l))
	r
	})

kohske / gist:1471921

Created December 13, 2011 12:13

Multi years calendar by R and ggplot2

	library(ggplot2)

	f <- function(y1, y2) {
	d <- seq.Date(as.Date(paste(y1, "-01-01", sep = "")), as.Date(paste(y2, "-12-31", sep = "")), "day")
	z <- data.frame(
	D = as.numeric(format(d, "%d")),
	W = format(d, "%w"),
	M = as.numeric(format(d, "%m")),
	Y = format(d, "%Y"))

kohske / gist:1594926

Created January 11, 2012 14:33

footstep illusion by R

	library(grid)
	library(animation)

	saveGIF({
	ani.options(interval = 0.1, nmax = 200)
	for (x in seq(0, 1, length = 200)) {
	grid.newpage()
	grid.rect(gp = gpar(fill = "grey", col = NA))
	grid.rect(seq(0, 1, 1/50), 1/4, 1/50/2, 1/2, gp = gpar(fill = "grey10", col = NA))
	grid.rect(x, c(0.15, 0.3, 0.7, 0.85), 1/50, 0.1, gp = gpar(fill = c("black", "white"), col = NA))

kohske / animation.r

Created January 11, 2012 15:16

cafewall illusion in R

	library(animation)
	ani.options(outdir = getwd())
	saveGIF({
	ani.options(interval = 1)
	grid.newpage()
	rs <- expand.grid(x = seq(0, 1, 1/10), y = seq(0, 1, 1/10))
	grid.rect(rs$x, rs$y, 1/10/2, 1/10/2, gp = gpar(fill = "black", col = NA))
	grid.rect(rs$x + 1/10/4, rs$y + 1/10/2, 1/10/2, 1/10/2, gp = gpar(fill = "black", col = NA))
	ls <- expand.grid(x = 0:1, y = seq(0, 1, 1/20) - 1/20/2)
	grid.polyline(ls$x, ls$y, id = gl(nrow(ls)/2, 2), gp = gpar(col = "grey50", lwd = 1))

kohske / sample.Rnw

Created January 19, 2012 19:58

	\documentclass{beamer}
	\usepackage{fontspec}
	\setsansfont{Hiragino Kaku Gothic Pro W3}
	\setmonofont{Monaco}

	\XeTeXlinebreaklocale "ja"
	\XeTeXlinebreakskip=0pt plus 1pt
	\XeTeXlinebreakpenalty=0
	\def\<{\@ifstar{\zx@hwback\nobreak}{\zx@hwback\relax}}
	\def\zx@hwback#1{\leavevmode#1\hskip-.5em\relax}%% LyX 2.1.0svn created this file. For more info, see http://www.lyx.org/.

kohske / rpipe.r

Created January 21, 2012 17:41

R pipe

	`\|` <- function(a, b) {
	env <- parent.frame()
	ret <- eval(a, env)
	bb <- llply(substitute(b), function(x) if(x==alist(,)[[1]]) ret else x)
	if (length(bb) == 1) bb[[2]] <- ret
	invisible(eval(as.call(bb), env))
	}

	s <- "a"
	(1 + 1) \| paste(,2, sep=s) \| sub("a", "b", ) \| print

kohske / error.r

Created January 22, 2012 01:28

test multiple gist

stop("intentional foul")

kohske / badhack.r

Created January 24, 2012 08:30

method_missing in R?

	method.name <- "test"
	eval(parse(text=sprintf('setGeneric("%s", function(object) standardGeneric("%s"))', method.name, method.name)))

kohske / fujipie.r

Created January 31, 2012 04:23

fujipie

	#' fujipie
	#'
	#' 例のフジテレビのパイチャート関数
	#'
	#' @param d numeric vector データベクトル
	#' @param x,y numeric 歪み
	#' @param r numeric (> 0) 良心（大きいほど良心的）
	#' @param a numeric [0-1]. 良心（小さいほど良心的）
	fujipie <- function(d, x, y, r, a) {
	par(mar=c(0,0,0,0))

kohske / official_twintail_function.r

Created February 2, 2012 15:59

twin tail function in R

	curve(sqrt(abs(1-x^2)), -1, -0.4, asp = 1, type = "l", xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2))
	curve(sqrt(abs(1-x^2)), 0.4, 1, add = T, type = "l")
	curve(-sqrt(abs(1-x^2)), -1, -0.2, add = T, type = "l")
	curve(-sqrt(abs(1-x^2)), 0.2, 1, add = T, type = "l")

	curve(0.3 + 1.35 * sqrt(abs(0.6^2-x^2)), -0.6, 0.6, add = T, type = "l")
	curve(0.3 + 1.35 * -sqrt(abs(0.6^2-x^2)), -0.6, 0.6, add = T, type = "l")

	curve(-0.1+0*x, -0.5, -0.4, add = T, type = "l")
	curve(-0.1+0*x, -0.2, 0.5, add = T, type = "l")

kohske takahashi kohske