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