-
Notifications
You must be signed in to change notification settings - Fork 1
/
ff-landkarte.R
127 lines (108 loc) · 4.76 KB
/
ff-landkarte.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
library("jsonlite")
library("fpc")
library("sp")
library("rgeos")
library("rgdal")
library("maptools")
library("alphahull")
library("igraph")
# Wechsel in das Arbeitsverzeichnis, ggf. anpassen
# setwd("~/Karten/WLAN")
# Projektion für Geodaten
P4S.latlon <- CRS("+proj=longlat +datum=WGS84 +no_defs")
P4S.psmerc <- CRS("+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 +wktext +no_defs
")
P4S.aeqd <- CRS("+proj=aeqd +lat_0=50 +lon_0=10 +x_0=0 +y_0=0")
# JSON-Daten einlesen
data.ffmap <- fromJSON("data.json", flatten=TRUE)
router <- data.ffmap$allTheRouters
router <- transform(router, lat=as.numeric(lat), long=as.numeric(long), clients=as.integer(clients))
# Namen der Communities einkürzen
comms <- data.ffmap$communities
for (i in names(comms)) {
comms[[i]]$name <- gsub("Freifunk ","",comms[[i]]$name)
comms[[i]]$name <- gsub("Freifunk","",comms[[i]]$name)
comms[[i]]$name <- gsub(" e.V.","",comms[[i]]$name)
comms[[i]]$name <- gsub(".freifunk.net","",comms[[i]]$name)
comms[[i]]$meta <- gsub("Freifunk Rheinland e.V. - Domäne Wupper","Wupper",comms[[i]]$meta)
comms[[i]]$meta <- gsub("Freifunk ","",comms[[i]]$meta)
comms[[i]]$meta <- gsub("Freifunk","",comms[[i]]$meta)
comms[[i]]$meta <- gsub(" e.V.","",comms[[i]]$meta)
comms[[i]]$meta <- gsub(" e. V.","",comms[[i]]$meta)
comms[[i]]$meta <- gsub(".freifunk.net","",comms[[i]]$meta)
comms[[i]]$meta <- gsub("Domäne ","",comms[[i]]$meta)
comms[[i]]$meta <- gsub(" Initiative","",comms[[i]]$meta)
}
# Communities ohne 'Metacommunity' bekommen ihren eigenen Namen
for (i in 1:length(router$id)) {
router$comm.name[i] <- comms[router$community[i]][[1]]$name
if (comms[router$community[i]][[1]]$meta != FALSE) {
router$meta[i] <- comms[router$community[i]][[1]]$meta
}
else router$meta[i] <- comms[router$community[i]][[1]]$name
}
# Crop Boundary Box (N40-N60, E0-E20)
router <- router[router$long>0,]
router <- router[router$long<20,]
router <- router[router$lat>40,]
router <- router[router$lat<60,]
# Router-Daten in CSV-Datei schreiben
write.csv(router, file="router.csv")
# Router-Koordinaten als Geodaten formatieren
router.sp <- spTransform(SpatialPointsDataFrame(router[c("long","lat")],data=as.data.frame(router[,c("name","status","clients","meta","community","comm.name")]), proj4string=P4S.latlon), P4S.aeqd)
# Koordinaten-Duplikate entfernen (für alphahull erforderlich)
router.sp <- remove.duplicates(router.sp)
# Clustering (Meta-Communities)
router.sp@data$pre <- 0
for (i in unique(router$meta)) {
ds <- dbscan(
router.sp[router.sp@data$meta==i,]@coords,
eps=1.5e4, MinPts=6, showplot=0
)
pre <- predict(ds, router.sp@data[router.sp@data$meta==i])
router.sp@data[router.sp@data$meta==i,]$pre <- pre
}
# Liste der einzelnen Meta-Cluster
rmeta <- unique(router.sp@data[router.sp@data$pre > 0,][c("meta","pre")])
gch.list <- list()
# Konkave Hüllen um die Cluster berechnen (= Gebiete der Freifunk-Metacommunities)
for (i in 1:dim(rmeta)[1]) {
rdata <- router.sp[router.sp$meta==rmeta$meta[i],][router.sp[router.sp$meta==rmeta$meta[i],]$pre==rmeta$pre[i],]
if (dim(rdata)[1] > 3) {
# calculate concave hull
# gch.as <- ashape(jitter(rdata@coords, 1e-3), alpha=0.20)
gch.as <- ashape(jitter(rdata@coords, 1), alpha=1.5e4)
gch.c <- graph.edgelist(cbind(as.character(gch.as$edges[, "ind1"]), as.character(gch.as$edges[,"ind2"])), directed = FALSE)
# modify the graph to obtain one single circular graph
while (sum(degree(gch.c)==1) > 0) {
gch.c <- delete.vertices(gch.c, degree(gch.c)==1)
}
if ((sum(degree(gch.c)) > 3) != 0) {
gch.c <- delete.vertices(gch.c, degree(gch.c) > 3)
}
if (sum(degree(gch.c) > 2) > 1) {
gch.c <- delete.vertices(gch.c, names(degree(gch.c) > 2)[(degree(gch.c) > 2)][1])
}
if (!is.connected(gch.c)) gch.c <- decompose.graph(gch.c, mode="weak", max.comps=1, min.vertices=3)[[1]]
# delete one edge to open the circular graph
if (sum(degree(gch.c)==1) == 0) gch.g <- gch.c - E(gch.c)[1] else gch.g <- gch.c
# find chain end points
ends <- names(which(degree(gch.g) == 1))
path <- get.shortest.paths(gch.g, ends[1], ends[2])[[1]][[1]]
# this is an index into the points
gch.path <- as.numeric(V(gch.c)[path]$name)
# join the ends
gch.path <- c(gch.path, gch.path[1])
gch.c <- gch.as$x[gch.path,]
gch <- gBuffer(SpatialPolygons(list(Polygons(list(Polygon(gch.c)), ID="1")),proj4string=P4S.aeqd),width=2000)
gch@polygons[[1]]@ID <- rownames(rmeta)[i]
}
else {
gch <- gBuffer(rdata, width=2000)
gch@polygons[[1]]@ID <- rownames(rmeta)[i]
}
gch.list[i] <- spTransform(gch, P4S.latlon)@polygons[[1]]
}
gch.sp <- SpatialPolygons(gch.list, proj4string=P4S.latlon)
gch.df.sp <- SpatialPolygonsDataFrame(gch.sp, data=rmeta)
writePolyShape(gch.df.sp, "gch")