Байесовы сети в R: пакет bnlearn

Описание модели

На протяжении семестра каждый студент проходит две текущих аттестации (получая от 0 до 45 баллов на каждой) и одну итоговую (получая от 1 до 5 баллов). Рассмотрим взаимодействие с байесовой сетью на примере анализа этих результатов.

Сведения о результатах промежуточной и итоговой аттестации студентов представим в виде объекта data.frame:

> head(rating)
        subj type id rate
1 Теория игр    1  1   35
2 Теория игр    1  2   25
3 Теория игр    1  3   35
4 Теория игр    1  4   25
5 Теория игр    1  5   10
6 Теория игр    1  6   35

Где:
subj — наименование дисциплины;
type — вид аттестации (1-я, 2-я и 3-я, итоговая);
id — идентификатор студента;
rate — соответствующая оценка.

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

• вектора оценок студентов по паросочетаниям предмет — номер аттестации;
• вектора оценок по предметам в паросочетаниях студент — номер аттестации.

В первом случае байесова сеть накапливает знания о связях между результатами аттестации в рамках одного предмета, во втором — о связях между результатами аттестации одного студента по всем предметам.

Перечень дисциплин для обучения байесовой сети может формироваться с учётом различных ограничений, например — в зависимости от места дисциплины в структуре образовательной программы, номера семестра либо читающего дисциплину преподавателя.

Выборка студентов для обучения байесовой сети также может формироваться с учетом ограничений — группы, направления подготовки, факультета, года поступления и т. д..

Обучение байесовой сети

Обратите внимание, представление оценок студентов в интервальной шкале методически ошибочно, пример ниже иллюстрирует исключительно работу с пакетом bnlearn и не дает возможности делать содержательные выводы.

Сформируем связи переменных в байесовой сети на основании экспертных знаний:

> net <- model2network("[A1][A2|A1][A3|A1:A2]")

Структура связей этой сети изображена на рисунке.

Структура зависимостей переменных в байесовой сети.

Сформируем набор переменных с результатами аттестаций по дисциплине «Теория игр»:

> a1 <- rating$rate[rating$subj == "Теория игр" & rating$type == 1]
> a2 <- rating$rate[rating$subj == "Теория игр" & rating$type == 2]
> a3 <- rating$rate[rating$subj == "Теория игр" & rating$type == 3]

В обучении байесовой сети пакет bnlearn может использовать объект типа data.frame, содержащий таблицу переменных типа num. Тип переменных a1, a2 и a3 — int, что необходимо учитывать при обучении сети:

> str(a1)
 int [1:8] 35 25 35 25 10 35 25 30
> str(a2)
 int [1:8] 35 25 35 25 20 25 25 25
> str(a3)
 int [1:8] 5 3 5 3 3 5 4 4
> rate <- data.frame(A1 = as.numeric(a1), A2 = as.numeric(a2), A3 = as.numeric(a3))
> net.rate <- bn.fit(net, rate)

Если эту особенность проигнорировать, произойдет следующее:

> rate <- data.frame(A1 = a1, A2 = a2, A3 = a3)
> net.rate <- bn.fit(net, rate)
Ошибка в check.data(data) : 
  variables must be either all real numbers or all factors.

Объект net.rate хранит обученную байесову сеть. Используя его, мы можем получать ответы на вероятностные вопросы. Естественно, эти ответы зависят от обучающей выборки.

Прогнозирование на основе обученной байесовой сети

Ниже приведены примеры построения прогнозов на основе байесовой сети net.rate.

1. Какова вероятность получить положительную оценку для студента, если результаты его аттестаций по дисциплине пока неизвестны?

> cpquery(net.rate, (A3 > 2.5), TRUE)
[1] 0.9393

2. Какова вероятность для студента получить «удовлетворительно», «хорошо» или «отлично» при тех же условиях?

> cpquery(net.rate, (A3 > 2.5 & A3 < 3.5), TRUE)
[1] 0.2479667
> cpquery(net.rate, (A3 > 3.5 & A3 < 4.5), TRUE)
[1] 0.3839
> cpquery(net.rate, (A3 > 4.5), TRUE)
[1] 0.3064333
> 0.2479667 + 0.3839 + 0.3064333
[1] 0.9383

