install.packages("ctv")
library(ctv)#
install.views("Spatial")
library(sp)#
data(meuse)#
coordinates(meuse) = ~x+y#
data(meuse.grid)#
gridded(meuse.grid) = ~x+y
meuse
spplot(meuse, "zinc")
spplot(meuse.grid, "dist")
at = seq(100,1900,200)#
col = rainbow(length(at))
at
col
spplot(meuse, "zinc", at = at, col.regions = col, cuts = length(at))
at = seq(0,1, 0.1)#
spplot(meuse.grid, "dist", at = at, col.regions = col)
library(classInt)#
library(gstat)#
# Use inverse distance weighted interpolation to make a zinc grid#
meuse.grid$zinc = idw(zinc~1, meuse, meuse.grid)$var1.pred#
at = classIntervals(meuse.grid$zinc, n = 10, style = "equal")$brks
at
rpois(10)
rpois(1,10)
dpois
dpois(c(1:10),10)
2+3
2*2
6-4
c(0,1,1,0,1,#
+   1,0,1,0,1,#
+   1,1,0,1,1,#
+   0,0,1,0,1,#
+   1,1,1,1,0)
neigh <- matrix(ncol=5,nrow=5,#
+ c(0,1,1,0,1,#
+   1,0,1,0,1,#
+   1,1,0,1,1,#
+   0,0,1,0,1,#
+   1,1,1,1,0))
neigh
neigh.w <- matrix(ncol=5,nrow=5,0)
neigh.w
for(i in 1:nrow(neigh)){#
+ neigh.w[i,] <- neigh[i,] / sum(neigh[i,])}
for(i in 1:nrow(neigh){}
for(i in 1:nrow(neigh)){
neigh.w[i,] <- neigh[i,] / sum(neigh[i,])}
neigh.w
neigh.rook <- matrix(ncol=N,nrow=N,c(#
+ 0,1,0,1,0,0,0,0,0,#
+ 1,0,1,0,1,0,0,0,0,#
+ 0,1,0,0,0,1,0,0,0,#
+ 1,0,0,0,1,0,1,0,0,#
+ 0,1,0,1,0,1,0,1,0,#
+ 0,0,1,0,1,0,0,0,1,#
+ 0,0,0,1,0,0,0,1,0,#
+ 0,0,0,0,1,0,1,0,1,#
+ 0,0,0,0,0,1,0,1,0))
N=9
neigh.rook <- matrix(ncol=N,nrow=N,c(#
+ 0,1,0,1,0,0,0,0,0,#
+ 1,0,1,0,1,0,0,0,0,#
+ 0,1,0,0,0,1,0,0,0,#
+ 1,0,0,0,1,0,1,0,0,#
+ 0,1,0,1,0,1,0,1,0,#
+ 0,0,1,0,1,0,0,0,1,#
+ 0,0,0,1,0,0,0,1,0,#
+ 0,0,0,0,1,0,1,0,1,#
+ 0,0,0,0,0,1,0,1,0))
neigh.rook
neigh.rook.w <- neigh.rook
neigh.rook.w
for(i in 1:N){
neigh.rook.w[i,] <- neigh.rook[i,] / sum(neigh.rook[i,])}
neigh.rook.w
X <- c(1,2,3,2,3,4,3,4,5)
X
X.mean <- mean(X)
X.mean
moran1 <- matrix(ncol=N,nrow=N,0)
moran1
for(i in 1:N){
for(j in 1:N){
moran1[i,j] <- neigh.rook.w[i,j] * (X[i] - X.mean) * (X[j] - X.mean)}}#
> moran1
moran1[i,j] <- neigh.rook.w[i,j] * (X[i] - X.mean) * (X[j] - X.mean)}}
for(i in 1:N){
for(j in 1:N){
moran1[i,j] <- neigh.rook.w[i,j] * (X[i] - X.mean) * (X[j] - X.mean)}}
sum(moran1)
MoranI <- N * sum(moran1) / {sum(neigh.rook.w) * sum((X-X.mean)^2)}
MoranI
b<-c(1:5)
bt<-t(b)
bt
bt2<-t(bt)
bt2
rbind(b,b,b)
c <- rbind(b,b)
c
d <- cbind(c,c)
d
A <- matrix(c(1,1,2,2,2,"SWI","RCI","SWI","ディズニー","おくりびと"),nrow=5,ncol=2)
A
B <- matrix(c(1,1,2,2,2,"SWI","RCI","SWI","ディズニー","おくりびと"),nrow=5,ncol=2)
B
colnames(B)<-c("TID","映画")
B
rownames(B)<-c(1:5)
B
library(spdep)
x <- read.shape(system.file("shapes/columbus.shp", package="maptools")[1])
plot(x)
n <- attr(x$Shapes,'nshps')
n
nParts <- integer(n)
nParts
for (i in 1:n) nParts[i] <- attr(x$Shapes[[i]], "nParts")
nParts
table(nParts)
nParts
cols <- c("azure", "blue", "orange")
cols
fgs <- cols[nParts]
fgs
plot(x, fg=fgs)
res <- plot(x, auxvar=x$att.data$CRIME)
str(res)
plot(x, fg=fgs)
res <- plot(x, auxvar=x$att.data$CRIME)
summary(x$att.data)
res <- plot(x, auxvar=x$att.data$HOVAL)
res <- plot(x, auxvar=x$att.data$DISCBD)
res <- plot(x, auxvar=x$att.data$INC)
res <- plot(x, auxvar=x$att.data$CRIME)
data(columbus)#
col.tri.nb <- tri2nb(coords, row.names=rownames(columbus))#
plot(polys, border="grey")#
plot(col.tri.nb, coords, add=TRUE)#
title(main="Raw triangulation links")
col.knn <- knearneigh(coords, k=4)#
plot(polys, border="grey")#
plot(knn2nb(col.knn), coords, add=TRUE)#
title(main="K nearest neighbours, k = 4")
knn3 <- knearneigh(coords, 3)#
knn4 <- knearneigh(coords, 4)#
nb3 <- knn2nb(knn3, row.names=rownames(columbus))#
nb4 <- knn2nb(knn4, row.names=rownames(columbus))#
diffs <- diffnb(nb3, nb4)#
plot(polys, border="grey")#
plot(nb3, coords, add=TRUE)#
plot(diffs, coords, add=TRUE, col="red", lty=2)#
title(main="Plot of third (black) and fourth (red)\nnearest neighbours")
col.nb1 <- dnearneigh(coords, 0, 1.0, row.names=rownames(columbus))#
plot(polys, border="grey")#
plot(col.nb1, coords, add=TRUE)#
title(main=paste("Distance based neighbours 0-1 distance units", sep=""))
pnb <- poly2nb(polys)#
col.tri.nb <- tri2nb(coords, row.names=rownames(columbus))#
dpnb <- diffnb(pnb, col.tri.nb)#
plot(polys, border="grey")#
plot(dpnb, coords, add=TRUE, col="red")#
plot(polys, border="grey")#
plot(col.tri.nb, coords, add=TRUE)#
plot(dpnb, coords, add=TRUE, col="red")#
title(main=" Red: drauney triangulation weights \n Black: and polygon generated queen weights")
moran.test(spNamedVec("CRIME", columbus), nb2listw(pnb, style="W"))
geary.test(spNamedVec("CRIME", columbus), nb2listw(pnb, style="W"))
library(spdep)
data(afcon)
afcon
plot(afxy)
plot(africa.rook.nb, afxy)
plot(diffnb(paper.nb, africa.rook.nb), afxy, col="red", add=TRUE)
 moran.test(afcon$totcon, nb2listw(africa.rook.nb))
