File:Today's Tokyo.svg

From Wikimedia Commons, the free media repository
Jump to navigation Jump to search

Original file (SVG file, nominally 900 × 630 pixels, file size: 2.16 MB)

Captions

Captions

Add a one-line explanation of what this file represents

Summary

[edit]
Description
English: Tokyo and surroundings, generated with R from publicly available shapefiles using code that is made available at https://gist.github.com/pipping/4c601adeaccd200f25b6ab37ffdfe866
Date
Source Own work
Author Pipping

Licensing

[edit]
I, the copyright holder of this work, hereby publish it under the following licenses:
GNU head Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.2 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled GNU Free Documentation License.
w:en:Creative Commons
attribution share alike
This file is licensed under the Creative Commons Attribution-Share Alike 4.0 International, 3.0 Unported, 2.5 Generic, 2.0 Generic and 1.0 Generic license.
You are free:
  • to share – to copy, distribute and transmit the work
  • to remix – to adapt the work
Under the following conditions:
  • attribution – You must give appropriate credit, provide a link to the license, and indicate if changes were made. You may do so in any reasonable manner, but not in any way that suggests the licensor endorses you or your use.
  • share alike – If you remix, transform, or build upon the material, you must distribute your contributions under the same or compatible license as the original.
You may select the license of your choice.

Code

[edit]

Created with the following piece of code:

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()

File history

Click on a date/time to view the file as it appeared at that time.

Date/TimeThumbnailDimensionsUserComment
current00:28, 11 April 2016Thumbnail for version as of 00:28, 11 April 2016900 × 630 (2.16 MB)Pipping (talk | contribs)Fix spelling of Chōfu
16:07, 7 April 2016Thumbnail for version as of 16:07, 7 April 2016900 × 630 (2.16 MB)Pipping (talk | contribs)Uppercase ward labels
15:52, 7 April 2016Thumbnail for version as of 15:52, 7 April 2016900 × 630 (2.17 MB)Pipping (talk | contribs)Add scale bar
04:44, 7 April 2016Thumbnail for version as of 04:44, 7 April 2016900 × 630 (2.16 MB)Pipping (talk | contribs)More reasonable size, better label positioning
04:10, 7 April 2016Thumbnail for version as of 04:10, 7 April 2016630 × 630 (2.26 MB)Pipping (talk | contribs)

The following page uses this file:

Metadata