Сумма вероятностей сходится с предыдущим ответом с точностью до двух знаков после запятой. Отклонение объясняется спецификой модели расчетов (метод по умолчанию: logic sampling) — чем сложнее структура сети, тем больше может быть расхождение даже для идентичных запросов, сделанных друг за другом.

3. Если студент получил больше 40 баллов за каждую из текущих аттестаций, каковы его шансы не получить на экзамене «отлично»?

> cpquery(net.rate, (A3 < 4.5), (A1 > 40 & A2 > 40))
[1] 0.015625

4. Если студент получил меньше 20 баллов за каждую из текущих аттестаций, каковы его шансы получить на экзамене положительную оценку?

> cpquery(net.rate, (A3 > 2.5), (A1 < 20 & A2 < 20))
[1] 0.5664931

Обратите внимание, шансы положительной оценки существенно меньше, чем в случае, когда о результатах аттестаций ничего не известно.

5. А если студент получил меньше 20 баллов хотя бы за одну из текущих аттестаций?

> cpquery(net.rate, (A3 > 2.5), (A1 < 20 | A2 < 20))
[1] 0.7522488

Шансы на положительную оценку в этом случае выше, чем в предыдущем.

Анализ причинности на основе обученной байесовой сети

Построение прогнозов — не единственный вариант использования обученной байесовой сети. Ниже приведены примеры диагностирования, построенные на ее основе.

1. Студент получил на экзамене «неудовлетворительно». Какова вероятность того, что хотя бы на одной промежуточной аттестации он получил меньше 20 баллов?

> cpquery(net.rate, (A1 < 20 | A2 < 20), (A3 > 1.5 & A3 < 2.5))
[1] 0.8404692

2. Тот же вопрос для студента, получившего на экзамене «хорошо».

> cpquery(net.rate, (A1 < 20 | A2 < 20), (A3 > 3.5 & A3 < 4.5))
[1] 0.1283003

3. Студент получил на экзамене «удовлетворительно». Что вероятнее: у него есть аттестация хуже 30 баллов или лучше 30 баллов?

> cpquery(net.rate, (A1 < 30 | A2 < 30), (A3 > 2.5 & A3 < 3.5))
[1] 0.9836088
> cpquery(net.rate, (A1 >= 30 | A2 >= 30), (A3 > 2.5 & A3 < 3.5))
[1] 0.1065574

Вероятность первого ответа — существенно выше.

Наконец, приведем варианты межпричинного анализа на основе байесовой сети.

1. Результат первой аттестации студента ниже 30 баллов. Какова вероятность того, что он получит на второй аттестации результат лучше, чем на первой?

> cpquery(net.rate, (A2 > A1), (A1 < 30))
[1] 0.6594571

2. Один студент во втором семестре учился лучше, чем в первом, другой — хуже. У кого вероятность результата второй аттестации выше 30 баллов больше?

> cpquery(net.rate, (A2 > A1), (A2 > 30))
[1] 0.3975462
> cpquery(net.rate, (A2 < A1), (A2 > 30))
[1] 0.6032461

Неожиданный результат — вероятность выше у студента-отличника, «расслабившегося» во втором семестре. Налицо проявление эффекта «возвращение к среднему значению».

Заключение

Нами рассмотрена работа с байесовой сетью, обученной на вещественных переменных. В случае с оценкой работы студентов лучше использовать переменные — факторы. Более того, пакет bnlearn позволяет использовать упорядоченные факторы.

R: трассировка маршрута

Сформируем кратчайший круговой маршрут, являющийся приближенным решением задачи коммивояжера для населённых пунктов Можгинского района.

Ранее мы вычислили для них матрицу расстояний (пояснения)…

> require("igraph")
> mozhga <- read.csv("mozhga.csv", sep = ";", dec = ",")
> mozhga.graph <- graph.data.frame(mozhga, directed = FALSE)  # Формируем граф,
> mozhga.dist <- shortest.paths(mozhga.graph)  # вычисляем матрицу расстояний
> d <- mozhga.dist[grep("_", colnames(mozhga.dist), invert = T), 
+                  grep("_", rownames(mozhga.dist), invert = T)]  # и избавляемся
> # от лишних узлов (предварены символом "_").

