次元の海で溺れる

Rとデータ解析と統計手法たちとわたし

【ggmapで遊ぶ②】巡回スープカレー屋問題を解いてみた

二回目の更新です。

さっきの記事の続き!!!wafdata.hatenablog.com

札幌駅周辺のスープカレー屋の情報をスクレイピングしてggmapして、
誰得な食べ歩きルートを作ってやろうというシリーズとなっております。

前回記事ではルートがうまく引けずに、「これって巡回セールスマン問題じゃん~ぶ~」などと供述していましたが、

@berobero11さんに背中を押して頂いたのでやってみます。
(いつも本当にありがとうございます)

参考にさせて頂いた記事はこちら。
祇園祭の山鉾の最適巡回経路 - 驚異のアニヲタ社会復帰への道


ではやります。

まず巡回セールスマン問題ってなにさ

巡回セールスマン問題には
以前から私の聖書とあがめているこのスライドにて出会いました(後半)


いつ見ても泣いちゃう、、

てことでちょっとまとめます。

巡回セールスマン問題(TSP)

端的に言うと、セールスマンが複数のセールス先を最も効率良く回れる経路は??という問いです。
普通に考えても回らなければならない拠点が増えれば増えるほど、想定し得るルートは指数関数的に増えていくので厳密解を求めるのは難しいと言われてまっす。

たとえば今回は6店なので、、(n-1)!/2通り、、60通りかな、、(そんなでもなかった)

TSPは三角等式を満たすという仮定を与えてどーのこーのという小難しい話があったりしますが、私的には三角等式は

(i店からj店への距離)+(j店からk店への距離)≧(i店からk店への距離)

なので、「i店からk店に行こうとしてるのに、途中でj店に寄り道したら遠くなっちゃうよねー」っていう仮定のことだと解釈してます。

いざ巡回スープカレー屋問題

そんでもって、
RではどうやらこのTSPを解く{TSP}なるパッケージがあるとのことで、、

デフォルトで使えるアルゴリズムは以下の通り。一部知らないやつがあった、、

  • nearest_insertion..........最近追加法
  • cheapest_insertion.........最廉挿入法
  • farthest_insertion.........最遠挿入法
  • arbitrary_insertion........(?)
  • nn.........................最近傍法
  • repetitive_nn..............(?)
  • 2-opt......................2近似解法


間違ってたら糾弾してください。

前提のプロットはこれです。

> curry_map
    code_y   code_x
1 43.06401 141.3547
2 43.06757 141.3462
3 43.06761 141.3525
4 43.06672 141.3545
5 43.06827 141.3524
6 43.06596 141.3502

sapporo_center <- geocode("Sapporo Station", source = "google") #札幌駅の位置を取得
sapporo_center

sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
                          zoom = 16, size = c(640, 640), scale = 2,
                          maptype = "roadmap",color = "color",markers=Curry_p)
ggmap::ggmap(sapporo_map)

f:id:WAFkw:20150830162536p:plain


カレー屋さん問題を解きます。

install.packages("TSP")
library(TSP)
> tsp_curry <- TSP(dist(curry_map[, c("code_x", "code_y")]));tsp_curry #TSP関数を適用。準備
object of class ‘TSP’ 
6 cities (distance ‘euclidean’) 

# 使えるメソッドを全て適用したいので、与える用意
>m0 <- c("nearest_insertion", "cheapest_insertion", "farthest_insertion", "arbitrary_insertion", "nn", "repetitive_nn", "2-opt")

#TSP問題はsolve_TSP()で解けるみたい
> tours <- lapply(m0, FUN=function(m) solve_TSP(tsp_curry, method=m));tours #solveTSP()で解く。のをメソッドごとに繰り返し

[[1]]
object of class ‘TOUR’ 
result of method ‘nearest_insertion’ for 6 cities
tour length: 0.02103666 

[[2]]
object of class ‘TOUR’ 
result of method ‘cheapest_insertion’ for 6 cities
tour length: 0.02150029 

[[3]]
object of class ‘TOUR’ 
result of method ‘farthest_insertion’ for 6 cities
tour length: 0.02103666 

[[4]]
object of class ‘TOUR’ 
result of method ‘arbitrary_insertion’ for 6 cities
tour length: 0.02150029 

[[5]]
object of class ‘TOUR’ 
result of method ‘nn’ for 6 cities
tour length: 0.0223355 

[[6]]
object of class ‘TOUR’ 
result of method ‘repetitive_nn’ for 6 cities
tour length: 0.02103666 

[[7]]
object of class ‘TOUR’ 
result of method ‘2-opt’ for 6 cities
tour length: 0.02103666 


#メソッド名が無いとわかんない!!
> names(tours) <- m0 #メソッド名を結果の名前に設定。
> tours
$nearest_insertion
object of class ‘TOUR’ 
result of method ‘nearest_insertion’ for 6 cities
tour length: 0.02103666 

$cheapest_insertion
object of class ‘TOUR’ 
result of method ‘cheapest_insertion’ for 6 cities
tour length: 0.02150029 

$farthest_insertion
object of class ‘TOUR’ 
result of method ‘farthest_insertion’ for 6 cities
tour length: 0.02103666 

$arbitrary_insertion
object of class ‘TOUR’ 
result of method ‘arbitrary_insertion’ for 6 cities
tour length: 0.02150029 

$nn
object of class ‘TOUR’ 
result of method ‘nn’ for 6 cities
tour length: 0.0223355 

