成对的功能每行重复N次

2 回答

• 1

  我认为最好使用 sp::SpatialPolygons() .

  library(sp); library(dplyr)
  
  mat <- as.matrix(sample_data)
  

  如果要完全分隔由一行组成的每个多边形，那么每行创建一个类 Polygons 可能是个好主意（ leaflet() 将类 Polygons 视为独立对象） .

  sp <- lapply(1:nrow(mat), function(x) matrix(mat[x,], byrow=T, ncol=2)) %>% 
    sapply(Polygon) %>%          # convert each row into list(matrices) and make list(Polygon)
    mapply(function(x, y) Polygons(list(x), ID = formatC(y, digits=3, flag="000")), x = ., y = 1:length(.)) %>% 
    SpatialPolygons()
  
  sp %>% leaflet() %>% addTiles() %>% addPolygons()
  

  Another approach
  当 c(lng, lat) 是 c(NA, NA) 时，多边形在该点处断开 .

  dat <- cbind(sample_data,NA, NA)
  
  m <- as.matrix(t(dat), byrow=T)
  dim(m) <- c(2,length(m)/2)
  leaflet() %>% addTiles() %>%
    addPolygons(lng=m[1,],lat=m[2,])
  

  

  您只想删除站点之间的多边形，只需使一个类 Polygons 具有一些类 Polygon . （但是如果你创建了类 Polygons par site，它在某些情况下有效） .

  mat2 <- rbind(mat[1:6,], mat[1:6,] + 0.04)  # example data
  
  sp2 <- lapply(1:nrow(mat2), function(x) matrix(mat2[x,], byrow=T, ncol=2)) %>% 
    sapply(Polygon) %>% Polygons(ID = "a") %>% list() %>% SpatialPolygons()
  
  sp2 %>% leaflet() %>% addTiles() %>% addPolygons()
  

  

  [Addition 1: scale]
  当您进行大小（比例）更改时，需要临时移动所有点以将标准点更改为 c(0,0) .

  ## basic idea
  exam <- matrix(c(1:4, 16:19), ncol=2)   # the criterion point (the point you don't want to change) is c(1,16)
  exam_scaled <- ( exam - exam[rep(1,nrow(exam)),] ) * 0.8  + exam[rep(1,nrow(exam)),]
                          # move                   size change      turn back
   ## example data
  mat3 <- as.matrix(sample_data[11:12,])
  
  s <- 0.8     # scale
  
  sp3 <- lapply(1:nrow(mat3), function(x) matrix(mat3[x,], byrow=T, ncol=2)) %>% 
    lapply(function(x) (x - x[rep(1, nrow(x)),]) * s + x[rep(1, nrow(x)),]) %>%    # scale change
    sapply(Polygon) %>%
    mapply(function(x, y) Polygons(list(x), ID = formatCy, digits=3, flag="000")), x = ., y = as.numeric(rownames(mat3))) %>% 
    SpatialPolygons()
  
  sp[10:12] %>% leaflet() %>% addTiles() %>% addPolygons() %>% 
    addPolygons(data = sp3, col = "red")   # 0.8 scale
  

  

  [Addition 2: color]
  我认为使用 SpatialPolygonsDataFrame 是个好主意（这不是必需的，但这种方法可以将所有信息保存在一个对象中） .

  # example data (change positions par 3 polygons)
  mat4 <- as.matrix(sample_data) + matrix(c(rep(0, 54), rep(rep(c(0.08, 0), 9), 3), 
    rep(rep(c(0, -0.06), 9), 3), rep(rep(c(0.08, -0.06), 9), 3)), byrow = T, nrow = 12)
  
  sp4 <- lapply(1:nrow(mat4), function(x) matrix(mat4[x,], byrow=T, ncol=2)) %>%  # the same as above code without data
    sapply(Polygon) %>% 
    mapply(function(x, y) Polygons(list(x), ID = formatC(y, digits=3, flag="000")), x = ., y = 1:length(.)) %>% 
    SpatialPolygons()
  
  df <- data.frame(col = rep(c("red", "green", "blue", "cyan"), each = 3),  # for directl definition
                   factor = as.factor(rep(1:4, each = 3)), numeric = 1:12)  # for fanctional approach
  
  rownames(df) <- getSpPPolygonsIDSlots(sp4)           # change rownames into sp4's ID
  spdf <- SpatialPolygonsDataFrame(sp4, data = df)     # make SpatialPolygonsDataFrame
  spdf@data    # data
  
   # for functional approach
  col_fac <- colorFactor(c("red", "green3", "blue", "cyan"), domain = NULL)
  col_num <- colorNumeric(colorRamp(c("white", "red")), domain = NULL)
  
  spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = spdf@data$col)
           # equivalent to addPolygons(color = rep(c("red", "green", "blue", "cyan"), each = 3))
  spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = col_fac(spdf@data$factor))
      # The slight color difference from the upper code might come from the difference of color name definition between leaflet and R
  spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = col_num(spdf@data$numeric))
  
   # Note: When you use some parts of SpatialPolygonsDataFrame, you need to transform 
   #       it into SpatialPolygons, such as SpatialPolygons(spdf@polygons)[1:4] %>% ...
  

  

  

  回复于 2024-05-14T18:52:08+08:00
• 1

  Hadley的purrr package为您提供了这类机器的机制（同时映射多个阵列），尽管之前的答案可能更适合您的确切应用 . 具体来说，您应该使用所述包中的 map2 函数 .

  回复于 2024-05-14T18:52:08+08:00