… и определили порядок их обхода (пояснения).

> require("TSP")
> mozhga.tsp <- TSP(d)
> mozhga.tour <- solve_TSP(mozhga.tsp, method = "2-opt")
> mozhga.tour.labels <- labels(mozhga.tour)

Элемент списка $vpath, возвращаемого функцией get.shortest.paths {igraph}, содержит номера вершин, составляющих кратчайший маршрут между двумя из них, заданными в качестве параметров.

Функция get.vertex.attribute {igraph} возвращает имя для данного номера вершины.

Код, формирующий список имен населённых пунктов в порядке их участия в маршруте:

> way <- sapply(1:(length(mozhga.tour.labels) - 1), function(x) {
+     get.shortest.paths(mozhga.graph,
+                        mozhga.tour.labels[x],
+                        mozhga.tour.labels[x + 1])$vpath[[1]][-1]
+ }) # Собираем номера вершин графа, в порядке движения по маршруту.
> way <- unlist(way)
> fullway <- c(mozhga.tour.labels[1], unlist(sapply(way, function(x) {
+     get.vertex.attribute(mozhga.graph, "name", index = x)
+ }))) # Преобразуем номера вершин в названия населённых пунктов и перекрёстков.
> head(fullway) # Выводим начало…
[1] "Ломеслуд"  "_1"        "_2"        "_3"        "Полянское" "_3"
> tail(fullway) # … и конец маршрута.
[1] "_2"       "_1"       "Ломеслуд" "Камышлы"  "Ломеслуд" "Кр. Яр"

Итоговый маршрут обхода (общая протяженность — 568.4 км) представлен на иллюстрации.

R: Формирование матрицы расстояний

Непосредственное измерение расстояний между населенными пунктами для заполнения матрицы расстояний — трудоёмкая задача. В случае развитой дорожной сети:

• сложно определить кратчайший маршрут движения между пунктами;
• велик объём работы (для \(n\) населенных пунктов число измерений составит \(n^2 - n \over 2 \));
• сложно объединить матрицы расстояний нескольких районов.

Представление дорожной сети в виде графа позволяет привлечь соответствующий инструментарий R для облегчения этой работы.

Сформировать матрицу кратчайших расстояний между всеми парами вершин произвольного связного графа можно при помощи функции floyd.warshall.all.pairs.sp из пакета RBGL. В качестве единственного аргумента эта функция принимает объект класса graph, поддерживаемый одноименным пакетом. Оба этих пакета являются частью проекта Bioconductor, с особенностями их установки и использования можно ознакомиться на соответствующих страницах: RBGL и graph.

Виртуальный класс graph объединяет несколько подклассов, отличающихся способом описания графа. Класс graphAM хранит граф в виде матрицы связности его вершин, класс graphBAM — в виде таблицы с описанием его дуг.

Применим перечисленные инструменты на примере представления в виде графа дорожной сети Можгинского района Удмуртской республики — сформируем и сохраним в формате csv таблицу, первый и второй столбец которой соответствуют узлам дорожной сети (населенным пунктам и перекресткам), а третий столбец — протяженности соединяющих их участков дороги с твёрдым покрытием:

"from";"to";"weight"
"Кр. Яр";"Ломеслуд";3,5
"Камышлы";"Ломеслуд";1,75
"_1";"Ломеслуд";4,55
"_1";"_2";1,75
"_3";"_2";1,05
"_3";"Полянское";2,1
"_3";"Бол. Уча";1,4
"Пазял-Зюмья";"Бол. Уча";2,1
…
"Водзя";"Чежесть-Какси";2,8

На карте результат процесса выглядит так:

Всего — 111 дуг, 96 вершин (в т. ч. 21 перекрёсток и 4 населённых пункта не относящихся к Можгинскому району), примерно 3 человеко-часа работы.

Код R, формирующий матрицу расстояний между всеми населёнными пунктами Можгинского района представлен ниже:

