exploration.Rmd

---
title: "Exploration"
output: html_document
---

## Housekeeping
```{r}
library(ggplot2)
source("utility.R")
```

## Read in Data Sample
```{r}
day1 <- "Webscope/R6/ydata-fp-td-clicks-v1_0.20090501.gz"
max_lines <- scan(text=system(paste("zcat <", day1, "| wc -l"), intern=TRUE), n=1)

raw_dat <- samplefile(day1, .5)
proc_line(raw_dat, "str_dat")
num_col <- max(count.fields("str_dat", sep=" "))

max_fields <- which(count.fields("str_dat", sep=" ")==max(count.fields("str_dat", sep=" ")))

dat <- read.table("str_dat", sep=" ", fill=TRUE, comment.char="",
                  nrows=length(raw_dat), header=FALSE, col.names=print_header(),
                  colClasses=c("numeric", "factor", "factor", 
                               "numeric", "numeric", "numeric", "numeric", "numeric", "numeric",
                               rep(c("factor", "numeric", "numeric", "numeric",
                                     "numeric", "numeric", "numeric"), 22), "factor", "numeric",
                               "factor", "numeric", "numeric", "numeric", "numeric", "numeric", "numeric"))
names(dat) <- print_header()
```

## Initial Exploration of Conjoint Characteristics

```{r}
summary(dat)
summary(dat$a1_id)
plot(dat[, 4:8])

pc <- princomp(dat[, 4:8])
plot(pc)

pc <- prcomp(dat[, 4:8])
comp <- data.frame(pc$x[,1:4])
plot(comp)
library(rgl)
plot3d(comp$PC1, comp$PC2, comp$PC3)
```

You can also embed plots, for example:

