library(ggplot2)
villesOs <- c("Vienne", "Graz", "Linz", "Salzburg", "Innsbruck")
data1 <- as.dist(matrix(nrow = 5, ncol = 5, byrow = TRUE,
                dimnames = list(villesOs, villesOs),
                data = c(0, 138, 144, 207, 306,
                         138, 0, 159, 191, 311,
                         144, 159, 0, 96, 197,
                         207, 191, 96, 0, 129,
                         306, 311, 197,  129, 0)))

data2 <- as.dist(matrix(nrow = 5, ncol = 5, byrow = TRUE,
                        dimnames = list(villesOs, villesOs),
                        data = c(0, 155, 76, 142, 254,
                                 155,0, 182, 239, 339,
                                 76, 182, 0, 64, 176,
                                 142, 239, 64, 0, 108,
                                 254, 339, 176, 108, 0)))

data3 <- as.dist(matrix(nrow = 5, ncol = 5, byrow = TRUE,
                        dimnames = list(villesOs, villesOs),
                        data = c(0, 45, 40, 50, 60,
                                 45, 0, 285, 140, 130,
                                 40, 285, 0, 260, 245,
                                 50, 140, 260, 0, 150,
                                 60, 130, 245, 150, 0)))

Par la route

Données empiriques

print(data1, upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne            138  144      207       306
Graz         138       159      191       311
Linz         144  159            96       197
Salzburg     207  191   96                129
Innsbruck    306  311  197      129          

Estimation

chrono1 <- cmdscale(data1)
round(dist(chrono1, upper = TRUE))
          Vienne Graz Linz Salzburg Innsbruck
Vienne            137  126      205       306
Graz         137       148      188       311
Linz         126  148            80       184
Salzburg     205  188   80                123
Innsbruck    306  311  184      123          

Carte correspondante

df1 <- data.frame(Ville = villesOs,
                  X = chrono1[,1],
                  Y = chrono1[,2])
df1$X <- df1$X * -1 # Symétrie horizontale de la carte pour qu'elle se présente comme la carte topo.
ggplot(df1, aes(X,Y)) +
  geom_point() +
  geom_text(aes(label = Ville), vjust = "inward", hjust = "inward") +
  coord_fixed(ratio = 1)

Erreur (min)

print(round(dist(chrono1) - data1), upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne             -1  -18       -2         0
Graz          -1       -11       -3         0
Linz         -18  -11           -16       -13
Salzburg      -2   -3  -16                 -6
Innsbruck      0    0  -13       -6          

Par le train

Données empiriques

print(data2, upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne            155   76      142       254
Graz         155       182      239       339
Linz          76  182            64       176
Salzburg     142  239   64                108
Innsbruck    254  339  176      108          

Estimation

chrono2 <- cmdscale(data2)
round(dist(chrono2, upper = TRUE))
          Vienne Graz Linz Salzburg Innsbruck
Vienne            155   79      144       254
Graz         155       183      240       339
Linz          79  183            67       177
Salzburg     144  240   67                111
Innsbruck    254  339  177      111          

Carte correspondante

df2 <- data.frame(Ville = villesOs,
                  X = chrono2[,1],
                  Y = chrono2[,2])
df2$X <- df2$X * -1 # Symétrie horizontale
df2$Y <- df2$Y * -1 # Symétrie verticale
ggplot(df2, aes(X,Y)) +
  geom_point() +
  geom_text(aes(label = Ville), vjust = "inward", hjust = "inward") +
  coord_fixed(ratio = 1)

Erreur (min)

print(round(dist(chrono2) - data2), upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne              0    3        2         0
Graz           0         1        1         0
Linz           3    1             3         1
Salzburg       2    1    3                  3
Innsbruck      0    0    1        3          

Par l’avion

Données empiriques

print(data3, upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne             45   40       50        60
Graz          45       285      140       130
Linz          40  285           260       245
Salzburg      50  140  260                150
Innsbruck     60  130  245      150          

Estimation

chrono3 <- cmdscale(data3)
round(dist(chrono3, upper = TRUE))
          Vienne Graz Linz Salzburg Innsbruck
Vienne            132  150      124       106
Graz         132       280      110        64
Linz         150  280           259       240
Salzburg     124  110  259                148
Innsbruck    106   64  240      148          

Carte correspondante

df3 <- data.frame(Ville = villesOs,
                  X = chrono3[,1],
                  Y = chrono3[,2])
df3$X <- df3$X * -1 # Symétrie horizontale
df3$Y <- df3$Y * -1 # Symétrie verticale
ggplot(df3, aes(X,Y)) +
  geom_point() +
  geom_text(aes(label = Ville), vjust = "inward", hjust = "inward") +
  coord_fixed(ratio = 1)

Erreur (min)

print(round(dist(chrono3) - data3), upper = TRUE)
          Vienne Graz Linz Salzburg Innsbruck
Vienne             87  110       74        46
Graz          87        -5      -30       -66
Linz         110   -5            -1        -5
Salzburg      74  -30   -1                 -2
Innsbruck     46  -66   -5       -2          
LS0tCnRpdGxlOiAiQW5hbHlzZSBzcGF0aWFsZSBURDIgLSBDaHJvbm9jYXJ0ZXMiCm91dHB1dDogCiAgaHRtbF9ub3RlYm9vazogCiAgICB0aGVtZTogc3BhY2VsYWIKLS0tCgpgYGB7ciwgY2hhcmdlbWVudCBkZXMgZG9ubsOpZXN9CmxpYnJhcnkoZ2dwbG90MikKdmlsbGVzT3MgPC0gYygiVmllbm5lIiwgIkdyYXoiLCAiTGlueiIsICJTYWx6YnVyZyIsICJJbm5zYnJ1Y2siKQpkYXRhMSA8LSBhcy5kaXN0KG1hdHJpeChucm93ID0gNSwgbmNvbCA9IDUsIGJ5cm93ID0gVFJVRSwKICAgICAgICAgICAgICAgIGRpbW5hbWVzID0gbGlzdCh2aWxsZXNPcywgdmlsbGVzT3MpLAogICAgICAgICAgICAgICAgZGF0YSA9IGMoMCwgMTM4LCAxNDQsIDIwNywgMzA2LAogICAgICAgICAgICAgICAgICAgICAgICAgMTM4LCAwLCAxNTksIDE5MSwgMzExLAogICAgICAgICAgICAgICAgICAgICAgICAgMTQ0LCAxNTksIDAsIDk2LCAxOTcsCiAgICAgICAgICAgICAgICAgICAgICAgICAyMDcsIDE5MSwgOTYsIDAsIDEyOSwKICAgICAgICAgICAgICAgICAgICAgICAgIDMwNiwgMzExLCAxOTcsICAxMjksIDApKSkKCmRhdGEyIDwtIGFzLmRpc3QobWF0cml4KG5yb3cgPSA1LCBuY29sID0gNSwgYnlyb3cgPSBUUlVFLAogICAgICAgICAgICAgICAgICAgICAgICBkaW1uYW1lcyA9IGxpc3QodmlsbGVzT3MsIHZpbGxlc09zKSwKICAgICAgICAgICAgICAgICAgICAgICAgZGF0YSA9IGMoMCwgMTU1LCA3NiwgMTQyLCAyNTQsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDE1NSwwLCAxODIsIDIzOSwgMzM5LAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA3NiwgMTgyLCAwLCA2NCwgMTc2LAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAxNDIsIDIzOSwgNjQsIDAsIDEwOCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMjU0LCAzMzksIDE3NiwgMTA4LCAwKSkpCgpkYXRhMyA8LSBhcy5kaXN0KG1hdHJpeChucm93ID0gNSwgbmNvbCA9IDUsIGJ5cm93ID0gVFJVRSwKICAgICAgICAgICAgICAgICAgICAgICAgZGltbmFtZXMgPSBsaXN0KHZpbGxlc09zLCB2aWxsZXNPcyksCiAgICAgICAgICAgICAgICAgICAgICAgIGRhdGEgPSBjKDAsIDQ1LCA0MCwgNTAsIDYwLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA0NSwgMCwgMjg1LCAxNDAsIDEzMCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgNDAsIDI4NSwgMCwgMjYwLCAyNDUsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDUwLCAxNDAsIDI2MCwgMCwgMTUwLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA2MCwgMTMwLCAyNDUsIDE1MCwgMCkpKQpgYGAKCiMjIFBhciBsYSByb3V0ZQojIyMjRG9ubsOpZXMgZW1waXJpcXVlcwpgYGB7ciBkYXRhMX0KcHJpbnQoZGF0YTEsIHVwcGVyID0gVFJVRSkKYGBgCiMjIyMgRXN0aW1hdGlvbgpgYGB7ciBkaXN0IGRhdGExfQpjaHJvbm8xIDwtIGNtZHNjYWxlKGRhdGExKQpyb3VuZChkaXN0KGNocm9ubzEsIHVwcGVyID0gVFJVRSkpCmBgYAojIyMjQ2FydGUgY29ycmVzcG9uZGFudGUKCmBgYHtyIG1hcCBkYXRhMX0KZGYxIDwtIGRhdGEuZnJhbWUoVmlsbGUgPSB2aWxsZXNPcywKICAgICAgICAgICAgICAgICAgWCA9IGNocm9ubzFbLDFdLAogICAgICAgICAgICAgICAgICBZID0gY2hyb25vMVssMl0pCmRmMSRYIDwtIGRmMSRYICogLTEgIyBTeW3DqXRyaWUgaG9yaXpvbnRhbGUgZGUgbGEgY2FydGUgcG91ciBxdSdlbGxlIHNlIHByw6lzZW50ZSBjb21tZSBsYSBjYXJ0ZSB0b3BvLgpnZ3Bsb3QoZGYxLCBhZXMoWCxZKSkgKwogIGdlb21fcG9pbnQoKSArCiAgZ2VvbV90ZXh0KGFlcyhsYWJlbCA9IFZpbGxlKSwgdmp1c3QgPSAiaW53YXJkIiwgaGp1c3QgPSAiaW53YXJkIikgKwogIGNvb3JkX2ZpeGVkKHJhdGlvID0gMSkKYGBgCiMjIyNFcnJldXIgKG1pbikKYGBge3IgZXJyb3IgZGF0YTF9CnByaW50KHJvdW5kKGRpc3QoY2hyb25vMSkgLSBkYXRhMSksIHVwcGVyID0gVFJVRSkKYGBgCgoKIyMgUGFyIGxlIHRyYWluCiMjIyMgRG9ubsOpZXMgZW1waXJpcXVlcwpgYGB7ciBkYXRhMn0KcHJpbnQoZGF0YTIsIHVwcGVyID0gVFJVRSkKYGBgCiMjIyMgRXN0aW1hdGlvbgpgYGB7ciBkaXN0IGRhdGEyfQpjaHJvbm8yIDwtIGNtZHNjYWxlKGRhdGEyKQpyb3VuZChkaXN0KGNocm9ubzIsIHVwcGVyID0gVFJVRSkpCmBgYAojIyMjIENhcnRlIGNvcnJlc3BvbmRhbnRlCmBgYHtyIG1hcCBkYXRhMn0KZGYyIDwtIGRhdGEuZnJhbWUoVmlsbGUgPSB2aWxsZXNPcywKICAgICAgICAgICAgICAgICAgWCA9IGNocm9ubzJbLDFdLAogICAgICAgICAgICAgICAgICBZID0gY2hyb25vMlssMl0pCmRmMiRYIDwtIGRmMiRYICogLTEgIyBTeW3DqXRyaWUgaG9yaXpvbnRhbGUKZGYyJFkgPC0gZGYyJFkgKiAtMSAjIFN5bcOpdHJpZSB2ZXJ0aWNhbGUKZ2dwbG90KGRmMiwgYWVzKFgsWSkpICsKICBnZW9tX3BvaW50KCkgKwogIGdlb21fdGV4dChhZXMobGFiZWwgPSBWaWxsZSksIHZqdXN0ID0gImlud2FyZCIsIGhqdXN0ID0gImlud2FyZCIpICsKICBjb29yZF9maXhlZChyYXRpbyA9IDEpCmBgYAoKIyMjIyBFcnJldXIgKG1pbikKYGBge3IgZXJyb3IgZGF0YTJ9CnByaW50KHJvdW5kKGRpc3QoY2hyb25vMikgLSBkYXRhMiksIHVwcGVyID0gVFJVRSkKYGBgCgojIyBQYXIgbCdhdmlvbgojIyMjIERvbm7DqWVzIGVtcGlyaXF1ZXMKYGBge3IgZGF0YTN9CnByaW50KGRhdGEzLCB1cHBlciA9IFRSVUUpCmBgYAojIyMjIEVzdGltYXRpb24KYGBge3IgZGlzdCBkYXRhM30KY2hyb25vMyA8LSBjbWRzY2FsZShkYXRhMykKcm91bmQoZGlzdChjaHJvbm8zLCB1cHBlciA9IFRSVUUpKQpgYGAKIyMjIyBDYXJ0ZSBjb3JyZXNwb25kYW50ZQpgYGB7ciBtYXAgZGF0YTN9CmRmMyA8LSBkYXRhLmZyYW1lKFZpbGxlID0gdmlsbGVzT3MsCiAgICAgICAgICAgICAgICAgIFggPSBjaHJvbm8zWywxXSwKICAgICAgICAgICAgICAgICAgWSA9IGNocm9ubzNbLDJdKQpkZjMkWCA8LSBkZjMkWCAqIC0xICMgU3ltw6l0cmllIGhvcml6b250YWxlCmRmMyRZIDwtIGRmMyRZICogLTEgIyBTeW3DqXRyaWUgdmVydGljYWxlCmdncGxvdChkZjMsIGFlcyhYLFkpKSArCiAgZ2VvbV9wb2ludCgpICsKICBnZW9tX3RleHQoYWVzKGxhYmVsID0gVmlsbGUpLCB2anVzdCA9ICJpbndhcmQiLCBoanVzdCA9ICJpbndhcmQiKSArCiAgY29vcmRfZml4ZWQocmF0aW8gPSAxKQpgYGAKCiMjIyMgRXJyZXVyIChtaW4pCmBgYHtyIGVycm9yIGRhdGEzfQpwcmludChyb3VuZChkaXN0KGNocm9ubzMpIC0gZGF0YTMpLCB1cHBlciA9IFRSVUUpCmBgYAoKCg==