Paste: balance-shuffle

USING: arrays binary-tree kernel make math sequences ;
IN: binary-tree.balance

: floored-middle ( seq -- i )
    length 1 - 2 /i ;

: take-middles ( seq^2 -- )
    [ dup floored-middle swap nth , ] each ;
    
: (>sides) ( seq -- left right )
    dup floored-middle [ head ] [ 1 + tail ] 2bi ;
    
: >sides ( seq^2 -- seq^2 )
    [ take-middles ]
    [ [ (>sides) 2array harvest ] map concat ] bi ;
    
: half-shuffle ( values -- values' )
    [ >array 1array [ dup empty? ] [ >sides ] until drop ] { } make ;

: re-balance ( tree/node -- new-node )
    values half-shuffle unclip <node> <binary-tree> swap add-values ;