```{r}
library(DBI)
con <- dbConnect(RSQLite::SQLite(), "data/final.db")
res <- dbSendQuery(con, "SELECT * FROM article WHERE articleID=109417")
dbFetch(res)

res <- dbSendQuery(con, "SELECT COUNT(articleID) FROM article")
dbFetch(res)

res <- dbSendQuery(con, "SELECT COUNT(articleID) FROM poolarticle GROUP BY poolID")
dbFetch(res)

res <- dbSendQuery(con, "SELECT datetime, COUNT(datetime) FROM event GROUP BY datetime")
times <- dbFetch(res, n=-1)
names(times) <- c('datetime', 'count')
times$datetime <- as.POSIXct(times$datetime)
ggplot(times, aes(datetime, count)) + geom_line()

res <- dbSendQuery(con, "SELECT datetime, AVG(click) FROM event GROUP BY datetime")
ctr <- dbFetch(res, n=-1)
names(ctr) <- c('datetime', 'ctr')
ctr$datetime <- as.POSIXct(ctr$datetime)
ggplot(ctr, aes(datetime, ctr)) + geom_line()

# articles with best CTRs
res <- dbSendQuery(con, "SELECT articleID, AVG(click) FROM event LEFT JOIN article ON event.displayed=article.articleID GROUP BY articleID ORDER BY AVG(click) DESC")
best_articles <- dbFetch(res, n=-1)

# favorite article by cluster
res <- dbSendQuery(con, "SELECT cluster, articleID, AVG(click) from event LEFT JOIN article ON event.displayed=article.articleID LEFT JOIN user ON event.userID=user.userID GROUP BY cluster")
cluster_favorites <- dbFetch(res, n=-1)

# cluster clickthrough rates
res <- dbSendQuery(con, "SELECT cluster, AVG(click), datetime from event LEFT JOIN user ON event.userID=user.userID GROUP BY cluster, datetime")
ctr_by_cluster <- dbFetch(res, n=-1)
names(ctr_by_cluster) <- c('cluster', 'ctr', 'datetime')
ctr_by_cluster$datetime <- as.POSIXct(ctr_by_cluster$datetime)
ggplot(ctr_by_cluster, aes(x=datetime, y=ctr, colour=cluster)) + geom_line() + stat_smooth(method='loess', formula=y ~ x, size=1)

# best arm per time period
res <- dbSendQuery(con, "SELECT MAX(ctr), datetime, articleID from (SELECT AVG(click) as ctr, datetime, articleID from event LEFT JOIN article ON event.displayed=article.articleID GROUP BY datetime, articleID) GROUP BY datetime")
arm_ctr <- dbFetch(res, n=-1)
names(arm_ctr)[1] <- c('ctr')
arm_ctr$datetime <- as.POSIXct(arm_ctr$datetime)
ggplot(arm_ctr, aes(x=datetime, y=ctr, fill=as.factor(articleID))) + geom_bar(stat='Identity')

# best arm per time period by cluster
res <- dbSendQuery(con, "SELECT MAX(ctr), datetime, articleID, cluster from (SELECT AVG(click) as ctr, datetime, articleID, cluster from event LEFT JOIN article ON event.displayed=article.articleID LEFT JOIN user ON event.userID=user.userID GROUP BY datetime, articleID, cluster) GROUP BY datetime, cluster")
arm_ctr_by_cluster <- dbFetch(res, n=-1)
names(arm_ctr_by_cluster)[1] <- c('ctr')
arm_ctr_by_cluster$datetime <- as.POSIXct(arm_ctr_by_cluster$datetime)
ggplot(arm_ctr_by_cluster, aes(x=datetime, y=ctr, fill=as.factor(articleID))) + geom_bar(stat='Identity') + facet_wrap(~cluster)

# top 5 arms per cluster
top_arms_by_cluster <- data.frame()
for (i in 2:6) {
  res <- dbSendQuery(con, paste("SELECT AVG(click) as ctr, articleID, cluster from event LEFT JOIN article ON event.displayed=article.articleID LEFT JOIN user ON event.userID=user.userID WHERE cluster=", i, "GROUP BY articleID ORDER BY ctr DESC LIMIT 5"))
  top_arms_by_cluster <- rbind(top_arms_by_cluster, dbFetch(res, n=-1))
}
ggplot(top_arms_by_cluster, aes(x=articleID, y=ctr, fill=as.factor(articleID))) + geom_bar(stat='Identity') + facet_wrap(~cluster, ncol=1)

# get ctr for specific article
res <- dbSendQuery(con, 'SELECT AVG(click) FROM event LEFT JOIN user ON event.userID=user.userID WHERE event.displayed=109453 AND user.cluster=2')
dbFetch(res, n=-1)

# clickthrough rates, cluster agnostic
res <- dbSendQuery(con, 'SELECT AVG(click) as ctr, displayed as articleID from event GROUP BY displayed')
ctrs <- dbFetch(res, n=-1)

# ctr by cluster
res <- dbSendQuery(con, 'SELECT AVG(click) as ctr, articleID, cluster from event LEFT JOIN article ON event.displayed=article.articleID LEFT JOIN user ON event.userID=user.userID GROUP BY articleID, cluster')
ctrs_cluster <- dbFetch(res, n=-1)

# max ID
res <- dbSendQuery(con, 'SELECT MAX(eventID) from event')
dbFetch(res)

# Bin Value of Max Feature
# Return the max feature for each user. Histogram bin the occurances
res <- dbSendQuery(con, 'SELECT MAX(feat2, feat3, feat4, feat5, feat6) FROM user GROUP BY userID')
max_feats <- dbFetch(res, n=-1)

dbDisconnect(con)
```

```{r}
library(zoo)
library(data.table)

test_results <- 'results2.gz'
result <- read.table(test_results, sep='\t', header=TRUE)
result$policy <- as.factor(result$policy)
result$reward.avg <- ave(result$reward, result$policy, FUN=function(x) cumsum(x)/seq_along(x))
result$reward.cum <- ave(result$reward, result$policy, FUN=cumsum)
result$regret.cum <- ave(result$regret, result$policy, FUN=cumsum)

result <- as.data.table(result)
result$dummy <- 1
arm_count <- result[, sum(dummy), by=list(policy, arm_pulled)]
names(arm_count)[3] <- "count"

result[, max(T), by=list(policy)]

ggplot(arm_count, aes(as.factor(arm_pulled), count, fill=policy)) + geom_bar(stat="identity") + facet_wrap(~policy)
ggplot(ctrs, aes(as.factor(articleID), ctr)) + geom_bar(stat="identity")

ggplot(result, aes(x=T, y=regret.cum, colour=policy)) + geom_line()
ggplot(result, aes(x=T, y=reward.cum, colour=policy)) + geom_line()
ggplot(result, aes(x=T, y=reward.cum, colour=policy)) + stat_smooth(method='loess', formula=y~x)
ggplot(result, aes(x=T, y=reward.avg, colour=policy)) + geom_line()

# Max features
names(max_feats) <- c('max_feat')
ggplot(max_feats, aes(max_feat)) + geom_histogram() + xlab("Max User Membership Feature")

# linucb
lindat <- read.table('data/linucb_test.gz', header=TRUE)
lindat <- as.data.table(lindat)
lindat[, cumulativeReward:=cumsum(reward), by=policy]
ggplot(lindat, aes(x=T, y=cumulativeReward, colour=policy)) + 
  geom_line() + 
  ggtitle('LinUCB vs. Other Algorithms')
```

