Annotation analysis

source(here::here("src/common_basis.R"))

Overall

dl <- bind_rows(
    d %>% filter(str_sub(theme,1,1)!='{') %>% mutate(multiple=F),
    d %>% filter(str_sub(theme,1,1)=='{') %>%
        mutate(theme=map(theme,~fromJSON(.) %>% as.data.frame())) %>% 
        unnest(theme) %>% 
        rename(theme=choices)
  ) %>% 
  mutate(ann=TRUE) %>% 
  complete(nesting(annotator_number,name,document_id,media,part,complement,gradation,implicitness),theme,fill=list(ann=FALSE))

New names:New names:

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2")

By stage

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,part,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(part,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_wrap(~part,scales="free")

By media

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_wrap(~media,scales="free",ncol=1)

By stage and media

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,part,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,part,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(media~part,scales="free")

By media and features

By media and presence of gradation

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,gradation,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,gradation,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(media~gradation,scales="free")

By media and presence of implicitness

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,implicitness,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,implicitness,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(media~implicitness,scales="free")

By media and presence of complement

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,complement,theme), relationship="many-to-many") %>%
  filter(theme!="not alcohol policy") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,complement,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(media~complement,scales="free")

By media and theme

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,media,theme), relationship="many-to-many") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,theme,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(theme~media,scales="free")

By theme and features

By theme and presence of gradation

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,gradation,theme), relationship="many-to-many") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(theme,gradation,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(theme~gradation,scales="free")

By theme and presence of implicitness

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,implicitness,theme), relationship="many-to-many") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(theme,implicitness,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(theme~implicitness,scales="free")

By theme and presence of complement

p <- scales::percent_format(accuracy=1)
dl %>% 
  inner_join(dl, join_by(document_id,complement,theme), relationship="many-to-many") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(theme,complement,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  ggplot(aes(x=annotator_number.x,y=annotator_number.y,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
  xlab("Annotator 1") +
  ylab("Annotator 2") +
  facet_grid(theme~complement,scales="free")

Feature, theme and media summary

p <- scales::percent_format(accuracy=1)
dl %>% 
  pivot_longer(complement:implicitness,names_to="feature") %>%
  inner_join(dl %>% 
  pivot_longer(complement:implicitness,names_to="feature"), join_by(document_id,feature,value,theme,media), relationship="many-to-many") %>%
  filter(name.x!=name.y) %>%
  mutate(agree=ann.x==ann.y) %>%
  group_by(media,theme,feature,value,annotator_number.x,annotator_number.y) %>%
  summarise(agree=sum(agree),pagree=sum(agree)/n(),.groups="drop") %>%
  group_by(media,theme,feature,value) %>%
  summarise(agree=mean(agree),pagree=mean(pagree),.groups="drop") %>%
  ggplot(aes(x=media,y=theme,fill=pagree)) +
  geom_raster() +
  theme_hsci(base_family="Arial") +
  scale_fill_viridis_c(labels=scales::percent_format(accuracy=1)) +
  geom_text(aes(label=p(pagree))) +
  labs(fill="Agreement") +
  theme(legend.position = "bottom") +
#  xlab("Annotator 1") +
#  ylab("Annotator 2") +
  facet_grid(feature~value,scales="free")