From 915153514afafb99f399a133c03b05a2f5435b57 Mon Sep 17 00:00:00 2001 From: nagbalae Date: Tue, 4 Apr 2023 19:26:25 +0200 Subject: [PATCH] spacial model stuff --- docs/abstract | 1 + mapout.R | 4 ++-- mgvsar.R | 12 ++++++++++++ model.R | 5 +++-- spacialregr.R | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++ tisztitas.R | 3 ++- 6 files changed, 74 insertions(+), 5 deletions(-) create mode 100644 docs/abstract create mode 100644 mgvsar.R diff --git a/docs/abstract b/docs/abstract new file mode 100644 index 0000000..2a3d34a --- /dev/null +++ b/docs/abstract @@ -0,0 +1 @@ +Elemzésemben a budapesti albérletárakat magyarázom a gyakran használt alapvető leíró tulajdonságok, mint például alapterület, szobák száma vagy eerkély mérete, mellett az adott albérlet területi tulajdonságaival. Ilyen elemzett változók a legközelebbi metrótól vonatállomástól esetleg egyéb tömegközlekedési eszköztől vagy bevásárlóközpontól számított távolság, vagy az adott lakás kerülete. Az elemzéshez az Ingatlan.com oldalon található hirdetéseket használom, és azt az Openstreetmap által szolgáltatott adatokkal összeillesztve elemzem. diff --git a/mapout.R b/mapout.R index ccbfcdf..d18b570 100644 --- a/mapout.R +++ b/mapout.R @@ -8,8 +8,8 @@ pal <- colorBin("YlOrRd", domain = df2$ar/df2$ater, bins = bins) leaflet(df2) %>% addTiles() %>% - # addCircleMarkers(~lon,~lat,popup = df2$cim,radius = 10,fillColor = ~pal(ar/ater),fillOpacity = 0.8,stroke = F) %>% - addMarkers(~lon,~lat,popup = df2$cim) %>% + addCircleMarkers(~lon,~lat,popup = df2$cim,radius = 10,fillColor = ~pal(ar/ater),fillOpacity = 0.8,stroke = F) %>% + #addMarkers(~lon,~lat,popup = df2$cim) %>% addLegend(pal = pal, values = df2$ar/df2$ater, title = "Ft/m2/hó", position = "bottomright") %>% addMarkers(metro$lon, metro$lat,popup = metro$name) %>% diff --git a/mgvsar.R b/mgvsar.R new file mode 100644 index 0000000..6d2be17 --- /dev/null +++ b/mgvsar.R @@ -0,0 +1,12 @@ +library(mgwrsar) +colnames(sdf@data) +sdata <- sdf@data +scoord <- sdf@coord +mgwrsarmod <- MGWRSAR(log(ar)~log(ater)+log(eter+1)++log(tomkoz+1)+as.factor(ker),sdata,scoord,kernels=c('gauss'),H=20) +summary_mgwrsar(mgwrsarmod) +plot_mgwrsar(mgwrsarmod,type="B_coef",var='ater') +leaflet(mgwrsarmod) |> + addCircles(lng=mgwrsarmod$data$lon,lat=mgwrsarmod$data$lat,radius = 10,fillColor = mgwrsarmod$residuals + ,weight = 0) |> + addTiles() +colnames(mgwrsarmod$Betav) diff --git a/model.R b/model.R index 0719b5b..e0e5b88 100644 --- a/model.R +++ b/model.R @@ -3,9 +3,10 @@ df3 <- df[df$tipus != "Kiadó szoba",] df3 <- df3[df3$ar <= 400000,] df4 <- df3[,c("ar","ater","szoba","felszoba","ker","metrotav","vonattav")] lmmod <- lm(log(ar)~ater+log(tomkoz+1)+szoba+felszoba+Emelet,df3) +lmmod <- lm(log(ar)~as.factor(ker)+ater+eter+log(tomkoz+1)+szoba+felszoba+Emelet,df3) lmmod <- lm(log(ar)~as.factor(ker)+ater+log(tomkoz+1)+szoba+felszoba+Emelet,df3) -lmmod <- lm(log(ar)~as.factor(ker)+ater+log(tomkoz+1)+szoba+felszoba+Emelet,df3) -lmmod <- lm(log(ar)~as.factor(ker)+log(ater)+log(tomkoz+1)+szoba+felszoba+Emelet,df3) +lmmod <- lm(log(ar)~as.factor(ker)+log(ater)+log(eter)+log(tomkoz+1)+szoba+felszoba+Emelet,df3) +lmmod <- lm(log(ar)~as.factor(ker)+log(ater)+log(eter+1)+log(tomkoz+1)+szoba+felszoba,df3) lmmod <- lm(log(ar/ater)~as.factor(ker)+log(tomkoz+1)+szoba+felszoba+Emelet,df3) lmmod <- lm((ar/ater)~as.factor(ker)+log(tomkoz+1)+szoba+felszoba+Emelet,df3) hist(df4$ar/df4$ater) diff --git a/spacialregr.R b/spacialregr.R index 5b3269b..3cd8cc4 100644 --- a/spacialregr.R +++ b/spacialregr.R @@ -1,2 +1,56 @@ +library(ggplot2) library(sp) sdf <- SpatialPointsDataFrame(df3[,c("lon","lat")],df3) +sdf <- SpatialPointsDataFrame(df3[,c("lon","lat")],df3,proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")) + +plot(sdf) +sdf$m3ar <- sdf$ar/sdf$ater + +library(GWmodel) + +hist(sdf$m3ar) +hist(log(sdf$m3ar)) +quick.map <- function(spdf,var,legend.title,main.title) +{ + x <- spdf@data[,var] + cut.vals <- pretty(x,5) + x.cut <- cut(x,cut.vals) + cut.levels <- levels(x.cut) + cut.band <- match(x.cut,cut.levels) + colors <- brewer.pal(length(cut.levels), "YlOrRd") + colors <- rev(colors) + par(mar=c(1,1,1,1)) + plot(spdf,col=colors[cut.band],pch=16) + title(main.title) + legend("topleft",cut.levels,col=colors,pch=16,bty="n",title=legend.title) +} + +localstat1 <- gwss(sdf,var=c("ar","ater","m3ar"),bw=0.3,quantile=T) +locstat <- bw.gwss.average(sdf,vars=c("ar","ater","m3ar")) +locstat +localstat1 + +library(RColorBrewer) +localstat1$SDF$m3 +quick.map(localstat1$SDF, "m3ar_Median","tut","tit") + +colnames(sdf) +grd <- SpatialGrid(GridTopology(c(18.93,47.39),c(.005,.005),c(80,50))) +grd2 <- c(grd,grd) +grd2 +plot(grd2) +DM <- gw.dist(dp.locat=coordinates(sdf),rp.locat = coordinates(grd)) +DM2 <- gw.dist(dp.locat=coordinates(sdf2),rp.locat = coordinates(grd)) +sdf2 <- sdf[!is.na(sdf$Emelet),] +regrs <- gwr.basic(log(m3ar)~log(ater),sdf,bw=0.02,kernel = "exponential", dMat = DM, regression.points = grd) +regrs <- gwr.basic(log(m3ar)~log(ater)+log(tomkoz+1),sdf,bw=0.02,kernel = "exponential", dMat = DM, regression.points = grd) +regrs <- gwr.basic(log(m3ar)~log(tomkoz+1)+as.factor(Emelet)+as.factor(ker),sdf2,bw=0.30,kernel = "exponential", dMat = DM2, regression.points = grd) +table(sdf$Emelet) +(regrs) +regrs$SDF$as.factor.ker.2 +image(regrs$SDF,'log.tomkoz...1.') #,xlim=c(19.135,19.139),ylim=c(47.45,47.55)) +image(regrs$SDF,'as.factor.ker.10') #,xlim=c(19.135,19.139),ylim=c(47.45,47.55)) +contour(regrs$SDF,'log.tomkoz...1.',add=T) +plot(sdf, add=T, col="blue",alpha=0.1) + +plot(grd) diff --git a/tisztitas.R b/tisztitas.R index 9e67d04..49dcb4b 100644 --- a/tisztitas.R +++ b/tisztitas.R @@ -1,6 +1,8 @@ source("funcs.R") df$ater <-as.numeric(str_split(df$Alapterület, " ",n=2,simplify = T)[,1]) +df$eter <-as.numeric(str_split(df$Erkélymérete, " ",n=2,simplify = T)[,1]) +df$eter[is.na(df$eter)]<- 0 df$ar <- sapply(df$Árhavonta, arconv) df$ker <- as.factor(as.numeric(as.roman(str_remove(str_split(df$cim, " ", simplify = T)[,1],"\\.")))) @@ -10,7 +12,6 @@ df <- df[!is.na(df$point),] df$lat <- as.double(unlist(map(df$point,1))) df$lon <- as.double(unlist(map(df[!is.na(df$point),]$point,2))) - df$szoba <- ifelse(grepl("fél",df$Szobák),as.numeric(unlist(map(str_split(df$Szobák," "),1))),as.numeric(df$Szobák)) df$felszoba <- ifelse(grepl("fél",df$Szobák),as.numeric(unlist(map(str_split(df$Szobák," "),3))),0) # unlist(map(str_split(df$Szobák," "),3))