Date: Thu, 15 Dec 2005 20:56:16 +0900 (JST)
From: "Hisaji ONO" <[EMAIL PROTECTED]> アドレスブッ
クに追加
DomainKeys は、このメールが ybb.ne.jp から送信されたこと
を確認しました。
Subject: Re: [R-sig-Geo] Editing Shapefiles --
Non-Contiguous Area-based Cartogram
To: "Hisaji ONO" <[EMAIL PROTECTED]>
Hi.
This is ascript for support of multi-parts polygon shape
file.
#require(maptools)
createNonContiguousAreaBasedCartogram<-function(mapObj,targetAttribute,areaAttribute){
outputMapObj <- mapObj
densities<- sqrt(targetAttribute/areaAttribute)
maxDensity<-max(densities) # get Maximum of densities
k <- 1/maxDensity
L <- k * densities
centroidXY<-get.Pcent(mapObj) # get polygons' centroids
mapObj2 <- mapObj[[1]]
for(i in 1:length(mapObj2)){
if(mapObj2[[i]]$nParts == 1){
coords <- mapObj2[[i]]$verts
newX<-L[i] * (coords[,1] - centroidXY[i,1]) +
centroidXY[i,1] # new X coordinate
newY<-L[i] * (coords[,2] - centroidXY[i,2]) +
centroidXY[i,2] # new Y coordinate
polygon(newX,newY,col="red") #draw polygon
}else{
pStartList <- mapObj2[[i]]$Pstart + 1
allCoords <- mapObj2[[i]]$verts
for(j in 1:length(pStartList)){
if(j == length(pStartList))
coords
<-allCoords[pStartList[j]:nrow(allCoords),]
else
coords <- allCoords[pStartList[j]:(pStartList[j
+ 1] -1),]
centroidXYP<-c(mean(coords[,1]),mean(coords[,2]))
centroidXYP<-c( centroidXY[i,1], centroidXY[i,2])
points(centroidXYP)
print(centroidXYP)
newX<-L[i] * (coords[,1] - centroidXYP[1]) +
centroidXYP[1] # new X coordinate
newY<-L[i] * (coords[,2] - centroidXYP[2]) +
centroidXYP[2] # new Y coordinate
polygon(newX,newY,col="blue") #draw polygon
}
}
}
}
columbus<-read.shape(system.file("shapes/columbus.shp",package="maptools"))
createNonContiguousAreaBasedCartogram(columbus,columbus$att.data$CRIME,columbus$att.data$AREA)
Regards.
_______________________________________________
R-sig-Geo mailing list
R-sig-Geo@stat.math.ethz.ch
https://stat.ethz.ch/mailman/listinfo/r-sig-geo