moran.test(afcon$totcon, nb2listw(paper.nb))
geary.test(afcon$totcon, nb2listw(paper.nb))
resI <- localmoran(afcon$totcon, nb2listw(paper.nb))
resI
afcon.lm <- data.frame(cbind(resI[,1],(afcon$totcon- #
mean(afcon$totcon))/sd(afcon$totcon)),row.names=afcon$name)
colnames(afcon.lm) <- c("Ii","standardized totcon")
afcon.lm
plot(afcon.lm,xlab="Local Moran's I", ylab="Standardized Total Conflicts")
text(afcon.lm,rownames(afcon.lm))
library(datasets)
library(stats)
eurodist
eur.cmd <- cmdscale(eurodist)
eur.cmd <- cmdscale(eurodist,k=2)
plot(eur.cmd)
    *#
#
      text(eur.cmd,rownames(eur.cmd ),cex=0.6)
library(DCluster)
data(nc.sids)
sids<-data.frame(Observed=nc.sids$SID74)
sids<-cbind(sids,  #
Expected=nc.sids$BIR74*sum(nc.sids$SID74)/sum(nc.sids$BIR74))
sids<-cbind(sids, x=nc.sids$x, y=nc.sids$y)
library(cluster)
sids.clust <- agnes(sids[,1])
sids
plot(sids.clust)
sids.clust2 <- agnes(sids[,2])
plot(sids.clust2)
help(agnes)
sids.clust2 <- agnes(sids[,2],method=ward)
sids.clust2 <- agnes(sids[,2],method="ward")
plot(sids.clust2)
sids.km<-kmeans(sids[,1],5)
plot(sids.km)
plot(sids[,1],col=sids.km$cluster)
sids.km
points(sids.km$centers,col=1:5,pch=8,cex=2)
data(nc.sids)
nc.sids
help(achisq.stat)
sids<-data.frame(Observed=nc.sids$SID74)#
sids<-cbind(sids, Expected=nc.sids$BIR74*sum(nc.sids$SID74)/sum(nc.sids$BIR74))
achisq.stat(sids, lambda=1)
 sids<-cbind(sids, x=nc.sids$x, y=nc.sids$y)
 sidsgam<-opgam(data=sids, radius=30, step=10, alpha=.002)#
 plot(sids$x, sids$y, xlab="Easting", ylab="Northing")#
 points(sidsgam$x, sidsgam$y, col="red", pch="*")#
 radii <- rep(30, length(sidsgam$x))#
 symbols(sidsgam$x, sidsgam$y, circles=radii,add=T)
