--- title: "Unbiased N-Back" date: "5/12/2019" output: ioslides_presentation: default slidy_presentation: default --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = FALSE) library(ggplot2) library(tidyverse) library(GA) ``` ## Intro $\dots$ Problem: ## Method ## Constraints - fixed number of targets - fixed number of lures (a.k.a, foils) - uniform distribution of choices - controlled local lumpiness ## Constraint Satisfaction Problem ```{r} trials <- c('a','b','c','d','c','d','b','a','a','d','b','a','c','c','a','c') min_len <-4 max_len <-4 contig_seqs = list() for (st in 1:length(trials)) { min_fin_index <- st + min_len - 1 max_fin_index <- min(st + max_len -1, length(trials)) for (fin in min_fin_index:max_fin_index) { seq <- list(trials[st:fin]) contig_seqs <- c(contig_seqs, seq) } } ``` Each constraint is a cost function to minimize for each sequence of stimuli ```{r} history <- contig_seqs targets <- 4 lures <- 2 targets_fitness <- function(x) 1.0 - 10*dnorm(x,mean=0,sd=4) lures_fitness <- function(x) 1.0 - 10*dnorm(x,mean=0,sd=4) # calc skewness skewness_fitness <- function(x, choices) { uniform_ratio <- length(x) / length(choices) deviation_from_uniform <- setNames(vector('numeric', length(choices)), choices) for (c in choices) { deviation_from_uniform[c] = abs(length(x[x==c]) - uniform_ratio) } #TODO convert to gaussian loss max(deviation_from_uniform) } ralph2014_skewed <- function(x, choices) { #trials = len(seq) #freqs = [float(seq.count(c)) for c in choices] #ralph_skewed = sum(heapq.nlargest(int(len(choices) / 2), freqs)) > (trials * 2 / 3) #return ralph_skewed F } merged_fitness <- function(x) targets_fitness(x) + lures_fitness(x) + skewness_fitness(x) GA <- ga(type = "real-valued", fitness = fitness, lower = -10, upper = 10) plot(GA) targets_sample <- data.frame(x=-targets:targets) targets_sample %>% ggplot(aes(x,y=targets_fitness(x))) + geom_line() ``` ``` modified_NB <- NB %>% mutate(n= extract from condition) %>% mutate(stimulus_type2=with_lure(stimulus_type)) %>% mutate(history= with lead/lag ) %>% mutate(constraint1=fitness1(history), constrain2=fitness2(history), constraint3=fitness(history)) kmeans(NB) ggplot(kmeans$accuracy) ggplot(kmeans$rt)