2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (c) 2008 Eric Mertens
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-26 12:03:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: kernel math math.order sequences sequences.private
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								locals hints ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: project-euler.150
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! sequence helper functions
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: partial-sums ( seq -- sums )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    0 [ + ] accumulate swap suffix ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: (partial-sum-infimum) ( inf sum elt -- inf sum )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    + [ min ] keep ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: partial-sum-infimum ( seq -- seq )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    0 0 rot [ (partial-sum-infimum) ] each drop ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: generate ( n quot -- seq )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-26 00:17:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ drop ] prepose map ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: map-infimum ( seq quot -- min )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ min ] compose 0 swap reduce ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! triangle generator functions
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: next ( t -- new-t s )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: sums-triangle ( -- seq )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    0 1000 [ 1+ [ next ] generate partial-sums ] map nip ; 
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-19 05:52:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								:: (euler150) ( m -- n )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [let | table [ sums-triangle ] |
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        m [| x |
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            x 1+ [| y |
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                m x - [| z |
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								                    x z + table nth-unsafe
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                    [ y z + 1+ swap nth-unsafe ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                    [ y        swap nth-unsafe ] bi -
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                ] map partial-sum-infimum
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 13:30:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            ] map-infimum
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] map-infimum
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-17 13:22:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								HINTS: (euler150) fixnum ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-16 05:25:38 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: euler150 ( -- n )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    1000 (euler150) ;
							 |