pp <- runifpoint(50)#
K<-Kest(pp,correction="Ripley")#
plot(K)
library(spdep)
pp <- runifpoint(50)#
K<-Kest(pp,correction="Ripley")#
plot(K)
help(runifpoints)
 library(spatstat)
pp <- runifpoint(50)#
K<-Kest(pp,correction="Ripley")#
plot(K)
plot(pp)
 library(splancs)
data(cardiff)#
s <- seq(2,30,2)#
plot(s, sqrt(khat(as.points(cardiff), cardiff$poly, s)/pi) - s,#
type="l", xlab="Splancs - polygon boundary", ylab="Estimated L",#
ylim=c(-1,1.5))
plot(cardiff)
newstyle <- khat(as.points(cardiff), cardiff$poly, s, newstyle=TRUE)#
str(newstyle)#
newstyle
apply(newstyle$khats, 2, sum)#
plot(newstyle)
plot(cardiff)
s
summary(cardiff)
sids
n1<-12; n2<-10; n3<-8; n4<-10;n<-n1+n2+n3+n4; v<- 0.1
#
x1<-runif(n1,0,20); y1<-0.8*x1+1.2
#
x2<-runif(n2,7,20); y2<-1.2*x2+0.9
#
x3<-runif(n3,10,20); y3<-0.7*x3+1.0
#
x4<-runif(n4,9,20); y4<-1.0*x4+0.8
x1<-runif(n1,0,20); y1<-rnorm(n1, 0.8*x1+1.2, sqrt(v))
#
x2<-runif(n2,7,20); y2<-rnorm(n2, 1.2*x2+0.9, sqrt(v))
#
x3<-runif(n3,10,20); y3<-rnorm(n3, 0.7*x3+1.0, sqrt(v))
#
x4<-runif(n4,9,20); y4<-rnorm(n4, 1.0*x4+0.8, sqrt(v))
par(mfrow=c(1,2))
#
plot(x1, y1,ann=FALSE,cex=1.4,cex.axis=1.5,xlim=c(0,22),ylim=c(0,30))
#
title(xlab="X",cex.lab=1.2,font.lab=4)
#
title(ylab="Y",cex.lab=1.2,font.lab=4)
#
points(x2,y2,pch=22,cex=1.4)
#
points(x3,y3,pch=23,cex=1.4)
#
points(x4,y4,pch=24,cex=1.4)
#
curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21))
#
curve(1.2*x+0.9,add=T,lwd=2,lty=2,xlim=c(6,21))
#
curve(0.7*x+1.0,add=T,lwd=2,lty=3,xlim=c(9,21))
#
curve(1.0*x+0.8,add=T,lwd=2,lty=4,xlim=c(8,21))
#
legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"),
#
lwd=2,lty=c(1,2,3,4),cex=1.2)
plot(x1, y1,ann=FALSE,cex=1.4,cex.axis=1.5,xlim=c(0,22),ylim=c(0,30))
#
title(xlab="X",cex.lab=1.2,font.lab=4)
#
title(ylab="Y",cex.lab=1.2,font.lab=4)
#
points(x2,y2,pch=22,cex=1.4)
#
points(x3,y3,pch=23,cex=1.4)
#
points(x4,y4,pch=24,cex=1.4)
#
curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21))
#
curve(1.2*x+0.9,add=T,lwd=2,lty=2,xlim=c(6,21))
#
curve(0.7*x+1.0,add=T,lwd=2,lty=3,xlim=c(9,21))
#
curve(1.0*x+0.8,add=T,lwd=2,lty=4,xlim=c(8,21))
#
legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"),
#
lwd=2,lty=c(1,2,3,4),cex=1.2)
plot(x1, y1,ann=FALSE,cex=1.4,cex.axis=1.5,xlim=c(0,22),ylim=c(0,30))
#
title(xlab="X",cex.lab=1.2,font.lab=4)
#
title(ylab="Y",cex.lab=1.2,font.lab=4)
#
points(x2,y2,pch=22,cex=1.4)
#
points(x3,y3,pch=23,cex=1.4)
#
points(x4,y4,pch=24,cex=1.4)
#
curve(0.82358*x+2.17414,add=T,lwd=2,lty=1,xlim=c(0,21))
par(mfrow=c(1,3))
#
# x~N(0,20)
#
curve(dnorm(x,0,20), -100, 100, main="x~N(0,20)", ylab="確率分布", lwd=2, cex.axis=1.5, 
#
cex.lab=1.5, cex.main=1.5,font.main=4)
#
# x~N(10,20)
#
curve(dnorm(x,10,20), -100,100, main="x~N(10,20)", ylab="確率分布", lwd=2, cex.axis=1.5, 
#
cex.lab=1.5, cex.main=1.5,font.main=4)
#
# x~N(0,40)
#
curve(dnorm(x,0,40), -100, 100, main="x~N(0,40)", ylab="確率分布", lwd=2, cex.axis=1.5, 
#
cex.lab=1.5, cex.main=1.5, font.main=4)
# y=1のとき
#
# dnorm(x, mean,sd)
#
curve(dnorm(x, 11/20, 11/20), -10, 10)
# 図1.7, 1.8, 1.9
#
par(mfrow=c(1,3))
#
beta <- 0.9;
#
b <- sum(y*x)/sum(x*x)
#
# seq(min, max, length)は区間[min,max]でlength個の数を生成
#
beta1 <- seq(0.62, 1.03, length=100)
#
# dnorm(n, m, s)は平均m，標準偏差sの正規分布
#
plot(beta1, dnorm(beta1, b, 1/sqrt(sum(x*x))),type="l", xlab=expression(beta), 
#
ylab="尤度",xlim=c(0.9,1.03),lwd=3,cex=1.3,cex.axis=1.5,cex.lab=1.3)
#
plot(x, y, xlab="X", ylab="Y",lwd=2,cex=1.3,cex.axis=1.5,cex.lab=1.4,font.lab=4)
#
curve(0.865*x, add=T,lwd=3)
#
plot(dunif,-1,2,type="l",xlab=" ",ylab=" ",lwd=3,cex.axis=1.5,cex.lab=1.4,font.lab=4)
curve(dnorm(x, 11/20, 11/20), -10, 10)
#