$repetitive_nn
object of class ‘TOUR’ 
result of method ‘repetitive_nn’ for 6 cities
tour length: 0.02103666 

$`2-opt`
object of class ‘TOUR’ 
result of method ‘2-opt’ for 6 cities
tour length: 0.02103666 

#結果を見ると、tour_lengthが各ルートの距離(的な)ものを表しているようだ

#tour_lengthの部分だけ抜いてきてattr()で整形
> tour_length <- c(sapply(tours, FUN=attr, "tour_length"));tour_length
  nearest_insertion  cheapest_insertion  farthest_insertion arbitrary_insertion                  nn       repetitive_nn 
         0.02103666          0.02150029          0.02103666          0.02150029          0.02233550          0.02103666 
             2-opt 
         0.02103666 

# 距離をソートして一番小さいものを取ってくる
> minlen <- sort(tour_length)[1];minlen
nearest_insertion 
       0.02103666 

#nearest_insertionで求めた結果が一番最短ルートを選べているもよう。

 #toursリストのメソッドごと繰り返して数値化
> curry_route <- sapply(tours, as.integer);curry_route
     nearest_insertion cheapest_insertion farthest_insertion arbitrary_insertion nn repetitive_nn 2-opt
[1,]                 2                  4                  3                   1  2             5     2
[2,]                 6                  1                  4                   6  6             3     6
[3,]                 1                  6                  1                   2  3             4     1
[4,]                 4                  2                  6                   3  5             1     4
[5,]                 3                  3                  2                   5  4             6     3
[6,]                 5                  5                  5                   4  1             2     5

#店を回る全体の順番の結論!
> root <- c(curry_route[, names(minlen)], curry_route[1, names(minlen)]);root
                                                                                                            nearest_insertion 
                2                 6                 1                 4                 3                 5                 2 


わちゃわちゃしましたが、
2→6→1→4→3→5→2
の順番でお店を回ればよさそうだ!!

単純に考えたら、
2の店→6の店
6の店→1の店、、
と、全部のルートを求めていけば良さそうなので、rootの結果をうまく与えてFor文で回すかなあ、、

しかし6店しかないので
いちいち処理を見たいという願望が芽生えたので、ちまちまやります

#店の順番を入れ替えるなどする。
> curry_map[root, c("code_x", "code_y")]
      code_x   code_y
2   141.3462 43.06757
6   141.3502 43.06596
1   141.3547 43.06401
4   141.3545 43.06672
3   141.3525 43.06761
5   141.3524 43.06827
2.1 141.3462 43.06757

travelmode<-"walking" #カレー屋は歩いて行くに限る

#それぞれの徒歩ルートを求めます

route_1<-route(c(lon[2],lat[2]),c(lon[6],lat[6]),structure="route",mode=travelmode)
route_2<-route(c(lon[6],lat[6]),c(lon[1],lat[1]),structure="route",mode=travelmode)
route_3<-route(c(lon[1],lat[1]),c(lon[4],lat[4]),structure="route",mode=travelmode)
route_4<-route(c(lon[4],lat[4]),c(lon[3],lat[3]),structure="route",mode=travelmode)
route_5<-route(c(lon[3],lat[3]),c(lon[5],lat[5]),structure="route",mode=travelmode)
route_6<-route(c(lon[5],lat[5]),c(lon[2],lat[2]),structure="route",mode=travelmode)

#本来はlon[i],lat[i]みたいな感じで渡していくべきなはず

#route1の中身を見てみる

     m    km     miles seconds   minutes       hours leg      lon      lat
1   48 0.048 0.0298272      35 0.5833333 0.009722222   1 141.3463 43.06795
2   51 0.051 0.0316914      37 0.6166667 0.010277778   2 141.3468 43.06803
3   19 0.019 0.0118066      14 0.2333333 0.003888889   3 141.3470 43.06758
4  119 0.119 0.0739466      86 1.4333333 0.023888889   4 141.3472 43.06757
5  111 0.111 0.0689754      80 1.3333333 0.022222222   5 141.3474 43.06651
6   35 0.035 0.0217490      25 0.4166667 0.006944444   6 141.3487 43.06663
7   58 0.058 0.0360412      42 0.7000000 0.011666667   7 141.3489 43.06636
8  104 0.104 0.0646256      75 1.2500000 0.020833333   8 141.3492 43.06601
9   41 0.041 0.0254774      29 0.4833333 0.008055556   9 141.3505 43.06618
10  NA    NA        NA      NA        NA          NA  NA 141.3506 43.06582

#48m行って~そのあと51m歩いて~みたいな所要時間と共に書いてありますね

#route1を描画

> ggmap(sapporo_map) +
+   geom_path(
+     aes(x=lon,y=lat), colour = 'red', size = 2,
+     data = route_1, lineend = 'round')

f:id:WAFkw:20150830214805p:plain

おお、スタートは左上からかな

(以降、ちまちま足して、ルートが繋がっていくのをいちいち喜びます)

#route2,3を追加
gmap(sapporo_map) +
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_1, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_2, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_3, lineend = 'round')

f:id:WAFkw:20150830214848p:plain


完成!!!

ggmap(sapporo_map) +
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_1, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_2, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_3, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_4, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_5, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_6, lineend = 'round')

f:id:WAFkw:20150830214902p:plain


わーい!!!!つながった!!!!

※通常はいちいち経過を見たりしないで、どうか繰り返し処理をしてください。


超楽しかったー
素晴らしい日曜日。

仕事行きたくない!!!!!!