Permalink
Browse files

Preliminary Algoritms for Detecting Regimes.

Added a get-splitpoint function, which takes two alts and creates a
first pass result for a point to split the alts at a single point. Also
added a backend for splitting alts into multiple regimes.
  • Loading branch information...
HazardousPeach committed Mar 17, 2014
1 parent 59f7d84 commit 64d2d5b6bd6a823d068bb4b0d4f56d82df7de65a
Showing with 44 additions and 0 deletions.
  1. +44 −0 casio/combine-alts.rkt
View
@@ -2,6 +2,7 @@
(require casio/alternative)
(require casio/programs)
(require casio/rules)
(require casio/points)
(provide (all-defined-out))
@@ -39,3 +40,46 @@
(loop (alt-prev cur-alt) (cons (alt-change cur-alt) acc))
acc)))
(define (get-splitpoint alt0 alt1)
(let* ([err-diff (errors-compare (alt-errors alt0) (alt-errors alt1))]
[split-index (splitindex-from-difflist err-diff)])
(/ (+ (list-ref *points* split-index) (list-ref *points* (+ 1 split-index))) 2)))
(define (splitindex-from-difflist difflist)
(let loop ([cur-index 0] [more-count 0] [diff-rest difflist])
(cond [(null? diff-rest)
cur-index]
[(eq? (car diff-rest) '=)
(loop cur-index more-count (cdr diff-rest))]
[(and (eq? (car diff-rest) '<) (> 1 more-count))
(loop (- (length difflist) (length diff-rest)) more-count (cdr diff-rest))]
[(eq? (car diff-rest) '<)
(loop cur-index (- more-count 1) (cdr diff-rest))]
[(eq? (car diff-rest) '>)
(loop cur-index (+ more-count 1) (cdr diff-rest))])))
(define (split-indicies-from-difflist difflist min-region-size)
(let loop ([cur-index 0] [regime '=] [opp-count 0]
[diff-rest difflist] [acc '()] [cur-region-size 0])
(cond [(null? diff-rest)
(cons cur-index acc)]
[(eq? (car diff-rest) '=)
(loop cur-index regime opp-count (cdr diff-rest) acc (+ 1 cur-region-size))]
[(and (eq? (car diff-rest) regime) (> 1 opp-count) (<= min-region-size cur-region-size))
(loop (- (length difflist) (length diff-rest)) regime opp-count (cdr diff-rest) acc (+ 1 cur-region-size))]
[(eq? (car diff-rest) regime)
(loop cur-index regime (- opp-count 1) (cdr diff-rest) acc (+ 1 cur-region-size))]
[(not (eq? (car diff-rest) regime))
(if (< min-region-size opp-count)
(loop (- (length difflist) (length diff-rest))
(if (eq? regime '<) '> '<)
0
(cdr diff-rest)
(cons cur-index acc)
opp-count)
(loop cur-index
regime
(+ 1 opp-count)
(cdr diff-rest)
acc
cur-region-size))])))

0 comments on commit 64d2d5b

Please sign in to comment.