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 swap add-values ;