R/building_height.R

In lunliu454/streetchar:

#'Calculate building height
#'@description
#'Calculates the height of buildings on two sides of streets with two options available.
#'It performs geometric translation to the lines ("street") by distance k, and defines polygons ("buildings") that intersect with the lines as building alongside streets.

#'@usage
#'Building_height(building, street, option = ("fixed", "street"), k = )
#'
#'@param building 	A Simple Feature containing the building footprints of a city
#'@param street 	A Simple Feature containing the street network of a city.
#'@param option Defines the method by which building height is calculated.
#'If option = "fixed", k should be defined by the user (default = 40 meters).
#'If option = "street", k equals to the width of street on each side.
#'@param k Defines the distance from streets. Buildings within which area will be considered as buildings alongside streets.
#'@details
#'Calculate building height with two options available.
#'It returns the summary statistics (max, min, average, weighted average, standard deviation) of building area alongside every street to the Simple Feature "street". If the calculation is performed in option "street", the width of street should first be calculated
#'If the translation lines of streets and the polygons ("building") does not have intersection, it will return NA.
#' @examples
#'## Not run:
#'building <-data(building)
#'street<-data(street)
#'building_height (building, street, option = "fixed", k = 40)

#'building <-data(building)
#'street<-data(street)
#'building_height (building, street, option = "street", k = 40)
#'## End(Not run)
building_height <- function(city,road,option,k){

  library(rgdal)
  library(devtools)
  library(sf)
  library(dplyr)
  library(maptools)
  library(stplanr)
  library(geosphere)
  library(rgeos)

  #格式转换
  road2<- st_as_sf(road)
  city2 <- st_as_sf(city)
  city2$id<-1:nrow(city2)
  city2 <- st_transform(city2,3857)
  city2 <- st_buffer(city2,0)
  road2<- st_transform(road2,3857)

  height_mean <- character (nrow(road))
  height_weighted.mean <- character (nrow(road))
  height_median <- character (nrow(road))
  height_min <- character (nrow(road))
  height_max <- character (nrow(road))
  height_sd <- character (nrow(road))

  if (option == "street"){
    k_left <- road$widthLeft
    k_right <- road$widthRight
    for (i in (1:length(road))){
      road_i <- road2[i,]
      roadbuffer1 <- st_buffer(road_i,k_left[i],endCapStyle = "FLAT",singleSide=T)
      roadbuffer2 <- st_buffer(road_i,k_right[i],endCapStyle = "FLAT",singleSide=T)
      roadbuffer <- rbind(roadbuffer1,roadbuffer2)
      roadbuffer <- st_cast(roadbuffer,"LINESTRING")

      #和建筑交集并算长???
      intersect <- st_intersection(roadbuffer,city2)
      if (nrow(intersect) == 0) {
        num_mean[i] <- NA
        num_weighted.mean[i] <- NA
        num_median[i] <- NA
        num_min[i] <- NA
        num_max[i] <- NA
        num_sd[i] <- NA
      }else{
        intersect$length <- st_length(intersect) %>% as.numeric

        #计算指标
        height_mean[i] <- mean(intersect$floors)
        height_weighted.mean[i] <- weighted.mean(intersect$floors,intersect$length)
        height_median[i] <- median(intersect$floors)
        height_min[i] <- min(intersect$floors)
        height_max[i] <- max(intersect$floors)
        height_sd[i] <- sd(intersect$floors)
      }
    }
  }

  if (option == "fixed"){
    if (k == 0 | is.na(k)) {
      k = 40
    }
    for (i in (1:length(road))){
      road_i <- road2[i,]
      roadbuffer <- st_buffer(road_i,k)
      roadbuffer <- st_cast(roadbuffer,"LINESTRING")

      #和建筑交集并算长???
      intersect <- st_intersection(roadbuffer,city2)
      if (nrow(intersect) == 0) {
        num_mean[i] <- NA
        num_weighted.mean[i] <- NA
        num_median[i] <- NA
        num_min[i] <- NA
        num_max[i] <- NA
        num_sd[i] <- NA
      }else{
        intersect$length <- st_length(intersect) %>% as.numeric

        #计算指标
        height_mean[i] <- mean(intersect$floors)
        height_weighted.mean[i] <- weighted.mean(intersect$floors,intersect$length)
        height_median[i] <- median(intersect$floors)
        height_min[i] <- min(intersect$floors)
        height_max[i] <- max(intersect$floors)
        height_sd[i] <- sd(intersect$floors)
      }
    }
  }

  road$height_mean <- height_mean
  road$height_mean <- height_weighted.mean
  road$height_median <- height_median
  road$height_min <- height_min
  road$height_max <- height_max
  road$height_sd <- height_sd
}