> require("graph")
> require("RBGL")
> mozhga <- read.csv("mozhga.csv", sep=";", dec=",")
> mozhga.BAM <- graphBAM(mozhga) # Формируем граф экспериментального класса graphBAM,
> mozhga.AM <- as(mozhga.BAM, "graphAM") # преобразуем его в стабильный класс graphAM,
> mozhga.dist <- floyd.warshall.all.pairs.sp(mozhga.AM) # вычисляем матрицу расстояний
> d <- mozhga.dist[grep("_", colnames(mozhga.dist), invert=T), # и избавляемся от лишних узлов
+                  grep("_", rownames(mozhga.dist), invert=T)] # (предварены символом "_").

Объект d — искомая матрица расстояний между населенными пунктами Можгинского района.

UPD:

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

> require("igraph")
> mozhga.graph <- graph.data.frame(mozhga, directed=FALSE) # Формируем граф,
> mozhga.dist <- shortest.paths(mozhga.graph) # вычисляем матрицу расстояний
> d <- mozhga.dist[grep("_", colnames(mozhga.dist), invert=T), # и избавляемся от лишних узлов
+                  grep("_", rownames(mozhga.dist), invert=T)] # (предварены символом "_").

Картограммы в R: используем OpenStreetMap в качестве фона

При помощи библиотеки OpenStreetMap, R-project может использовать растровые карты проекта OpenStreetMap.

Среди ее зависимостей находятся библиотеки rJava и rgdal. Про установку библиотеки rgdal я писал ранее. Установка библиотеки rJava также требует дополнительных действий — в ее зависимости входит Java JRE и Java JDK. Ubuntu 12.04 precise использует в качестве Java-окружения OpenJDK 6, так что для удовлетворения зависимостей rJava достаточно дополнительно установить пакет openjdk-6-jdk и познакомить с ним R:

$ sudo aptitude install openjdk-6-jdk
$ sudo R CMD javareconf

После такой подготовки системы, библиотека OpenStreetMap успешно устанавливается и мы можем переходить к её использованию. С тем, как получены объекты brks, part и udm.TIK можно познакомиться в предыдущих статьях.

> map <- openmap(c(59, 49), # Широта и долгота северо-западного угла карты.
+                           c(55, 56), # Широта и долгота юго-восточного угла карты.
+                           zoom=7,    # Масштаб карты, можно посмотреть в ее URL:
+ # http://www.openstreetmap.org/#map=7/57.035/53.553 (выделен красным).
+                           type="osm") # Тип скачиваемой карты (tile server). Есть и другие.
> colors <- rev(heat.colors(length(brks), alpha=1/3))
> udm.TIK.osm <- spTransform(udm.TIK, osm()) # Меняем проекцию объекта udm.TIK на используемую
# проектом OpenStreetMap.
> str(map) # Смотрим размеры карты в пикселах (выделены красным):
List of 2
 $ tiles:List of 1
  ..$ :List of 5
  .. ..$ colorData : chr [1:422878] "#F1EEE8" "#F1EEE8" "#F1EEE8" "#F1EEE8" ...
  .. ..$ bbox      :List of 2
  .. .. ..$ p1: num [1:2] 5454655 8180387
  .. .. ..$ p2: num [1:2] 6233891 7361866
  .. ..$ projection:Formal class 'CRS' [package "sp"] with 1 slots
  .. .. .. ..@ projargs: chr "+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0
+x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=@null +no_defs"
  .. ..$ xres      : int 667
  .. ..$ yres      : int 634
  .. ..- attr(*, "class")= chr "osmtile"
 $ bbox :List of 2
  ..$ p1: num [1:2] 5454655 8180387
  ..$ p2: num [1:2] 6233891 7361866
 - attr(*, "zoom")= int 7
 - attr(*, "class")= chr "OpenStreetMap"
> png("ER-osm.png", width=634, height=667, units="px") # Рисуем. Размер может быть любым,
#                            карта будет отмасштабирована с сохранением отношения сторон.
> plot(map)
> plot(udm.TIK.osm, col=colors[findInterval(part, brks, all.inside=T)],
+ border="transparent", add=TRUE)
> legend("left", inset=0.1, legend=leglabs(brks, under="<", over=">"), fill=colors, bty="n")
> title(main="Доля голосов за ЕР\nв муниципальных районах\nи городских округах Удмуртии")
> dev.off()

