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==