单位数用户数扫码数

#Sys.setenv(NLS_LANG="AMERICAN_AMERICA.ZHS16GBK")
Sys.setenv(NLS_LANG="AMERICAN_AMERICA.UTF8")
library(ROracle)
library(tidyverse)
library(dbplyr)
library(knitr)
library(magrittr)
library(lubridate)
library(janitor)

drv <- dbDriver("Oracle")
connect.string <- paste(
  "(DESCRIPTION=",
  "(ADDRESS=(PROTOCOL=tcp)(HOST=192.168.30.12)(PORT=1521))",
  "(CONNECT_DATA=(SERVICE_NAME=JZDB1)))", sep = "")
con <- dbConnect(drv, username = "", password = "",
                 dbname = connect.string)

dqmc <- con %>%
  tbl(in_schema('ipvsdb','SYS_XZQH_ZZJG')) %>%
  select(DZMC,DZBM) %>%
  filter(str_length(DZBM)==4) %>%
  collect() %>%
  clean_names() %>%
  remove_empty(c("rows", "cols"))

#单位数
sqltxt <- "select * from sys_org"
tmp <- tbl(con,sql(sqltxt)) %>%
  collect() %>%
  clean_names() %>%
  remove_empty(c("rows", "cols")) %>%
  filter(jlzt=='1')

ggplot(tmp,aes(yyjb,fill=yyjb))+
  geom_bar(stat="count",width=0.5,fill = "cornflowerblue")+
  geom_text(stat='count',aes(label=..count..), vjust=0,size=3.5)+
  labs(x="",y="单位数量",title = "单位数")+
  scale_x_discrete("级别", labels = c("1" = "省级","2" = "市级",
                                     "3" = "县级","4" = "乡级","5" = "村级"))+
  theme_classic()+
  annotate("text", x= 3, y=20,label="单位总数:11595",vjust=-40)+
  theme(legend.position = "none")
 
#用户数
sqltxt <- "select * from sys_user"
tmp <- tbl(con,sql(sqltxt)) %>%
  collect() %>%
  clean_names() %>%
  remove_empty(c("rows", "cols")) %>%
  filter(jlzt=='1') %>%
  mutate(jb=case_when(
    str_detect(jgbm,'00000000$')~'省级',
    str_detect(jgbm,'000000$')~'市级',
    str_detect(jgbm,'0000$')~'县级',
    str_detect(jgbm,'01$')~'乡级'
    )) %>%
  #缺失值替换
  mutate(jb=fct_explicit_na(jb, na_level = "村级")) %>%
  mutate(jb=factor(jb,levels = c("省级","市级","县级","乡级","村级")))

ggplot(tmp,aes(jb,fill=jb))+
  geom_bar(stat="count",width=0.5)+
  geom_text(stat='count',aes(label=..count..), vjust=0,size=3.5)+
  labs(x='级别',y='用户数量',title = '用户数')+
  theme_classic()+
  annotate("text", x= 3, y=20,label="用户总数:32705",vjust=-40)+
  theme(legend.position = "none")

#扫码接种率
sqltxt <- "select dzjgm,jz_sj,xt_djsj,xt_djjgdm,sfmf from inoc_jzjl
where xt_djsj >= '2018-07-01'"
jzjl <- tbl(con,sql(sqltxt)) %>%
  collect() %>%
  clean_names() %>%
  remove_empty(c("rows", "cols")) %>%
  mutate(jzsj=ymd(str_sub(as.character(jz_sj),1,10)),
         djsj= ymd(str_sub(xt_djsj,1,10)),
         year=str_sub(xt_djsj,1,4),
         sm=if_else(is.na(dzjgm),'no','yes')) %>%
  mutate(js= as.numeric(round(djsj-jzsj,0))) %>%
  mutate(jishi=case_when(js==0~'yes',js!=0~'no')) %>%
  mutate(shi=str_sub(xt_djjgdm,1,4)) %>%
  filter(str_detect(shi,"^62")) %>%
  left_join(dqmc,by=c('shi'='dzbm'))

#测试
sml2 <- jzjl %>%
  group_by(year) %>%
  count(sm,sfmf) %>%
  drop_na(sfmf) %>%
  spread(sm,n) %>%
  ungroup() %>%
  adorn_percentages("row") %>%
  adorn_pct_formatting() %>%
  adorn_ns(position = "front")

#分年
sml <- jzjl %>%
  group_by(year) %>%
  count(sm,sfmf) %>%
  drop_na(sfmf) %>%
  spread(sm,n) %>%
  ungroup() %>%
  mutate(prop=round((.$yes/(.$no+.$yes)*100),2),count=.$no+.$yes)

ggplot(sml,aes(year,prop,fill=sfmf))+
  geom_bar(stat = "identity",position=position_dodge(width = 1))+
  geom_text(aes(label = count), colour = "black",
            position = position_dodge(0.9),vjust = 0)+
  geom_text(aes(label = prop), colour = "black",
            position = position_dodge(0.9),vjust = 2)+
  theme_classic()+
  labs(fill = "疫苗类别")+
  theme(legend.title = element_blank())
 
#分地区
sml <- jzjl %>%
  filter(year=='2019')%>%
  group_by(dzmc) %>%
  count(sm,sfmf) %>%
  drop_na(sfmf) %>%
  spread(sm,n) %>%
  ungroup() %>%
  mutate(prop=round((.$yes/(.$no+.$yes)*100),2),count=.$no+.$yes) %>%
  drop_na(dzmc) %>%
  mutate(dzmc=factor(dzmc,levels=dqmc$dzmc))

ggplot(sml,aes(dzmc,prop,fill=sfmf))+
  geom_bar(stat = "identity",position=position_dodge(width = 1))+
  # geom_text(aes(label = prop), colour = "black",
  #           position = position_dodge(0.9),vjust = 2)+
  theme_classic()+
  labs(x='地区',y='扫码率',fill = "疫苗类别",title = '扫码接种率')+
  #旋转
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

评论

此博客中的热门博文

V2ray websocket(ws)+tls+nginx分流

Rstudio 使用代理