関数作成
Keigo Matsuo
June.17
関数作成
Rにおける関数とは、複数の処理手順を1つにまとめたオブジェクトのことを指します。 早速、例題をやってみましょう。
library(grid)
grid.imageFun <- function(nrow,ncol,cols,byrow=TRUE){
x <-(1:ncol)/ncol
y <-(1:nrow)/nrow
if(byrow){
right <- rep(x, nrow)
top <- rep(y, each=ncol)
}else{
right <- rep(x, each=nrow)
top <- rep(y, ncol)
}
grid.rect(x=right, y=top,
width=1/ncol, height=1/nrow,
just=c("right", "top"),
gp= gpar(col=NA, fill=cols),
name="image")
}
grays <- gray(0.4 + (rep(1:4, 4) -rep(0:3,each=4))/10)
grid.imageFun(4,4,grays)
grid.imageFun(4,4,grays,byrow=FALSE)
例題2
library(oz)## Warning: package 'oz' was built under R version 3.3.2grid.ozFun <- function(ozRegion){
pushViewport(
viewport(name="ozlay",
layout=grid.layout(1,1,
widths = diff(ozRegion$rangex),
heights=diff(ozRegion$rangey),
respect = TRUE)))
pushViewport(viewport(name="ozvp",
layout.pos.row=1,
layout.pos.col=1,
xscale=ozRegion$rangex,
yscale=ozRegion$rangey,
clip=TRUE))
index <- 1
for(i in ozRegion$lines){
grid.lines(i$x, i$y, default.units = "native",
name=paste("ozlines",index,sep=""))
index <- index + 1
}
upViewport(2)
}
grid.ozFun(ozRegion())
例題3
bivariate mapが作成できる関数を作ってみる。 第1引数:spatialPolygonDataFrame 第2引数:spatialPolygonDataFrameに含まれる列1 第3引数:spatialPolygonDataFrameに含まれる列2
## 簡単な作図関数を作ってみる
library(raster)## Loading required package: sp## Warning: package 'sp' was built under R version 3.3.2library(rgdal)## Warning: package 'rgdal' was built under R version 3.3.2## rgdal: version: 1.2-7, (SVN revision 660)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.1.2, released 2016/10/24
## Path to GDAL shared files: /Users/matsuokeigo/Library/R/3.3/library/rgdal/gdal
## Loaded PROJ.4 runtime: Rel. 4.9.1, 04 March 2015, [PJ_VERSION: 491]
## Path to PROJ.4 shared files: /Users/matsuokeigo/Library/R/3.3/library/rgdal/proj
## Linking to sp version: 1.2-4library(ggplot2)## Warning: package 'ggplot2' was built under R version 3.3.2library(grid)
library(gridExtra)
library(plyr)
## map
Japan <- getData("GADM", country="Japan", level=1)
colnames(Japan@data)[12] <- c("region")
## 指定したwdからcsvを読み込み
setwd("~/Desktop")
data <- read.csv("稼働率2016.csv", header=T, fileEncoding="Shift_JIS",as.is = T)
Japan@data <- merge(Japan@data, data, by = "region")
bivariate_map <- function(Japan, Avg., Dev.){
require(dplyr)
Japan@data$classA <- ntile(Japan@data$Avg., 3)
Japan@data$classB <- ntile(Japan@data$Dev., 3)
Japan@data$classC <- ifelse(Japan@data$classA == 1 & Japan@data$classB == 1,"#e8e8e8",
ifelse(Japan@data$classA == 2 & Japan@data$classB == 1,"#b0d5df",
ifelse(Japan@data$classA == 3 & Japan@data$classB == 1,"#64acbe",
ifelse(Japan@data$classA == 1 & Japan@data$classB == 2,"#e4acac",
ifelse(Japan@data$classA == 2 & Japan@data$classB == 2,"#ad9ea5",
ifelse(Japan@data$classA == 3 & Japan@data$classB == 2,"#627f8c",
ifelse(Japan@data$classA == 1 & Japan@data$classB == 3,"#c85a5a",
ifelse(Japan@data$classA == 2 & Japan@data$classB == 3,"#985356",
ifelse(Japan@data$classA == 3 & Japan@data$classB == 3,"#574249",
"NA")))))))))
library(rgeos)
library(viridis)
library(ggthemes)
Japan_s <- gSimplify(Japan, .01)
# fortify でデータフレームの形へ
Japan@data$id <- rownames(Japan@data)
Japan1 <- fortify(Japan_s)
pJapan <- join(Japan1, Japan@data, by="id")
colnames(pJapan)
mainp <- ggplot(data=pJapan, aes(x=long, y=lat, group=group)) +
geom_polygon(data=pJapan, aes(x=long, y=lat, group=group,fill=classC)) +
scale_fill_manual(values = c("#574249","#985356","#c85a5a","#627f8c","#ad9ea5","#e4acac","#64acbe","#b0d5df","#e8e8e8"),guide="none") +
coord_quickmap() + ggthemes::theme_map() +
theme(legend.position=c(.8, .2))
xlab <- substitute(Avg.)
ylab <- substitute(Dev.)
library(reshape)
legendGoal=melt(matrix(1:9,nrow=3))
bvColors=c("#e8e8e8","#b0d5df","#64acbe","#e4acac","#ad9ea5","#627f8c","#c85a5a","#985356","#574249")
legendGoal$text <- as.data.frame(bvColors)
lgbox <- ggplot(legendGoal, aes(X2,X1,fill = as.factor(value),label = text)) +
geom_tile() +
scale_fill_manual(name="",values=bvColors) +
theme(legend.position="none") +
theme(axis.title.x=element_text(size=rel(1),color=bvColors[9])) + xlab(paste(xlab,"-->")) +
theme(axis.title.y=element_text(size=rel(1),color=bvColors[9])) + ylab(paste(ylab,"-->")) +
theme(axis.text=element_blank()) +
theme(line=element_blank()) +
theme(plot.subtitle = element_text(vjust = 1),
plot.caption = element_text(vjust = 1),
axis.ticks = element_line(linetype = "blank"),
axis.text = element_text(family = "serif",
colour = NA), panel.background = element_rect(fill = NA),
legend.key = element_rect(fill = NA),
legend.background = element_rect(fill = NA))
grid.newpage()
##main mapの描画
v1 <- viewport(width = 1, height = 1, x = 0.5, y = 0.5)
##navigate mapの描画
v2 <- viewport(width = 0.26, height = 0.22, x = 0.75, y = 0.22)
print(mainp, vp = v1)
print(lgbox, vp = v2)
}
## 完成した作図関数
## 第1引数にはSpatialPolygonDataFrame
## 第2引数にはx軸（SpatialPolygonDataFrameの列）
## 第3引数にはy軸（SpatialPolygonDataFrameの列）
bivariate_map(Japan,Dec.,Dev.)## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## The following object is masked from 'package:gridExtra':
##
## combine## The following objects are masked from 'package:raster':
##
## intersect, select, union## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Warning: package 'rgeos' was built under R version 3.3.2## rgeos version: 0.3-23, (SVN revision 546)
## GEOS runtime version: 3.4.2-CAPI-1.8.2 r3921
## Linking to sp version: 1.2-4
## Polygon checking: TRUE## Warning: package 'ggthemes' was built under R version 3.3.2##
## Attaching package: 'reshape'## The following object is masked from 'package:dplyr':
##
## rename## The following objects are masked from 'package:plyr':
##
## rename, round_any## Don't know how to automatically pick scale for object of type data.frame. Defaulting to continuous.