1 Введение

В пакете lingtypology мне захотелось нарисовать карту. Однако на этот раз я хочу приблизиться к формату, который можно публиковать в статье. Так что я выбираю черно-белую подложку.

library(lingtypology) 

# закачаем данные
df <- read.csv("http://web-corpora.net/~agricolamz/maps/2016%20Kuban%20article/data.csv")

# нарисуем при помощи пакета lingtypology
map.feature(df$language,
            features = df$languoid,
            latitude = df$latitude,
            longitude = df$longitude,
            radius = 8,
            color = c("white", "black","grey"),
            stroke.features = df$languoid,
            stroke.color = "black",
            stroke.legend = F,
            tile = "OpenStreetMap.BlackAndWhite")

В целом, конечно, отлично, но мы же хотим знать что это за точки, ведь если мы опубликуем эту карту в статье никто не сможет тыкать в них. К тому же в январе я добавил в пакет lingtypology аргументы, позволяющие добавлять изображения. Все необходимые названия селений уже записаны в файле:

head(df$village)

## [1] Вако-Жиле       Бесленей        Хабез           Новохумаринский
## [5] Абазакт         Псауче-Дахэ    
## 22 Levels: Абазакт Адыгэ-Хабль Али-Бердуковский Баралки ... Эрсакон

Нужно получить список картинок (например, .png, желательно, прозрачных), содержащих названия всех селений и ничего другого. После этого можно будет выложить их в интернет и дать ссылки для пакета lingtypology.

2 Как?

У меня было несколько вариантов:

• первым вариантом было не вылезать из R и сделать графики без осей и т. п., но с текстом. Это можно сделать и в base, и в ggplot, хотя идея делать графики, а потом их обрезать меня пугала. Как я автоматически пойму насколько нужно обрезать? Тем более, что буквы имеют подстрочные элементы (например, у или р), которые не надо обрезать, в то время, как это пространство у слов, не содержащих подстрочные элементы следует обрезать.
• в LaTeX есть тип документов standalone, который делает .pdf, содержащий исключительно написанное или нарисованное, без всяких рамок и прочего. Правда потом все равно придется делать из .pdf .png, но это-то R умеет.

Наверняка, есть способ более быстрый (совершенно точно), элегантный и прочее и прочее… Однако я решил использовать LaTeX, точнее его разновидность XeLaTeX. В результате я могу контролировать даже шрифт получивших надписей.

3 R > Latex > R

Для начала я решил создать векторы, содержащие в качестве строки XeLaTeX-код (все бэкслэши приходится экранировать):

latex <- paste("
\\documentclass{standalone}
\\usepackage[english,russian]{babel}
\\usepackage{fontspec}
\\defaultfontfeatures{Ligatures={TeX},Renderer=Basic}
\\setmainfont[Ligatures={TeX,Historic},
  SmallCapsFont={Brill},
    SmallCapsFeatures={Letters=SmallCaps}]{Brill}
\\setsansfont{Brill}
\\begin{document}",
df$village,
"\\end{document}")
latex[1]

## [1] "\n\\documentclass{standalone}\n\\usepackage[english,russian]{babel}\n\\usepackage{fontspec}\n\\defaultfontfeatures{Ligatures={TeX},Renderer=Basic}\n\\setmainfont[Ligatures={TeX,Historic},\n  SmallCapsFont={Brill},\n\tSmallCapsFeatures={Letters=SmallCaps}]{Brill}\n\\setsansfont{Brill}\n\\begin{document} Вако-Жиле \\end{document}"

Теперь нужно создать все эти XeLaTeX файлы

setwd("/home/agricolamz/_DATA/OneDrive1/_Work/Articles/2017 II Kuban phonology/map/names")
mapply(function(x, y){write(x,file = paste0(y, ".tex"))},
       latex, # аргумент x
       df$village) # аргумент y

cd "/home/agricolamz/_DATA/OneDrive1/_Work/Articles/2017 II Kuban phonology/map/names"
ls

