Paste: hailstone

USING: kernel sequences math math.ranges arrays sorting ;
IN: hailstone

: (hs) ( x -- x ) dup odd? [ 3 * 1 + ] [ 2 / ] if ;

: hs ( x -- seq ) dup [ dup 1 > ] [ (hs) dup ] produce nip swap prefix ;

: hs-seqs ( -- seq ) 0 [ 1 + dup 100000 <= ] [ dup hs ] produce nip ;

: to-num-len ( seq -- newseq ) dup [ first ] dip length 2array ;

! not-so-good tries
: longest ( -- x ) hs-seqs [ to-num-len ] map sort-values last ;
: longest2 ( -- x ) hs-seqs [ to-num-len ] [ 2array sort-values last ] map-reduce ;

! slightly better?
: longest-in ( x -- y ) [1,b] [ hs to-num-len ] [ 2array sort-values last ] map-reduce ;

Annotation: shorter?

: hs-step ( x -- y ) dup odd? [ 3 * 1 + ] [ 2 / ] if ;
: hs ( x -- seq ) [ dup 1 > ] [ [ hs-step ] keep ] produce swap suffix ;
: longest ( n -- pair ) iota [ hs length ] map [ supremum ] keep [ = ] with find 2array ;

( scratchpad ) 10 5 ^ longest .
{ 77031 351 }

New Annotation