#
# 図1.7, 1.8, 1.9
#
par(mfrow=c(1,3))
#
beta <- 0.9;
#
b <- sum(y*x)/sum(x*x)
#
# seq(min, max, length)は区間[min,max]でlength個の数を生成
#
beta1 <- seq(0.62, 1.03, length=100)
#
# dnorm(n, m, s)は平均m，標準偏差sの正規分布
#
plot(beta1, dnorm(beta1, b, 1/sqrt(sum(x*x))),type="l", xlab=expression(beta), 
#
ylab="尤度",xlim=c(0.9,1.03),lwd=3,cex=1.3,cex.axis=1.5,cex.lab=1.3)
#
plot(x, y, xlab="X", ylab="Y",lwd=2,cex=1.3,cex.axis=1.5,cex.lab=1.4,font.lab=4)
#
curve(0.865*x, add=T,lwd=3)
#
plot(dunif,-1,2,type="l",xlab=" ",ylab=" ",lwd=3,cex.axis=1.5,cex.lab=1.4,font.lab=4)
x
y
x <-c(x1,x2,x3,x4)
y<-par(mfrow=c(1,2))#
plot(x1, y1,ann=FALSE,cex=1.4,cex.axis=1.5,xlim=c(0,22),ylim=c(0,30))#
title(xlab="X",cex.lab=1.2,font.lab=4)#
title(ylab="Y",cex.lab=1.2,font.lab=4)#
points(x2,y2,pch=22,cex=1.4)#
points(x3,y3,pch=23,cex=1.4)#
points(x4,y4,pch=24,cex=1.4)#
curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21))#
curve(1.2*x+0.9,add=T,lwd=2,lty=2,xlim=c(6,21))#
curve(0.7*x+1.0,add=T,lwd=2,lty=3,xlim=c(9,21))#
curve(1.0*x+0.8,add=T,lwd=2,lty=4,xlim=c(8,21))#
legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"),#
lwd=2,lty=c(1,2,3,4),cex=1.2)
curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21))
plot(x1, y1,ann=FALSE,cex=1.4,cex.axis=1.5,xlim=c(0,22),ylim=c(0,30))#
title(xlab="X",cex.lab=1.2,font.lab=4)#
title(ylab="Y",cex.lab=1.2,font.lab=4)#
points(x2,y2,pch=22,cex=1.4)#
points(x3,y3,pch=23,cex=1.4)#
points(x4,y4,pch=24,cex=1.4)#
curve(0.8*x1+1.2,add=T,lwd=2,lty=1,xlim=c(0,21))#
curve(1.2*x2+0.9,add=T,lwd=2,lty=2,xlim=c(6,21))#
curve(0.7*x3+1.0,add=T,lwd=2,lty=3,xlim=c(9,21))#
curve(1.0*x4+0.8,add=T,lwd=2,lty=4,xlim=c(8,21))#
legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"),#
lwd=2,lty=c(1,2,3,4),cex=1.2)
x <- c(x1,x2,x3,x4); y <- c(y1,y2,y3,y4)
title(xlab="X",cex.lab=1.2,font.lab=4) title(ylab="Y",cex.lab=1.2,font.lab=4) points(x2,y2,pch=22,cex=1.4) points(x3,y3,pch=23,cex=1.4) points(x4,y4,pch=24,cex=1.4) curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21)) curve(1.2*x+0.9,add=T,lwd=2,lty=2,xlim=c(6,21)) curve(0.7*x+1.0,add=T,lwd=2,lty=3,xlim=c(9,21)) curve(1.0*x+0.8,add=T,lwd=2,lty=4,xlim=c(8,21)) legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"), lwd=2,lty=c(1,2,3,4),cex=1.2)
x1<-runif(n1,0,20); y1<-rnorm(n1, 0.8*x1+1.2, sqrt(v))#
x2<-runif(n2,7,20); y2<-rnorm(n2, 1.2*x2+0.9, sqrt(v))#
x3<-runif(n3,10,20); y3<-rnorm(n3, 0.7*x3+1.0, sqrt(v))#
x4<-runif(n4,9,20); y4<-rnorm(n4, 1.0*x4+0.8, sqrt(v))
title(xlab="X",cex.lab=1.2,font.lab=4) title(ylab="Y",cex.lab=1.2,font.lab=4) points(x2,y2,pch=22,cex=1.4) points(x3,y3,pch=23,cex=1.4) points(x4,y4,pch=24,cex=1.4) curve(0.8*x+1.2,add=T,lwd=2,lty=1,xlim=c(0,21)) curve(1.2*x+0.9,add=T,lwd=2,lty=2,xlim=c(6,21)) curve(0.7*x+1.0,add=T,lwd=2,lty=3,xlim=c(9,21)) curve(1.0*x+0.8,add=T,lwd=2,lty=4,xlim=c(8,21)) legend(0,30,legend=c("モデル１：Y=0.8*X+1.2","モデル２：Y=1.2*X+0.9","モデル３：Y=0.7*X+1.0","モデル４：Y=1.0*X+0.8"), lwd=2,lty=c(1,2,3,4),cex=1.2)
library(sna)
g<-rgraph(5)
g.p<-0.8*g+0.2*(1-g)
dat<-rgraph(5,5,tprob=g.p)
g
dat
pnet<-matrix(ncol=5,nrow=5)
pnet[,]<-0.5
#Define em and ep priors
pem<-matrix(nrow=5,ncol=2)
pem[,1]<-3
pem[,2]<-5
pep<-matrix(nrow=5,ncol=2)
pep[,1]<-3
pep[,2]<-5
#Draw from the posterior
b<-bbnam(dat,model="actor",nprior=pnet,emprior=pem,epprior=pep,
burntime=100,draws=100)
#Print a summary of the posterior draws
summary(b)
data(coleman)
coleman
summary(coleman)
gplot(coleman[1,,]|coleman[2,,],edge.col=2*coleman[1,,]+3*coleman[2,,])
gplot3d(coleman[1,,]|coleman[2,,],edge.col=2*coleman[1,,]+3*coleman[2,,])
gplot3d(rgws(1,5,3,1,0))
gplot3d(rgws(1,5,3,1,0.05))
gplot3d(coleman[1,,]|coleman[2,,],edge.col=2*coleman[1,,]+3*coleman[2,,])