## How_to_create_village_names.html
## How_to_create_village_names.Rmd
## Абазакт.tex
## Адыгэ-Хабль.tex
## Али-Бердуковский.tex
## Баралки.tex
## Бесленей.tex
## Блечепсин.tex
## Вако-Жиле.tex
## Жако.tex
## Зеюко.tex
## Инжичишхо.tex
## Коноково.tex
## Кошехабль.tex
## Кош-Хабль.tex
## Кургоковское.tex
## Малый-Зеленчук.tex
## Новохумаринский.tex
## Псауче-Дахэ.tex
## Уляп.tex
## Хабез.tex
## Ходзь.tex
## Хумара.tex
## Эрсакон.tex

Скомпелируем все эти файлы .tex (если в каком-то из названий есть пробел, то у меня все умирает и не работает):

cd "/home/agricolamz/_DATA/OneDrive1/_Work/Articles/2017 II Kuban phonology/map/names"; for i in *.tex; do xelatex $i;done
# И приберемся за собой...
rm *.aux
rm *.log
rm *.tex

cd "/home/agricolamz/_DATA/OneDrive1/_Work/Articles/2017 II Kuban phonology/map/names"
ls

## How_to_create_village_names.html
## How_to_create_village_names.Rmd
## Абазакт.pdf
## Адыгэ-Хабль.pdf
## Али-Бердуковский.pdf
## Баралки.pdf
## Бесленей.pdf
## Блечепсин.pdf
## Вако-Жиле.pdf
## Жако.pdf
## Зеюко.pdf
## Инжичишхо.pdf
## Коноково.pdf
## Кошехабль.pdf
## Кош-Хабль.pdf
## Кургоковское.pdf
## Малый-Зеленчук.pdf
## Новохумаринский.pdf
## Псауче-Дахэ.pdf
## Уляп.pdf
## Хабез.pdf
## Ходзь.pdf
## Хумара.pdf
## Эрсакон.pdf

Последний шаг: сконвертируем получившиеся .pdf в .png:

setwd("/home/agricolamz/_DATA/OneDrive1/_Work/Articles/2017 II Kuban phonology/map/names")
library("animation")
sapply(df$village, function(x){
  im.convert(paste0(x, ".pdf"),
             paste0(x, ".png"),
             extra.opts="-density 400")})

Теперь я залью файлы в интернет и построю карту:

# Вектор с адресами файлов в интернете
df$url <- paste0(
  "http://web-corpora.net/~agricolamz/maps/2016%20Kuban%20article/",
  df$village,
  ".png")

# карта
library(leaflet); library(lingtypology) 
map.feature(df$language,
            features = df$languoid,
            latitude = df$latitude,
            longitude = df$longitude,
            radius = 8,
            color = c("white", "black","grey"),
            stroke.features = df$languoid,
            stroke.color = "black",
            stroke.legend = F,
            popup = df$village,
            image.url = df$url,
            image.height = 15,
            image.width = 10*nchar(as.character(df$village)),
            tile = "OpenStreetMap.BlackAndWhite")

Дальше осталось вручную подвести каждый сдвиг названия относительно точки:

df$x.shift[6] <- 20
map.feature(df$language,
            features = df$languoid,
            latitude = df$latitude,
            longitude = df$longitude,
            radius = 8,
            color = c("white", "black","grey"),
            stroke.features = df$languoid,
            stroke.color = "black",
            stroke.legend = F,
            image.url = df$url,
            image.height = 11*df$font.size,
  # Ширина изображения должна зависеть от количества символов
            image.width = 10*nchar(as.character(df$village)),
            image.X.shift = df$x.shift, # подобранные значения
            image.Y.shift = df$y.shift, # подобранные значения
            tile = "OpenStreetMap.BlackAndWhite")

Конечно, местами все не так красиво, все основные проблемы сейчас в аргументе image.height однако цель, в целом, достигнута.