博文

几何体修正

 library(sf) library(tidyverse) library(magrittr) `%nin%` = Negate(`%in%`) xz <- st_read("D:\\乡镇边界\\乡镇边界.shp") %>%    select(Name) %>%    st_make_valid() %>%  #几何体修正几何图形   st_write("D:\\乡镇边界\\乡镇边界.geojson") xz %>%    st_make_valid()  xz %>%    st_is_valid() %>%    as_tibble() -> tst xz %>%    filter(na.omit(st_is_valid(xz)) == TRUE) -> xz #过滤冒犯的几何图形(通过基于结果的空间对象的子集) # empty geometries, using any(is.na(st_dimension(x))) # corrupt geometries, using any(is.na(st_is_valid(x))) # invalid geometries, using any(na.omit(st_is_valid(x)) == FALSE); in case of corrupt and/or invalid geometries, # in case of invalid geometries, query the reason for invalidity by st_is_valid(x, reason = TRUE) # you may be succesful in making geometries valid using st_make_valid(x) or, if st_make_valid is not supported by # st_buffer(x, 0.0) on non-corrupt geometries (but beware of the bowtie example above, wh...

overlap及两层地图

 library(sf) library(tidyverse) library(magrittr) `%nin%` = Negate(`%in%`) ts <- st_read("C:\\Users\\ruiying\\Desktop\\甘肃乡镇\\gansu.TAB") %>%    filter(str_detect(地区编码,"^620502") | str_detect(地区编码,"^620503")) %>%   rename(code=地区编码) %>%    filter(row_number() %nin% c(44,45)) # ts %>%  #   st_transform(4326) # ts <- st_read("C:\\Users\\ruiying\\Desktop\\ts.geojson") # bl <- read.csv("C:\\Users\\ruiying\\Desktop\\报告卡2021-11-03(8时).csv") # bl %<>% #   mutate(xiang=str_sub(bl$现住详细地址,10,12)) %>% #   group_by(xiang) %>% #   summarise(n=n()) xiang <- read.csv("C:\\Users\\ruiying\\Desktop\\xiang.csv") %>%   select(-X) ts %>%    left_join(xiang,by=c("NAME"="NAME")) %>%    ggplot() +   geom_sf(aes(fill=n))+   scale_fill_gradientn(breaks = c(2,4,6),                        colors=c("gray"...

purrr

 library(tidyverse) dat = data.frame(y1 = rnorm(10),y2 = rnorm(10)+10) re = list() #1 for(i in 1:2){ #2   re[[i]] = mean(dat[,i]) #3 }  map(dat,mean) map_dbl(dat,mean) map_df(dat,mean) map_df(dat,~mean(.)) iris %>%    split(.$Species) %>%    map(.,~aov(Sepal.Length ~ Sepal.Width,data=.) %>% summary) # aov(Sepal.Length ~ Sepal.Width,data = iris) mtcars %>%    split(.$cyl) %>%    map(.,~lm(mpg~wt+hp+drat,data = .)) %>%    map(coef) %>%    map_df('wt') mtcars %>%    split(.$cyl) %>%    map(.,~lm(mpg~wt+hp+drat,data = .)) %>%    map(coef) %>%    as.data.frame() x <- list(   list(-1, x = 1, y = c(2), z = "a"),   list(-2, x = 4, y = c(5, 6), z = "b"),   list(-3, x = 8, y = c(9, 10, 11)) ) # select by name map_dbl(x,'x') # select by position map_dbl(x,1) # select by name and position map_dbl(x,list('y',1)) wt <- c(5,  5,...

读写geojson和shp文件

 library(sf) library(tidyverse) 读写geojson shi <- st_read("C:\\Users\\ruiying\\Desktop\\shi.geojson") st_write(shi, "C:\\Users\\ruiying\\Desktop\\shi2.geojson",append=F) 读写json weihai <- st_read("D:\\使用GEOJSON数据绘制地图\\威海市.json") st_write(weihai %>% select(name,adcode),"C:\\Users\\ruiying\\Desktop\\weihai.geojson") st_write(meuse_sf,"weihai.shp") st_write(meuse_sf,"weihai.geojson",append = F) st_write(meuse_sf,"weihai.json",driver = 'GeoJSON',append = F) st_write(meuse_sf,"weihai.gpkg",append = F) test <- st_read('C:\\Users\\ruiying\\Desktop\\shi.geojson')

填充地图

 shi %>%    left_join(shi_df,by=c('市代码'='市代码')) %>%    filter(str_detect(市代码,'^62')) %>%    ggplot()+   geom_sf(aes(fill=bl),size=0.01)+   scale_fill_gradientn(breaks = c(15,30,45),                        colors=c("gray", "yellow", "orange", "red"))

R 分层抽样

 library(sampling) mtcars_order <- mtcars %>% arrange(gear) mtcars_order %>% group_by(gear) %>% summarise(n=n()) smn <- round(prop.table(table(mtcars_order$gear))*10) stratID <- strata(mtcars_order,stratanames='gear',size = smn,method = 'srswor') head(stratID) strat<-getdata(mtcars_order,stratID) library(doBy) mtcars %>% group_by(am,gear) %>% summarise(n=n()) mtcars %>% group_by(am) %>% summarise(n=n()) sampleBy(formula = ~ iris$Species,frac=0.1,data=iris) sample_by(mtcars,formula = ~am+gear,frac = 0.2)

分组按量抽样

 df <- data.frame(id = 1:15,                  grp = rep(1:3,each = 5),                   frq = rep(c(3,2,4), each = 5)) set.seed(22) df %>%   group_by(grp) %>%                                 # for every group   summarise(d = list(data.frame(id=id)),            # create a data frame of ids             frq = unique(frq)) %>%                  # get the unique frq value   mutate(v = map2(d, frq, ~sample_n(.x, .y))) %>%   # sample using data frame of ids and frq value   unnest(v) %>%                                     # unnest sampled values   select(-frq)...