[R-sig-Geo] Editing Shapefiles

[Hisaji ONO]

Date: Thu, 15 Dec 2005 20:56:16 +0900 (JST) 
From: "Hisaji ONO" <hi_ono2001 at ybb.ne.jp>  アドレスブッ
クに追加
DomainKeys は、このメールが ybb.ne.jp から送信されたこと
を確認しました。  
Subject: Re: [R-sig-Geo] Editing Shapefiles --
Non-Contiguous Area-based Cartogram 
To: "Hisaji ONO" <hi_ono2001 at ybb.ne.jp> 

       


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.