Буду благодарен за указание способа узнать разрешение растровой карты автоматически.

Решение задачи коммивояжера в R

Для решения задачи коммивояжера в R-project можно использовать пакет TSP:

> library("TSP")
# Заполним матрицу расстояний между городами…
> m <- matrix(c(0,   222, 652, 52,  447, 160, 445, 134, 380, 112, 536, 
+               222, 0,   594, 170, 565, 278, 223, 252, 322, 230, 654,
+               652, 594, 0,   600, 995, 708, 817, 682, 272, 660, 1084,
+               52,  170, 600, 0,   395, 108, 393, 82,  328, 60,  484,
+               447, 565, 995, 395, 0,   503, 340, 313, 723, 455, 519,
+               160, 278, 708, 108, 503, 0,   501, 190, 436, 48,  592,
+               445, 223, 817, 393, 340, 501, 0,   475, 545, 453, 877,
+               134, 252, 682, 82,  313, 190, 475, 0,   410, 142, 402,
+               380, 322, 272, 328, 723, 436, 545, 410, 0,   388, 812,
+               112, 230, 660, 60,  455, 48,  453, 142, 388, 0,   544,
+               536, 654, 1084, 484, 519, 592, 877, 402, 812, 544, 0),
+             nrow=11, byrow=TRUE)
> colnames(m) <- c("Воткинск", "Глазов", "Екатеринбург", "Ижевск", "Казань",
+                  "Камбарка", "Киров", "Можга", "Пермь", "Сарапул", "Уфа")
> rownames(m) <- colnames(m)
> m
             Воткинск Глазов Екатеринбург Ижевск Казань Камбарка Киров Можга Пермь Сарапул  Уфа
Воткинск            0    222          652     52    447      160   445   134   380     112  536
Глазов            222      0          594    170    565      278   223   252   322     230  654
Екатеринбург      652    594            0    600    995      708   817   682   272     660 1084
Ижевск             52    170          600      0    395      108   393    82   328      60  484
Казань            447    565          995    395      0      503   340   313   723     455  519
Камбарка          160    278          708    108    503        0   501   190   436      48  592
Киров             445    223          817    393    340      501     0   475   545     453  877
Можга             134    252          682     82    313      190   475     0   410     142  402
Пермь             380    322          272    328    723      436   545   410     0     388  812
Сарапул           112    230          660     60    455       48   453   142   388       0  544
Уфа               536    654         1084    484    519      592   877   402   812     544    0
# … создадим TSP-объект…
> tsp <- TSP(m)
# … и найдем решение методом "2-opt":
> tour <- solve_TSP(tsp, method="2-opt")
> tour
object of class ‘TOUR’ 
result of method ‘2-opt’ for 11 cities
tour length: 3080
# Получаем замкнутый маршрут, заданный списком городов по порядку обхода.
> labels(tour)
 [1] "Камбарка"     "Сарапул"      "Ижевск"       "Екатеринбург" "Пермь"        "Глазов"      
 [7] "Киров"        "Казань"       "Уфа"          "Можга"        "Воткинск"
> 48+60+600+272+322+223+340+519+402+134+160
[1] 3080

Существует альтернативный способ создания таблицы расстояний, с заполнением только нижней ее половины:

> m <- structure(c(222, 652, 52,  447, 160, 445, 134, 380, 112, 536,
+                  594, 170, 565, 278, 223, 252, 322, 230, 654,
+                  600, 995, 708, 817, 682, 272, 660, 1084,
+                  395, 108, 393, 82,  328, 60,  484,
+                  503, 340, 313, 723, 455, 519,
+                  501, 190, 436, 48,  592,
+                  475, 545, 453, 877,
+                  410, 142, 402,
+                  388, 812,
+                  544), 
+                Labels = c("Воткинск", "Глазов", "Екатеринбург", "Ижевск", "Казань",
+                           "Камбарка", "Киров", "Можга", "Пермь", "Сарапул", "Уфа"), 
+                 Size = 11L, class = "dist", Diag = FALSE, Upper = FALSE)
# Результат:
> m
             Воткинск Глазов Екатеринбург Ижевск Казань Камбарка Киров Можга Пермь Сарапул
