---
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()
```


```{r}


for (r in 1:nrow(NB)) {
  NB[r,'history'] <- substr(paste(NB[r-1,]$history, NB[r,]$stimulus, sep=''),-4,1)
}


with_lures <- function(stim, lag1=NA,lag2=NA,lag3=NA,lag4=NA) {
  # 2-back
  print(lag1)
  if (is.na(lag1) || is.na(lag3))
    return(NA)
  ifelse(stim==lag1 ||  stim==lag3, T, F)
}


NB %>%
  mutate(
    lure = map_chr(
      stimulus, 
      ~with_lures(
        .x,
        lag(stimulus,1),
        lag(stimulus,2),
        lag(stimulus,3),
        lag(stimulus,4)
      )
    )
  )

modified_NB <- NB %>%
  #mutate(condition_n=ifelse(condition=='3-back',factor(2),factor(3))) %>%
  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)

