File:Today's Tokyo.svg

svg('test.svg', width=10)

## Latest available data from this source
year <- 2006
baseurl <- 'http://giswin2.geo.tsukuba.ac.jp/teacher/murayama/boundary/shapefiles/'

## Download/read data
dataFile <- paste0('jpn', year, '.lzh')
if (!file.exists(dataFile))
   download.file(paste0(baseurl, dataFile), dataFile)
extensions <- c('dbf', 'shp', 'shx')
basename <- paste0('jpn', year, 'geo')
if (!all(file.exists(paste(basename, extensions, sep='.'))))
   unzip(dataFile, exdir = '.')

library(maptools)
polygons <- readShapePoly(basename)

## Sanitise data
library(functional)
translate <- Curry('iconv', from = 'SJIS', to = 'UTF-8')
# fixes ’利島村　' in the CITY field
translateAndStripWhitespace = function(s) gsub('^\\s+|\\s+$', "", translate(s))
polygons$CITY <- sapply(polygons$CITY, # City/town/ward
                        translateAndStripWhitespace)
polygons$PREF <- sapply(polygons$PREF, # Prefecture
                        translateAndStripWhitespace)
polygons$GUN  <- sapply(polygons$GUN,  # District
                        translateAndStripWhitespace)

## Restrict to Tokyo and surroundings
tokyoNeighbourhoodPolygons <- polygons[
  polygons$PREF %in% c('東京都', '神奈川県', '山梨県', '埼玉県', '千葉県'),]
# Akiruno is (erroneously?) split into Akigawa and Itsukaichi (merged 1995/09/01)
akirunoParts <- c('秋多町', '五日市町')
# Nishi-Tokyo is (erroneously?) split into Hōya and Tanashi (merged 2001/01/21)
nishitokyoParts <- c('保谷市', '田無市')

## Merge surrounding wards into prefectures, incorrect sub-ward levels into wards 
mergedPolygons <-
  unionSpatialPolygons(
    tokyoNeighbourhoodPolygons,
    sapply(1:length(tokyoNeighbourhoodPolygons),
           function(i) {
             prefecture <- tokyoNeighbourhoodPolygons$PREF[[i]]
             if (prefecture == '東京都') {
               city <- tokyoNeighbourhoodPolygons$CITY[[i]]
               if (city %in% akirunoParts) 'あきる野市'
               else if (city %in% nishitokyoParts) '西東京市'
               else city
             } else
               prefecture
           }))

## English labels for wards and prefectures
townTranslator <- list(
  '奥多摩町' = 'Okutama',
  '桧原村' = 'Hinohara',
  '日の出村' = 'Hinode',
  '瑞穂町' = 'Mizuho')
cityTranslator <- list(
  '八王子市' = 'Hachiōji',       # Actually a 'core city'
  'あきる野市' = 'Akiruno',
  '昭島市' = 'Akishima',
  '調布市' = 'Chōfu',
  '府中市' = 'Fuchū',
  '福生町' = 'Fussa',
  '羽村町' = 'Hamura',
  '久留米町' = 'Higashi-Kurume', # Note: Higashi (東) is missing from the name
  '東村山市' = 'Higashi-Murayama',
  '大和町' = 'Higashi-Yamato',   # Note: Higashi (東) is missing from the name
  '日野市' = 'Hino',
  '稲城町' = 'Inagi',
  '清瀬町' = 'Kiyose',
  '小平市' = 'Kodaira',
  '小金井市' = 'Koganei',
  '国分寺市' = 'Kokubunji',
  '狛江町' = 'Komae',
  '国立市' = 'Kunitachi',
  '町田市' = 'Machida',
  '三鷹市' = 'Mitaka',
  '村山町' = 'Musashi-Murayama',
  '武蔵野市' = 'Musashino',
  '西東京市' = 'Nishi-Tōkyō',
  '青梅市' = 'Ōme',
  '立川市' = 'Tachikawa',
  '多摩町' = 'Tama')
specialWardTranslator <- list(
  '世田谷区' = 'Setagaya',
  '中央区' = 'Chūō',
  '中野区' = 'Nakano',
  '北区' = 'Kita',
  '千代田区' = 'Chiyoda',
  '台東区' = 'Taitō',
  '品川区' = 'Shinagawa',
  '墨田区' = 'Sumida',
  '大田区' = 'Ōta',
  '文京区' = 'Bunkyō',
  '新宿区' = 'Shinjuku',
  '杉並区' = 'Suginami',
  '板橋区' = 'Itabashi',
  '江戸川区' = 'Edogawa',
  '江東区' = 'Kōtō',
  '渋谷区' = 'Shibuya',
  '港区' = 'Minato',
  '目黒区' = 'Meguro',
  '練馬区' = 'Nerima',
  '荒川区' = 'Arakawa',
  '葛飾区' = 'Katsushika',
  '豊島区' = 'Toshima',
  '足立区' = 'Adachi')