Глазов            222                                                                     
Екатеринбург      652    594                                                              
Ижевск             52    170          600                                                 
Казань            447    565          995    395                                          
Камбарка          160    278          708    108    503                                   
Киров             445    223          817    393    340      501                          
Можга             134    252          682     82    313      190   475                    
Пермь             380    322          272    328    723      436   545   410              
Сарапул           112    230          660     60    455       48   453   142   388        
Уфа               536    654         1084    484    519      592   877   402   812     544

Отличий в использовании такой таблицы нет.

Живой журнал

Завёл себе живой журнал. Уже давно — 16 сентября 2012 года.

Картограммы в R: меняем проекцию

Для смены проекции карты в R можно использовать библиотеку rgdal:

> install.packages("rgdal")
> library("rgdal")

В Ubuntu для работы этой библиотеки требуются пакеты libgdal1-dev и libproj-dev с их зависимостями.

Мы можем скачать и прочитать шейп-файл, как указано ранее (это, кстати, существенно быстрее), однако продемонстрирую вариант подключения к открытой базе геоданных PostGIS при помощи того же rgdal:

> # Читаем список доступных слоёв базы GEN…
> ogrListLayers(dsn="PG:host=gis-lab.info user=guest dbname=gen password=guest")
 [1] "modis_tiles"              "oblasts"                  "ru_adm2_country"
 …
[26] "wrs2_landsat_rus"
> # … и загружаем слой границ России в объект rus.
> rus <- readOGR(dsn="PG:host=gis-lab.info user=guest dbname=gen password=guest",
+ layer="ru_adm2_country", verbose=T)

Проект GIS-Lab для отображения Сибирской части России и для отображения России целиком пользуется равновеликой конической проекцией Альберса с главными параллелями 52° и 64° с.ш. и главным меридианом 105° в.д.. Проекция объекта rus —

> proj4string(rus)
[1] "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0"

— что делает его изображение разорванным по 180-му меридиану, в районе Чукотки. Сменим проекцию и нарисуем карту:

> rus2 <- spTransform(rus, CRS("+proj=aea +lat_1=52 +lat_2=64 +lat_0=0 +lon_0=105
+ +x_0=18500000 +y_0=0 +ellps=krass +units=m +towgs84=28,-130,-95,0,0,0,0 +no_defs"))
> plot(rus2, col="#31A35488", border=F)

Чтобы наложить на полученную карту сетку координат, необходимо эту сетку специально подготовить:

> grd <- gridlines(rus,
+ norths = seq(10, 90, by=5), # рисуем линии каждые 5° между 10 и 90° с.ш.
+ # Отобразятся только те из них, которые попадут в область рисуемой карты.
+ easts = seq(-179.9999, 180, by=5), # Если указать -180, этот меридиан не отобразится.
+ ndiscr=360) # Число опорных точек — если указать мало,
> # координатная сетка после перепроецирования может получиться ломаной.
> # Меняем проекцию координатной сетки так же, как у карты…
> grd2 <- spTransform(grd, CRS("+proj=aea +lat_1=52 +lat_2=64 +lat_0=0 +lon_0=105
+ +x_0=18500000 +y_0=0 +ellps=krass +units=m +towgs84=28,-130,-95,0,0,0,0 +no_defs"))
> # … и добавляем её к рисунку.
> plot(grd2, add=T, col="#08519C88", lty=2)

Результат приведен в начале заметки.

Перед сменой проекции мы можем упростить контур объекта rus,

> rus.thiny <- thinnedSpatialPoly(rus,
+ tolerance=0.5, # Интенсивность упрощения, чем больше, тем проще контур.
+ minarea=0.1) # Минимальная площадь сохранямых островов.

объем данных уменьшается очень существенно, но машинное время, затраченное на этот процесс, превышает время на смену проекции и отрисовку исходного объекта вместе взятое. Результат с упрощенным контуром — ниже.