Multidimensionale Skalierung – MDS
Übung: Bayerische Städte
1 MDS durchführen
Ermitteln Sie mit Hilfe einer nichtmetrischen MDS eine zweidimensionale Konfiguration bayerischer Städte. In R macht das die Funktion isoMDS() des Pakets MASS, das Sie installiert haben sollten und einbinden müssen.
Führen Sie dazu die folgenden Schritte durch:
- Erstellen Sie ein leeres Quarto-Dokument und geben Sie ihm die Dateiendung .qmd. Die Datei sollte im Urzustand so aussehen:
Lesen Sie die Daten ein (die Sie auch hier finden); Sie können sie aber auch direkt von ihrem Online-Speicherort einlesen. Kopieren Sie dazu die Adresse des Links. Das Einlesen übernimmt die Funktion
read.csv():bav_cit_data <- read.csv("https://bookdown.org/Armin_E/mds_ex_1/data/bav_cit.csv", row.names = 1, sep=",", dec = ".")Lassen Sie sich zur Kontrolle die Daten ausgeben. Dazu rufen Sie einfach den Namen der Variablen auf, die auf die Daten verweist.
Erstellen Sie den Code für die folgenden Teilaufgaben:
Wandeln Sie die Daten in eine Matrix um. Das machen Sie mit Hilfe der Funktion
as.matrix()folgendermaßen:
ihre_daten_variable <- as.matrix(ihre_daten_variable)Symmetrisieren Sie die Matrix. Der folgende Befehl weist der bestehenden Variablen den Mittelwert aus Matrix und transponierter Matrix zu (das Transponieren übernimmt die Funktion
t()). Geben Sie das Ergebnis aus:
ihre_daten_variable <- (ihre_daten_variable + t(ihre_daten_variable)) / 2Führen Sie die MDS mit Hilfe der Funktion
isoMDS()durch. Erzeugen Sie eine zweidimensionale Lösung.Lassen Sie sich den STRESS-Wert ausgeben:
ihre_mds_ergebnis_variable$stressErzeugen Sie eine Darstellung der Lösung:
plot(mds_result$points, type = "p", main = "Städte in Bayern > 50k",
xlab = "Dimension 1", `ylab = "Dimension 2")
text(mds_result$points, labels = rownames(bav_cit_data),
cex = 0.9, pos = 1, font = 1, col = "black")- [Optional] Spielen Sie mit der Funktion abline(), um die Himmelsrichtungen einzuzeichnen.
Aschaffenburg Augsburg Bamberg Bayreuth Erlangen Fürth Hof
Aschaffenburg 0 322 174 239 175 179 273
Augsburg 324 0 236 238 195 150 290
Bamberg 174 235 0 72 43 56 106
Bayreuth 241 237 72 0 96 102 56
Erlangen 176 195 43 98 0 16 142
Fürth 181 150 56 102 15 0 155
Hof 275 289 106 56 143 156 0
Ingolstadt 281 84 156 159 115 100 211
Kempten 348 104 340 342 299 277 394
Landshut 355 126 230 232 189 186 250
München 356 72 231 233 190 175 285
NeuUlm 273 80 264 266 223 201 318
Nürnberg 189 144 64 84 18 11 136
Passau 402 245 277 279 236 232 297
Regensburg 287 149 162 164 121 117 178
Rosenheim 426 152 301 304 260 245 356
Schweinfurt 137 279 55 119 99 111 154
Würzburg 82 252 97 161 105 110 196
Ingolstadt Kempten Landshut München NeuUlm Nürnberg Passau
Aschaffenburg 280 347 354 355 270 184 400
Augsburg 85 105 124 70 82 143 243
Bamberg 156 340 230 232 264 61 277
Bayreuth 158 342 232 234 266 84 279
Erlangen 116 300 190 192 224 18 237
Fürth 99 277 201 175 201 12 232
Hof 211 395 250 286 318 136 297
Ingolstadt 0 198 106 81 155 93 197
Kempten 199 0 191 127 88 270 310
Landshut 107 192 0 76 197 177 120
München 80 127 72 0 143 168 192
NeuUlm 156 88 195 141 0 194 314
Nürnberg 94 271 176 169 195 0 222
Passau 199 311 121 194 316 223 0
Regensburg 84 245 81 128 220 109 121
Rosenheim 151 193 143 69 223 238 169
Schweinfurt 212 304 282 283 228 116 328
Würzburg 210 277 284 286 201 115 331
Regensburg Rosenheim Schweinfurt Würzburg
Aschaffenburg 286 426 137 81
Augsburg 149 152 279 247
Bamberg 163 302 55 96
Bayreuth 165 304 119 161
Erlangen 123 262 99 99
Fürth 118 245 107 105
Hof 176 357 153 195
Ingolstadt 83 151 207 205
Kempten 245 193 303 272
Landshut 80 146 281 279
München 125 70 282 279
NeuUlm 220 223 228 196
Nürnberg 109 240 115 113
Passau 120 170 328 325
Regensburg 0 198 213 210
Rosenheim 196 0 352 350
Schweinfurt 214 354 0 46
Würzburg 217 356 47 0 Aschaffenburg Augsburg Bamberg Bayreuth Erlangen Fürth Hof
Aschaffenburg 0.0 323.0 174.0 240.0 175.5 180.0 274.0
Augsburg 323.0 0.0 235.5 237.5 195.0 150.0 289.5
Bamberg 174.0 235.5 0.0 72.0 43.0 56.0 106.0
Bayreuth 240.0 237.5 72.0 0.0 97.0 102.0 56.0
Erlangen 175.5 195.0 43.0 97.0 0.0 15.5 142.5
Fürth 180.0 150.0 56.0 102.0 15.5 0.0 155.5
Hof 274.0 289.5 106.0 56.0 142.5 155.5 0.0
Ingolstadt 280.5 84.5 156.0 158.5 115.5 99.5 211.0
Kempten 347.5 104.5 340.0 342.0 299.5 277.0 394.5
Landshut 354.5 125.0 230.0 232.0 189.5 193.5 250.0
München 355.5 71.0 231.5 233.5 191.0 175.0 285.5
NeuUlm 271.5 81.0 264.0 266.0 223.5 201.0 318.0
Nürnberg 186.5 143.5 62.5 84.0 18.0 11.5 136.0
Passau 401.0 244.0 277.0 279.0 236.5 232.0 297.0
Regensburg 286.5 149.0 162.5 164.5 122.0 117.5 177.0
Rosenheim 426.0 152.0 301.5 304.0 261.0 245.0 356.5
Schweinfurt 137.0 279.0 55.0 119.0 99.0 109.0 153.5
Würzburg 81.5 249.5 96.5 161.0 102.0 107.5 195.5
Ingolstadt Kempten Landshut München NeuUlm Nürnberg Passau
Aschaffenburg 280.5 347.5 354.5 355.5 271.5 186.5 401.0
Augsburg 84.5 104.5 125.0 71.0 81.0 143.5 244.0
Bamberg 156.0 340.0 230.0 231.5 264.0 62.5 277.0
Bayreuth 158.5 342.0 232.0 233.5 266.0 84.0 279.0
Erlangen 115.5 299.5 189.5 191.0 223.5 18.0 236.5
Fürth 99.5 277.0 193.5 175.0 201.0 11.5 232.0
Hof 211.0 394.5 250.0 285.5 318.0 136.0 297.0
Ingolstadt 0.0 198.5 106.5 80.5 155.5 93.5 198.0
Kempten 198.5 0.0 191.5 127.0 88.0 270.5 310.5
Landshut 106.5 191.5 0.0 74.0 196.0 176.5 120.5
München 80.5 127.0 74.0 0.0 142.0 168.5 193.0
NeuUlm 155.5 88.0 196.0 142.0 0.0 194.5 315.0
Nürnberg 93.5 270.5 176.5 168.5 194.5 0.0 222.5
Passau 198.0 310.5 120.5 193.0 315.0 222.5 0.0
Regensburg 83.5 245.0 80.5 126.5 220.0 109.0 120.5
Rosenheim 151.0 193.0 144.5 69.5 223.0 239.0 169.5
Schweinfurt 209.5 303.5 281.5 282.5 228.0 115.5 328.0
Würzburg 207.5 274.5 281.5 282.5 198.5 114.0 328.0
Regensburg Rosenheim Schweinfurt Würzburg
Aschaffenburg 286.5 426.0 137.0 81.5
Augsburg 149.0 152.0 279.0 249.5
Bamberg 162.5 301.5 55.0 96.5
Bayreuth 164.5 304.0 119.0 161.0
Erlangen 122.0 261.0 99.0 102.0
Fürth 117.5 245.0 109.0 107.5
Hof 177.0 356.5 153.5 195.5
Ingolstadt 83.5 151.0 209.5 207.5
Kempten 245.0 193.0 303.5 274.5
Landshut 80.5 144.5 281.5 281.5
München 126.5 69.5 282.5 282.5
NeuUlm 220.0 223.0 228.0 198.5
Nürnberg 109.0 239.0 115.5 114.0
Passau 120.5 169.5 328.0 328.0
Regensburg 0.0 197.0 213.5 213.5
Rosenheim 197.0 0.0 353.0 353.0
Schweinfurt 213.5 353.0 0.0 46.5
Würzburg 213.5 353.0 46.5 0.0[1] 4.727519
2 Property Fitting: Längengrade
Kopieren Sie den folgenden Code in Ihre Quarto-Datei und lassen Sie ihn laufen.
longitudes <- c(
9.1500, # Aschaffenburg
10.8978, # Augsburg
10.8900, # Bamberg
11.5775, # Bayreuth
11.0029, # Erlangen
10.9890, # Fürth
11.9136, # Hof
11.4375, # Ingolstadt
10.3153, # Kempten
12.1522, # Landshut
11.5810, # München
10.0000, # Neu-Ulm
11.0767, # Nürnberg
13.4312, # Passau
12.0953, # Regensburg
12.1289, # Rosenheim
10.2216, # Schweinfurt
9.9350 # Würzburg
)
# Erstellen eines Dataframes mit den MDS-Koordinaten und Längengraden
data <- data.frame(MDS1 = mds_result$points[, 1], MDS2 = mds_result$points[, 2], Längengrade = longitudes)
# Durchführung der linearen Regression
regression_model <- lm(Längengrade ~ MDS1 + MDS2, data=data)
# Zusammenfassung des Regressionsmodells anzeigen
summary(regression_model)
Call:
lm(formula = Längengrade ~ MDS1 + MDS2, data = data)
Residuals:
Min 1Q Median 3Q Max
-0.14955 -0.04283 0.01695 0.05098 0.09694
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 11.1553056 0.0169408 658.49 < 2e-16 ***
MDS1 -0.0040168 0.0001443 -27.84 2.5e-14 ***
MDS2 -0.0104501 0.0002077 -50.30 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.07187 on 15 degrees of freedom
Multiple R-squared: 0.9956, Adjusted R-squared: 0.995
F-statistic: 1699 on 2 and 15 DF, p-value: < 2.2e-16# Speichern der Steigung und des Intercepts
b0 <- 0
b1 <- coef(regression_model)[3] / coef(regression_model)[2] # evtl. 2 und 3 vertauschen; ich glaube aber es stimmt so
# Plot der MDS-Koordinaten
plot(mds_result$points, main = "MDS-Lösung mit Regressionsgerade", xlab = "Dimension 1", ylab = "Dimension 2", xlim = xlim, ylim = ylim, asp=1)
text(mds_result$points, labels = rownames(data), pos = 3)
# Hinzufügen der Regressionsgerade
abline(a = b0, b = b1, col = "red", lwd = 2)
steigung <- b1
for (i in 1:nrow(data)) {
# Koordinaten des Datenpunkts
x0 <- data$MDS1[i]
y0 <- data$MDS2[i]
# Berechnung des Lotfußpunkts (x1, y1) auf die Linie y = steigung * x
x1 <- (x0 + steigung * y0) / (1 + steigung^2)
y1 <- steigung * x1
# Zeichnen des Lots
segments(x0, y0, x1, y1, col = "lightgrey", lwd = 2)
# Zeichnen des Lotfußpunkts
points(x1, y1, col = "lightgrey", pch = 19)
}
3 Property Fitting: Breitengrade [optional]
Ermitteln Sie die Breitengrade der Städte und bringen Sie sie in das passende R-Format.
Ändern Sie den R-Code für die Längengrade an den wenigen erforderlichen Stellen ab.
Sie sollten dieses Ergebnis erhalten:
Call:
lm(formula = Breitengrade ~ MDS1 + MDS2, data = data)
Residuals:
Min 1Q Median 3Q Max
-0.14042 -0.04224 0.02269 0.04738 0.08903
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 49.1032500 0.0168650 2911.55 < 2e-16 ***
MDS1 0.0066595 0.0001436 46.37 < 2e-16 ***
MDS2 -0.0023975 0.0002068 -11.59 6.92e-09 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.07155 on 15 degrees of freedom
Multiple R-squared: 0.9934, Adjusted R-squared: 0.9925
F-statistic: 1126 on 2 and 15 DF, p-value: < 2.2e-16
4 Soziale Medien
Ermitteln Sie Ähnlichkeitsdaten zu den verbreitetsten Sozialen Medien. Überführen Sie die Ähnlichkeiten in Distanzen. Führen Sie eine MDS mit diesen Daten durch. Vielleicht können Sie bestimmte – eher objektive Information – für ein Property Fitting verwenden.