USING: kernel sequences math math.functions math.order accessors combinators ; 
IN: binary-chop

: bisect-slice ( seq -- slice slice )
  dup length 2 /
  [ ceiling head-slice ] [ ceiling tail-slice ] 2bi
  ;

DEFER: chop 

: check-right ( seq int -- int )
  swap [ drop -1 ] [
    swap [ dup first ] dip [ <=> ] keep swap
    {
      { +gt+ [ drop drop -1 ] }
      { +lt+ [ [ rest-slice ] dip chop ] }
      [ drop drop from>> ]
    } case
  ] if-empty
  ;

: check-left ( seq int -- int )
  swap [ drop -1 ] [
    swap [ dup last ] dip [ <=> ] keep swap
    {
      { +gt+ [ [ but-last-slice ] dip chop ] }
      { +lt+ [ drop drop -1 ] }
      [ drop drop to>> 1 - ]
    } case
  ] if-empty
  ;
  
: chop ( seq int -- int )
  [ bisect-slice ] dip
  [ check-right ] keep
  swap dup -1 = [ drop check-left ] [ [ drop drop ] dip ] if
  ;

USING: binary-chop tools.test ;
IN: binary-chop.tests
    
[ -1 ] [ { } 3 chop ] unit-test
[ -1 ] [ { 1 } 3 chop ] unit-test
[ 0 ] [ { 1 } 1 chop ] unit-test

[ 0 ] [ { 1 3 5 } 1 chop ] unit-test
[ 1 ] [ { 1 3 5 } 3 chop ] unit-test
[ 2 ] [ { 1 3 5 } 5 chop ] unit-test
[ -1 ] [ { 1 3 5 } 0 chop ] unit-test
[ -1 ] [ { 1 3 5 } 2 chop ] unit-test
[ -1 ] [ { 1 3 5 } 4 chop ] unit-test
[ -1 ] [ { 1 3 5 } 6 chop ] unit-test

[ 0 ] [ { 1 3 5 7 } 1 chop ] unit-test
[ 1 ] [ { 1 3 5 7 } 3 chop ] unit-test
[ 2 ] [ { 1 3 5 7 } 5 chop ] unit-test
[ 3 ] [ { 1 3 5 7 } 7 chop ] unit-test
[ -1 ] [ { 1 3 5 7 } 0 chop ] unit-test
[ -1 ] [ { 1 3 5 7 } 2 chop ] unit-test
[ -1 ] [ { 1 3 5 7 } 4 chop ] unit-test
[ -1 ] [ { 1 3 5 7 } 6 chop ] unit-test
[ -1 ] [ { 1 3 5 7 } 8 chop ] unit-test