comparison sampling/sampling.Rmd @ 0:205974c9568c tip

Initial commit. Predictions not included for lack of space.

+---
+title: "Sampling (Amendment 7/3/2018)"
+output: html_notebook
+---
+
+```{r initialisation}
+library(tidyverse)
+if(!require("RSQLite")){
+  install.packages("RSQLite")
+  library("RSQLite")
+}
+
+source('../db/access_db.R')
+source('../sampling/strategies.R')
+```
+
+## Examples
+
+```{r param_simul}
+num_simul <- 10000
+num_folds <- 4
+seed <- 1986
+```
+
+```{r get_info}
+
+get_info_list <- function(samples_list){
+  
+  aux <- numeric(length(samples_list))
+  df <- 
+    data.frame(ex_tr = aux, ar_tr = aux,
+               ex_te_orig = aux, ar_te_orig = aux,
+               ex_te_filt = aux, ar_te_filt = aux)
+  
+  for (i in 1:length(samples_list)){
+    df[i,] <- get_info(samples_list[[i]])
+  }
+  
+  df
+  
+}
+
+get_info <- function(samples){
+  
+  ar_tr <- 
+    get_artists(samples$train, unique_artist = T)
+  ex_filt <- 
+    filter_excerpts(samples$test, ar_tr)
+  
+  data.frame(
+    ex_tr = length(samples$train),
+    ar_tr = length(ar_tr),
+    ex_te_orig = length(samples$test),
+    ar_te_orig = length(get_artists(samples$test, unique_artists = T)),
+    ex_te_filt = length(ex_filt),
+    ar_te_filt = length(get_artists(ex_filt, unique_artist = T))
+  )
+
+}
+
+```
+
+```{r bs_no_strat, eval = F}
+set.seed(seed)
+max_iter <- num_simul
+
+bs_no_strat <- get_samples('bs', iter = max_iter)
+```
+```{r bs_no_strat_info, eval = F}
+bs_no_strat_info <- get_info_list(bs_no_strat)
+summary(bs_no_strat_info)
+```
+
+
+```{r cv_example, eval = F}
+
+set.seed(seed)
+
+max_iter <- num_simul / num_folds
+cv_no_strat <- vector("list", max_iter)
+for (i in 1:max_iter){
+  cv_no_strat[[i]] <- get_samples('cv', iter = num_folds)
+}
+
+cv_no_strat <- unlist(cv_no_strat, recursive = F)
+```
+```{r cv_no_strat_info, eval = F}
+cv_no_strat_info <- get_info_list(cv_no_strat)
+summary(cv_no_strat_info)
+```
+
+
+```{r compare_no_strat, eval = F}
+bs_no_strat_info_plot <- 
+  bs_no_strat_info %>%
+  melt %>%
+  mutate(mode = 'bs')
+cv_no_strat_info_plot <-
+  cv_no_strat_info %>%
+  melt %>%
+  mutate(mode = 'cv')
+
+info_no_strat_plot <- rbind(bs_no_strat_info_plot, cv_no_strat_info_plot) %>%
+  select(mode, variable, value)
+names(info_no_strat_plot) <- c("mode", "set", "num")
+```
+
+```{r plot_ex_no_strat}
+
+info_no_strat_plot_ex <- info_no_strat_plot %>%
+  filter(grepl('ex', set)) %>%
+  filter(!grepl('tr', set))
+ggplot(info_no_strat_plot_ex, 
+       aes(x = num, y = ..count.., color = mode, linetype = set)) +
+  geom_density() +
+  scale_linetype_manual(values=c("twodash", "dotted")) +
+  xlim(0, 500)
+
+ggplot(info_no_strat_plot_ex, 
+       aes(mode, num, color = set)) +
+  geom_boxplot() +
+  ylim(0, 500)
+
+```
+
+```{r plot_ar_no_strat}
+
+info_no_strat_plot_ar <- info_no_strat_plot %>%
+  filter(grepl('ar', set))
+
+ggplot(info_no_strat_plot_ar, 
+       aes(x = num, y = ..count.., color = mode, linetype = set)) +
+  geom_density() +
+  scale_linetype_manual(values = c("solid", "twodash", "dotted")) +
+  xlim(0, 500)
+
+ggplot(info_no_strat_plot_ar, 
+       aes(mode, num, color = set)) +
+  geom_boxplot() +
+  ylim(0, 500)
+```
+
+```{r bs_strat, eval = F}
+set.seed(seed)
+max_iter <- num_simul
+
+bs_strat <- 
+  get_samples('bs', iter = max_iter, stratified = T)
+```
+```{r bs_strat_info, eval = F}
+bs_strat_info <- get_info_list(bs_strat)
+summary(bs_strat_info)
+```
+
+
+```{r cv_strat, eval = F}
+set.seed(seed)
+
+max_iter <- num_simul / num_folds
+cv_strat <- vector("list", max_iter)
+for (i in 1:max_iter){
+  cv_strat[[i]] <- 
+    get_samples('cv', iter = num_folds, stratified =  T)
+}
+cv_strat <- unlist(cv_strat, recursive = F)
+```
+```{r cv_strat_info}
+cv_strat_info <- get_info_list(cv_strat)
+summary(cv_strat_info)
+```
+
+```{r compare_strat}
+bs_strat_info_plot <- 
+  bs_strat_info %>%
+  melt %>%
+  mutate(mode = 'bs')
+cv_strat_info_plot <-
+  cv_strat_info %>%
+  melt %>%
+  mutate(mode = 'cv')
+
+info_strat_plot <- rbind(bs_strat_info_plot, cv_strat_info_plot) %>%
+  select(mode, variable, value)
+names(info_strat_plot) <- c("mode", "set", "num")
+```
+
+```{r plot_ex_strat}
+
+info_strat_plot_ex <- info_strat_plot %>%
+  filter(grepl('ex', set)) %>%
+  filter(!grepl('tr', set))
+
+ggplot(info_strat_plot_ex, 
+       aes(mode, num, color = set)) +
+  geom_boxplot() +
+  ylim(0, 500)
+
+```
+
+```{r plot_ar_strat}
+
+info_strat_plot_ar <- info_strat_plot %>%
+  filter(grepl('ar', set))
+
+ggplot(info_strat_plot_ar, 
+       aes(x = num, y = ..count.., color = mode, linetype = set)) +
+  geom_density() +
+  scale_linetype_manual(values = c("solid", "twodash", "dotted")) +
+  xlim(0, 500)
+
+ggplot(info_strat_plot_ar, 
+       aes(mode, num, color = set)) +
+  geom_boxplot() +
+  ylim(0, 500)
+```
+
+
+
+
+
+## Full Sets
+
+```{r create_sets, eval = F}
+create_set_df <- function(a_list, num_sets = NULL, set = 'train'){
+  
+  if(is.null(num_sets)) num_sets <- length(a_list)
+  mode <- deparse(substitute(a_list))
+  
+  df <- data.frame(stringsAsFactors = F)
+  
+  for (i  in 1:num_sets){
+    df <- rbind(df,
+                data.frame(
+                  mode = mode,
+                  iteration = i,
+                  ex_id = a_list[[i]][[set]],
+                  stringsAsFactors = F
+                  )
+    )
+  }
+  
+  df %>%
+    separate(mode, c("mode", "strat"),
+             remove = T, extra = "drop") %>%
+    mutate(strat = !(strat == 'no')) %>%
+    select(mode, strat, iteration, ex_id)
+  
+}
+```
+
+```{r train_sets}
+train_sets <- rbind(
+  create_set_df(cv_no_strat, num_sets = NULL, set = 'train'),
+  create_set_df(bs_no_strat, num_sets = NULL, set = 'train'),
+  create_set_df(cv_strat, num_sets = NULL, set = 'train'),
+  create_set_df(bs_strat, num_sets = NULL, set = 'train')
+)
+```
+
+```{r test_sets}
+test_sets <- rbind(
+  create_set_df(cv_no_strat, num_sets = NULL, set = 'test'),
+  create_set_df(bs_no_strat, num_sets = NULL, set = 'test'),
+  create_set_df(cv_strat, num_sets = NULL, set = 'test'),
+  create_set_df(bs_strat, num_sets = NULL, set = 'test')
+)
+```
+
+
+```{r get_train_artists}
+train_sets_artists <- train_sets %>%
+  inner_join(get_excerpts_artists(), by = c('ex_id')) %>%
+  group_by(mode, strat, iteration) %>%
+  select(mode, strat, iteration, artist_id) %>%
+  unique() %>%
+  ungroup()
+```
+
+```{r get_test_artists}
+test_sets_artists <- test_sets %>%
+  inner_join(get_excerpts_artists(), by = c('ex_id')) %>%
+  ungroup()
+```
+
+```{r filter_test_sets}
+
+filt_test_sets <- data.frame(stringsAsFactors = F)
+
+combinations <- unique(train_sets_artists %>% select(mode, strat, iteration))
+
+
+for (row in 1:nrow(combinations)){
+  
+  the_mode <- combinations[row, 'mode'] %>%
+    unlist() %>% unname()
+  the_strat <- combinations[row, 'strat'] %>%
+    unlist() %>% unname()
+  the_iteration <- combinations[row, 'iteration'] %>%
+    unlist() %>% unname()
+  
+  unique_artists <- train_sets_artists %>%
+    filter(mode == the_mode, strat == the_strat,
+           iteration == the_iteration) %>%
+    select(artist_id) %>%
+    unlist() %>%
+    unname()
+  
+  filt_test_ex <- test_sets_artists %>%
+    filter(mode == the_mode, strat == the_strat, 
+           iteration == the_iteration, !(artist_id %in% unique_artists)) %>%
+    select(ex_id) %>%
+    unlist()
+  
+  filt_test_sets <- rbind(filt_test_sets,
+                          test_sets %>%
+                            filter(mode == the_mode, strat == the_strat,
+                                   iteration == the_iteration,
+                                   ex_id %in% filt_test_ex))
+  
+}
+```
+
+
+### Class-wise analysis
+
+```{r bs_strat_class}
+info_test <- data.frame()
+info_filt <- data.frame()
+
+for (i in 1:2){
+  info_test[i,] <- table(get_classes(
+    bs_strat[[i]]$test, unique_classes = F)
+    )
+  info_filt[i,] <- table(get_classes(
+    filter_excerpts(bs_strat[[i]]$test,
+                    get_artists(bs_strat[[i]]$train)),
+    unique_classes = F))
+}
+```
+
+
+## Create Sets for Prediction
+
+```{r num_sets, eval = F}
+num_sets <- 40
+```
+
+### Concatenate "Arbitrary" Sets
+
+
+```{r train_sets_pred, eval = F}
+train_sets_pred <- train_sets %>%
+  filter(iteration <= 40)
+```
+
+```{r store_train_sets, eval = F}
+write.csv(x = train_sets_pred, file = '../sets/train.csv',
+          row.names = F)
+```
+
+### Concatenate Test Set
+
+```{r test_sets_pred, eval = F}
+test_sets_pred <- test_sets %>%
+  filter(iteration <= 40)
+```
+
+
+```{r store_test_sets, eval = F}
+write.csv(x = test_sets_pred, file = '../sets/test.csv',
+          row.names = F)
+```