廿TT

譬如水怙牛過窓櫺 頭角四蹄都過了 因甚麼尾巴過不得

[googleAnalyticsR]調整済みオッズ比の四半期比較プロット

今日の川柳

とりあえず図とコードだけ貼ります。

f:id:abrahamcow:20180301011921p:plain

縦の棒はオッズ比の95%信頼区間です。

library(googleAnalyticsR)
library(tidyverse)
library(lubridate)
#####
ga_auth()
account_list <- ga_account_list()
ga_id <- account_list$viewId[3]

gadata <-
  google_analytics_4(ga_id,
                     date_range = c("2015-12-01","2018-02-28"),
                     metrics = c("sessions","goal3Completions"),
                     dimensions = c("yearMonth","channelGrouping","userType"))

gadata2 <- gadata %>% 
  dplyr::filter(channelGrouping!="(Other)"&channelGrouping!="Email") %>% 
  mutate(channelGrouping=relevel(factor(channelGrouping),"Organic Search")) %>% 
  mutate(date=as.Date(paste0(yearMonth,"01"),format="20%y%m%d")) %>% 
  mutate(Q=round_date(date,"3 months")-months(1)) %>% 
  group_by(Q,channelGrouping,userType) %>% 
  summarise(sessions=sum(sessions),CVs=sum(goal3Completions)) %>% 
  ungroup()

u_Q <-unique(gadata2$Q)

fitlist <-lapply(u_Q, function(q){
  glm(cbind(CVs,sessions-CVs) ~ channelGrouping + userType,
    data=dplyr::filter(gadata2,Q==q),family = "binomial")})

CIdf <-lapply(fitlist, function(x)data.frame(variables=names(x$coefficients),
                                             value=exp(x$coefficients),exp(confint(x)))) %>% 
  bind_rows()
CIdf <- mutate(CIdf,Q=rep(u_Q,each=n_distinct(CIdf$variables)))

p1<-ggplot(CIdf,aes(x=Q,y=value,ymin=X2.5..,ymax=X97.5..))+
  geom_line()+
  geom_pointrange()+
  facet_wrap(~variables,scales = "free_y",nrow = 5)+
  scale_x_date(breaks=u_Q)+
  theme_bw()+
  theme(axis.text = element_text(colour="black"))
print(p1)
ggsave(filename = "~/Desktop/p1.png",p1)