surroundingTranslator <- list(
  '神奈川県' = 'Kanagawa',
  '山梨県' = 'Yamanashi',
  '埼玉県' = 'Saitama',
  '千葉県' = 'Chiba')

tokyoTranslator <- c(townTranslator,
                     cityTranslator,
                     specialWardTranslator)
combinedTranslator <- c(tokyoTranslator,
                        surroundingTranslator)

## Remove wards that we do not want to plot (in effect, islands)
mergedPolygons <- mergedPolygons[names(mergedPolygons)
                                 %in% names(combinedTranslator),]

wardNames <- names(mergedPolygons)
wardNamesTranslated <- sapply(wardNames, function(x) toupper(combinedTranslator[[x]]))
wardNamesTranslatedMultiline <- gsub("-", "-\n", wardNamesTranslated)

## Restrict polygons to plotting area (tokyo area +- (5%,2%)) to better position labels
library(raster)
library(rgeos)

tokyoExtent <-
  extent(mergedPolygons[wardNames %in% names(tokyoTranslator)])
xdiff <- tokyoExtent@xmax - tokyoExtent@xmin
ydiff <- tokyoExtent@ymax - tokyoExtent@ymin
plottingExtent <- extent(tokyoExtent@xmin - 0.05 * xdiff,
                         tokyoExtent@xmax + 0.05 * xdiff,
                         tokyoExtent@ymin - 0.02 * ydiff,
                         tokyoExtent@ymax + 0.02 * ydiff)
mergedPolygons <-
  gIntersection(mergedPolygons, as(plottingExtent,
                                   "SpatialPolygons"),
                byid=TRUE, id=wardNames)

## Compute appropriate label positions
plot.new()
# the error 'Could not fit label inside polygon' means cex needs to be lowered
almostOptimalLabelPositions <-
  polygonsLabel(mergedPolygons,
                labels = wardNamesTranslatedMultiline,
                doPlot = FALSE,
                cex=0.2)
labelPositions <- data.frame(row.names = wardNamesTranslatedMultiline,
                             longitude = almostOptimalLabelPositions[,1],
                             latitude  = almostOptimalLabelPositions[,2]);
labelSizes <- sapply(wardNames,
                     function(w)
                       if (w %in% names(surroundingTranslator)) 3.5
                       else 1.6)
labelFGColors <- sapply(wardNames,
                        function(w)
                          if (w %in% names(surroundingTranslator)) '#808080'
                          else 'white')
labelBGColors <- sapply(wardNames,
                        function(x)
                          if (x %in% names(townTranslator)) '#D2CCAA'
                          else if (x %in% names(cityTranslator)) '#D9AEC0'
                          else if (x %in% names(specialWardTranslator)) '#BDB0DA'
                          else '#F0F0F0')

## Plot
library(ggplot2)
library(ggsn)
fortifiedPolygons <- fortify(mergedPolygons)
plotData <- merge(fortifiedPolygons,
                  data.frame(color=labelBGColors), by.x='id', by.y=0)
ggplot(data = fortifiedPolygons, aes(long,lat)) +
  labs(x = 'Longitude', y = 'Latitude') +
  geom_polygon(aes(group = group), size=0.1, fill=plotData$color, color='black') +
  coord_map(xlim = c(plottingExtent@xmin, plottingExtent@xmax),
            ylim = c(plottingExtent@ymin, plottingExtent@ymax)) +
  geom_text(data = labelPositions,
            aes(label = wardNamesTranslatedMultiline,
                x = longitude, y = latitude),
            size = labelSizes,
            color = labelFGColors) +
  scalebar(data = fortifiedPolygons,
           dist = 5, dd2km = TRUE, model = 'GRS80',
           st.bottom = FALSE, st.size=1.5,
           anchor = c(x=tokyoExtent@xmax, y=tokyoExtent@ymin)) +
  theme(axis.text=element_blank(),
        axis.title=element_blank(),
        axis.ticks=element_blank(),
        panel.background = element_rect(fill = '#C0DCF7', colour = '#979798'),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank())

dev.off()