# For Export
```{r}
library(DBI)
library(ggplot2)
library(reshape2)
con <- dbConnect(RSQLite::SQLite(), "data/final.db")

# Bin Value of Max Feature
# Return the max feature for each user. Histogram bin the occurances
res <- dbSendQuery(con, 'SELECT MAX(feat2, feat3, feat4, feat5, feat6) FROM user GROUP BY userID')
max_feats <- dbFetch(res, n=-1)
names(max_feats) <- c('max_feat')

pdf(file='figures/max_feats.pdf')
ggplot(max_feats, aes(max_feat)) + 
  geom_histogram(aes(y=(..count..)/sum(..count..)), binwidth=.1) + 
  xlim(c(0, 1)) +
  xlab("feature value") +
  ylab("density") + 
  ggtitle("Maximum User Membership Feature")
dev.off()

# Top arms and ctrs by Cluster
top_arms_by_cluster <- data.frame()
for (i in 2:6) {
  res <- dbSendQuery(con, paste("SELECT AVG(click) as ctr, articleID, cluster from event LEFT JOIN article ON event.displayed=article.articleID LEFT JOIN user ON event.userID=user.userID WHERE cluster=", i, "GROUP BY articleID ORDER BY ctr DESC LIMIT 5"))
  top_arms_by_cluster <- rbind(top_arms_by_cluster, dbFetch(res, n=-1))
}

pdf(file='figures/top_arms.pdf')
ggplot(top_arms_by_cluster, aes(x=as.factor(articleID), y=ctr, fill=as.factor(articleID))) + 
  geom_bar(stat='Identity') + 
  scale_fill_discrete(name='articleID') +
  ylab('CTR') +
  xlab('articleID') +
  ggtitle('Top 5 Articles Per User Cluster') +
  facet_wrap(~cluster, ncol=1)
dev.off()

# CTRs for a couple of articles per day in a facet (109612, 109772)


# Rejection Sampling Unbiasedness... actually, this wouldn't do it
# because rejection sampling SHOULD take the set of samples associated with the policy
# e.g. think of a policy that always picks the same arm -- distributions will not be the same
rej_acc <- read.table('data/acceptreject.gz')
names(rej_acc) <- c('status', 'articleID')
rej_acc$articleID <- as.factor(rej_acc$articleID)
ggplot(rej_acc, aes(articleID)) + geom_histogram() + facet_wrap(~status)


# results
result <- read.table('data/crash.gz', header=TRUE)
result <- as.data.table(result)
result[, cumulativeReward:=cumsum(reward), by=list(policy)]
result_epsilon <- read.table('data/results_epsilon.gz', header=TRUE)
result_epsilon <- as.data.table(result_epsilon)
result_epsilon[, cumulativeReward:=cumsum(reward), by=list(policy)]

# strip out bad epsilon, leave out Indexed, put in good ones (and get rid of redundant)
result <- result[policy != 'EpsilonGreedy(0.1)' & policy != 'EpsilonGreedy(0.2)' & policy != 'IndexedUCB']
result <- rbind(result, result_epsilon[policy == 'EpsilonGreedy(0.1)'])

contextless_ctrs <- result[, max(cumulativeReward)/1000000, by=list(policy)]
setnames(contextless_ctrs, c('policy', 'V1'), c('Policy', 'CTR'))
contextless_ctrs <- contextless_ctrs[order(-CTR)]
contextless_results <- ggplot(result, aes(x=T, y=cumulativeReward, colour=policy)) + geom_line() + ggtitle('Cumulative Clicks Over Time')

# Contextful
result_context <- read.table('data/results_contextual.gz', header=TRUE)
result_context <- as.data.table(result_context)
result_context[, cumulativeReward:=cumsum(reward), by=list(policy)]

contextful_ctrs <- result_context[, max(cumulativeReward)/1000000, by=list(policy)]
setnames(contextful_ctrs, c('policy', 'V1'), c('Policy', 'CTR'))
contextful_ctrs <- contextful_ctrs[order(-CTR)]

contextful_results <- ggplot(result_context, aes(x=T, y=cumulativeReward, colour=policy)) + geom_line() + ggtitle('Cumulative Clicks Over Time')

# Percent of arms pulled correctly
## clickthrough rates, cluster agnostic
res <- dbSendQuery(con, 'SELECT AVG(click) as ctr, displayed as articleID from event GROUP BY displayed')
ctrs <- dbFetch(res, n=-1)
ctrs <- as.data.table(ctrs)
ctrs[, articleRank:=rank(-ctr, ties.method='first')]
ctrs <- ctrs[order(articleRank)]
ctrs[, UCB:=sum(result$policy=='UCB' & result$arm_pulled==articleID), by=articleID]
ctrs[, KLUCB:=sum(result$policy=='KL-UCB' & result$arm_pulled==articleID), by=articleID]
ctrs[, Thompson:=sum(result$policy=='Thompson' & result$arm_pulled==articleID), by=articleID]
ctrs[, Epsilon:=sum(result$policy=='EpsilonGreedy(0.1)' & result_epsilon$arm_pulled==articleID), by=articleID]

ctrs_policies <- melt(ctrs, id.vars=c('ctr', 'articleID', 'articleRank'), variable.name='policy')
chosen_top100_chart <- ggplot(ctrs_policies[articleRank < 100,], aes(articleRank, value)) + geom_bar(stat='identity') + facet_wrap(~policy) + ylab('times pulled') + ggtitle("Times Article Chosen vs. Article Rank (Top 100)")
chosen_all_chart <- ggplot(ctrs_policies, aes(articleRank, value)) + geom_bar(stat='identity') + facet_wrap(~policy) + ylab('times pulled') + ggtitle("Times Article Chosen vs. Article Rank")

## clickthrough rate, cluster sensitive
result_cst <- read.table('data/results_contextual2.gz', header=TRUE)
result_cst <- as.data.table(result_cst)

cst_res <- dbSendQuery(con, 'SELECT AVG(click) as ctr, cluster, displayed as articleID from event LEFT JOIN user on event.userID=user.userID GROUP BY displayed, cluster')
cst_ctrs <- dbFetch(cst_res, n=-1)
cst_ctrs <- as.data.table(cst_ctrs)
cst_ctrs[, articleRank:=rank(-ctr, ties.method='first'), by=cluster]
cst_ctrs <- cst_ctrs[order(cluster, articleRank)]
cst_ctrs[, IndexedUCB:=sum(result_cst$policy=='IndexedUCB' & result_cst$arm_pulled==articleID & result_cst$context==cluster), by=list(articleID, cluster)]
cst_ctrs[, ContextualThompson:=sum(result_cst$policy=='ContextualThompson' & result_cst$arm_pulled==articleID & result_cst$context==cluster), by=list(articleID, cluster)]

cst_policies <- melt(cst_ctrs, id.vars=c('ctr', 'articleID', 'articleRank', 'cluster'), variable.name='policy')
cst_top_chart <- ggplot(cst_policies[policy != 'LinUCB (Scaled)'], aes(articleRank, value)) + geom_bar(stat='identity') + facet_grid(policy~cluster) + ggtitle("Times Article Chosen vs. Article Rank (By Cluster)") + ylab('times pulled')

# LinUCB
lin_res <- dbSendQuery(con, paste('SELECT AVG(click) as ctr, cluster, displayed as articleID from event LEFT JOIN user on event.userID=user.userID WHERE displayed in (', paste(levels(as.factor(lindat$arm_pulled)), collapse=', '), ') GROUP BY displayed, cluster'))
lin_ctrs <- dbFetch(lin_res, n=-1)
lin_ctrs <- as.data.table(lin_ctrs)
lin_ctrs[, articleRank:=rank(-ctr, ties.method='first'), by=cluster]
lin_ctrs <- lin_ctrs[order(cluster, articleRank)]
lin_ctrs[, LinUCB:=sum(lindat$policy=='LinUCB' & lindat$arm_pulled==articleID & lindat$context==cluster), by=list(articleID, cluster)]

lin_top_chart <- ggplot(lin_ctrs, aes(articleRank, LinUCB)) + geom_bar(stat='identity') + facet_grid(~cluster) + ggtitle("Times Article Chosen vs. Article Rank (By Cluster)") + ylab('times pulled')

# LinUCB ctrs
linCTR <- lindat[, sum(reward), by=policy][policy=='LinUCB']
setnames(linCTR, c('policy', 'V1'), c('Policy', 'CTR'))
linCTR$CTR <- linCTR$CTR / 10000
rbind(all_ctrs, linCTR)[order(-CTR)]
```