57 lines
		
	
	
		
			1.7 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			57 lines
		
	
	
		
			1.7 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (c) 2012 Anonymous
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
 | 
						|
IN: rosetta-code.hailstone-sequence
 | 
						|
 | 
						|
! http://rosettacode.org/wiki/Hailstone_sequence
 | 
						|
 | 
						|
! The Hailstone sequence of numbers can be generated from a
 | 
						|
! starting positive integer, n by:
 | 
						|
 | 
						|
! * If n is 1 then the sequence ends.
 | 
						|
! * If n is even then the next n of the sequence = n/2
 | 
						|
! * If n is odd then the next n of the sequence = (3 * n) + 1
 | 
						|
 | 
						|
! The (unproven), Collatz conjecture is that the hailstone
 | 
						|
! sequence for any starting number always terminates.
 | 
						|
 | 
						|
! Task Description:
 | 
						|
 | 
						|
! 1. Create a routine to generate the hailstone sequence for a
 | 
						|
!    number.
 | 
						|
 | 
						|
! 2. Use the routine to show that the hailstone sequence for the
 | 
						|
!    number 27 has 112 elements starting with 27, 82, 41, 124 and
 | 
						|
!    ending with 8, 4, 2, 1
 | 
						|
 | 
						|
! 3. Show the number less than 100,000 which has the longest
 | 
						|
!    hailstone sequence together with that sequences length.
 | 
						|
!    (But don't show the actual sequence)!
 | 
						|
 | 
						|
: hailstone ( n -- seq )
 | 
						|
    [ 1vector ] keep
 | 
						|
    [ dup 1 number= ]
 | 
						|
    [
 | 
						|
        dup even? [ 2 / ] [ 3 * 1 + ] if
 | 
						|
        2dup swap push
 | 
						|
    ] until
 | 
						|
    drop ;
 | 
						|
 | 
						|
: hailstone-main ( -- )
 | 
						|
    27 hailstone dup dup
 | 
						|
    "The hailstone sequence from 27:" print
 | 
						|
    "  has length " write length .
 | 
						|
    "  starts with " write 4 head [ unparse ] map ", " join print
 | 
						|
    "  ends with " write 4 tail* [ unparse ] map ", " join print
 | 
						|
 | 
						|
    ! Maps n => { length n }, and reduces to longest Hailstone sequence.
 | 
						|
    1 100000 [a,b)
 | 
						|
    [ [ hailstone length ] keep 2array ]
 | 
						|
    [ [ [ first ] bi@ > ] most ] map-reduce
 | 
						|
    first2
 | 
						|
    "The hailstone sequence from " write pprint
 | 
						|
    " has length " write pprint "." print ;
 | 
						|
 | 
						|
MAIN: hailstone-main
 | 
						|
 |