/* Euler projects. Here are some Euler project written in Pop-11 (Poplog). Note: The following solutions are heavily influenced by the Lisp solutions which used the loop construct a lot; hence the array (or rather list) comprehensions... To compile it: pop11 %nort mkimage euler_project euler_project.p ":problem1();" This Pop-11 program was created by Hakan Kjellerstrand (hakank@gmail.com). See also my Pop-11 / Poplog page: http://www.hakank.org/poplog/ */ compile('/home/hakank/Poplib/init.p'); /* Problem 1 http://projecteuler.net/index.php?section=problems&id=1 """ If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23. Find the sum of all the multiples of 3 or 5 below 1000. """ Answer: 233186 */ define sumlist(list) -> res; applist(0, list, nonop + ) -> res; enddefine; ;;; problem1()=> define problem1(); lvars ll,i; [%for i from 1 to 999 do if (i mod 3 = 0) or (i mod 5 = 0) then i endif endfor%] -> ll; applist(0, ll, nonop + )=> enddefine; define problem1b_tmp(n); lvars i, sum; 0 -> sum; for i to n do if i mod 3 = 0 or i mod 5 = 0 then sum + i -> sum; endif; endfor; sum; enddefine; define problem1b(); problem1b_tmp(999)=>; enddefine; /* Problem 2 http://projecteuler.net/index.php?section=problems&id=2 """ Each new term in the Fibonacci sequence is generated by adding the previous two terms. By starting with 1 and 2, the first 10 terms will be: 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ... Find the sum of all the even-valued terms in the sequence which do not exceed four million. """ Note: The sequence starts with 1 2, not 1 1 2. Answer: ** 4613732 The list is [2 8 34 144 610 2584 10946 46368 196418 832040 3524578] */ define even(num); if num mod 2 = 0 then return(true); endif; return(false); enddefine; define odd(num); if num mod 2 = 1 then return(true); endif; return(false); enddefine; define fib(num) -> res; if num <= 1 then 1 -> res; return(); endif; fib(num - 1) + fib(num -2) -> res; enddefine; define select( L, pred ); lvars L2, i; [%for i in L do if pred(i) then i endif endfor%]->L2; return(L2); enddefine; ;;; ;;; memoised version of fib ;;; fibvec must be initialized (see problem2) ;;; vars fibvec; ;;; GLOBAL! define fib2(num) -> res; if num <= 1 then fibvec(1) -> res; return(); endif; ;;; not in fibvec? if fibvec(num) == 0 then fib2(num - 1) + fib2(num - 2) -> fibvec(num); endif; fibvec(num) -> res; enddefine; ;;; ;;; note: this is not used any more. ;;; But note the construction: we don't need any if's ;;; or returns etc ;;; define even_and_less_than_4000000(num) ; even(num) and num < 4000000 enddefine; define problem2a; lvars n, f2, f_even, i; 100 -> n; newarray([1 ^n], 0) -> fibvec; ;;; GLOBAL! 1->fibvec(1); 2->fibvec(2); npr(fib2(n)); ;;; get the values ;;; [%for i from 1 to fibvec.length do fibvec(i) endfor%]->f2; [%for i from 1 to fibvec.length do if fibvec(i) < 4000000 then fibvec(i) endif endfor%]->f2; npr(f2); ;;;select(f2, even_and_less_than_4000000)->f_even; select(f2, even)->f_even; npr(f_even); sumlist(f_even)=> enddefine; ;;; Version b: uses dynamic lists ;;; note: problem() a the second time gives [] 0 as result ;;; define problem2b()->fib_list; ;;; Alternative and much more elegant version using dynamis lists. ;;; (see dynamic_lists.p) ;;; Note: This is a kind of memoizing. ;;; ;;; Define the generator of the Fibonacci sequence define gen_fib() -> next; lconstant store = [1 1]; ;;; but this is not very naturual lvars tmp = store(1); store(2) -> store(1); store(2) -> next; tmp + store(2) -> store(2); enddefine; ;;; convert to dynamic list lvars fib_list = pdtolist(gen_fib); lvars i = 1; lvars sum = 0; [% ;;; less than 4000000 while fib_list(i) < 4000000 do ;;; and is even lvars t = fib_list(i); if t mod 2 = 0 then t + sum -> sum; t; ;;; put the value on the stack endif; i + 1 -> i endwhile %]=> sum=> fib_list=> enddefine; ;;;; testing without memo. Must be run before problem2() ;;;; since it memoizes fib. define problem2_nomemo(); ;;; newmemo(fib,200) -> fib; lvars i = 0; lvars t = 1; lvars sum = 0; lvars fib_list; [% while t < 4000000 do fib(i) -> t; if t mod 2 = 0 then t + sum -> sum; t; endif; i + 1 -> i endwhile %]->fib_list; sum=> fib_list=> enddefine; ;;; And this version uses ~/Poplog/newmemo.p ;;; From Popplestones Popbook (popbook.pdf), page 289 ;;; Yes, it works very well. And it works the next time as well. ;;; Note: The following will give a MEMORY LIMIT after a while ;;; uses time; ;;; time problem2(); define problem2(); newmemo(fib,200) -> fib; lvars i = 0; lvars t = 1; lvars sum = 0; lvars fib_list; [% while t < 4000000 do fib(i) -> t; if t mod 2 = 0 then t + sum -> sum; t; endif; i + 1 -> i endwhile %]->fib_list; sum=> fib_list=> enddefine; /* Problem 3 http://projecteuler.net/index.php?section=problems&id=3 The prime factors of 13195 are 5, 7, 13 and 29. What is the largest prime factor of the number 600851475143 ? Answer: 6857 */ define divisors(n); lvars i; [1 %for i from 2 to round(n/2) do if (n mod i = 0) then i endif endfor% ^n] enddefine; define is_prime(n); lvars i; if n = 2 or n = 3 then return(true); endif; if n mod 2 = 0 then return(false); endif; for i from 3 by 2 to round(sqrt(n))+1 do if n mod i = 0 then return(false); endif; endfor; return(true); enddefine; ;;; ;;; Very brutal... ;;; define factors(n); lvars m = n; lvars list = []; lvars found = false; if is_prime(n) then return([]); endif; lvars i; [% while m > 1 do false -> found; for i from 2 to round(m/2) do if m mod i = 0 then while m mod i = 0 then i; m / i -> m; endwhile; true -> found; endif endfor; if not(found) then quitloop endif; endwhile %]->list; return(list); enddefine; ;;; ;;; Simpler version: loop until the last prime is detected ;;; define problem3(); lvars last; lvars n = 600851475143; lvars i; for i from 2 to round(sqrt(n)) do if n mod i = 0 and is_prime(i) then i=> i -> last endif endfor; last=> enddefine; /* http://projecteuler.net/index.php?section=problems&id=4 A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 99. Find the largest palindrome made from the product of two 3-digit numbers. : strnumber('9090')+1=> ** 9091 : unpackitem(123)=> ** [1 2 3] : packitem([1 2 3 4 5])+1=> ** 12346 : lvars ll = [%for k from 1 to 9 do k endfor%]; : ll=> ** [1 2 3 4 5 6 7 8 9] : for i, j in ll,ll do i+j endfor=>; ** 2 4 6 8 10 12 14 16 18 : for i, j in ll,ll do if palindrome(unpackitem(i*j)) then [^i ^j] endif endfor=>; ** [1 1] [2 2] [3 3] : last([%for i from 1 to 99 do for j from 1 to 99 do if palindrome(unpackitem(i*j)) then [^i ^j] endif; endfor; endfor%])=>; ** [99 91] */ define palindrome(list); list = rev(list); enddefine; ;;; ;;; problem4(); ;;; ** [906609 913 993] define problem4(); lvars i,j; last( syssort( [% for i from 100 to 999 do for j from 100 to i do if palindrome(unpackitem(i*j)) then [^(i*j) ^i ^j ] endif; endfor; endfor %], procedure(l1,l2); hd(l1) < hd(l2); endprocedure) )=> enddefine; ;;; alternative version, using just a variable maxval define problem4b(); lvars i,j,x,imax, jmax; lvars maxval = 0; for i from 100 to 999 do for j from 100 to i do i*j -> x; if x > maxval then if palindrome(unpackitem(i*j)) then x -> maxval; i -> imax; j -> jmax; endif; endif; endfor; endfor; [^imax * ^jmax = ^maxval]=> enddefine; /* Problem 5 2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder. What is the smallest number that is evenly divisible by all of the numbers from 1 to 20? Answer: 232792560 */ define problem5(); lvars i; lcm_n([%for i from 1 to 20 do i endfor%].explode,20)=> enddefine; /* Problem 6 """ The sum of the squares of the first ten natural numbers is, 1^2+ 22 ... + 10^2 = 385 The square of the sum of the first ten natural numbers is, (1 + 2 + ... + 10)^2= 55^2 = 3025 Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 385 = 2640. Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum. """ Answer: : problem6(); ** [25502500 - 338350 = 25164150] : applist(0, [%applist([%for i from 1 to 10 do i endfor%], procedure(n); n*n endprocedure)%], nonop +)=> ** 385 : applist(0, [%applist([%for i from 1 to 10 do i endfor%], procedure(n); n endprocedure)%], nonop +)**2=> ** 3025 */ define problem6(); lvars n = 100; lvars i; lvars list= [%for i from 1 to n do i endfor%]; lvars sum_squares, squares_sum, sdiff; applist(0, [%applist(list, procedure(n); n*n endprocedure)%], nonop +) -> sum_squares; applist(0, list, nonop +)**2 -> squares_sum; (squares_sum - sum_squares) -> sdiff; [^squares_sum - ^sum_squares = ^sdiff]=>; enddefine; /* Problem 7 By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th prime is 13, we can see that the 6th prime is 13. What is the 10001st prime number? */ ;;; ;;; brutal version. ;;; define is_prime(n); lvars i; if n = 2 or n = 3 then return(true); endif; if n mod 2 = 0 then return(false); endif; for i from 3 by 2 to round(sqrt(n))+1 do if n mod i = 0 then return(false); endif; endfor; return(true); enddefine; define gen_prime()->next; lconstant store = [2]; store(1) -> next; lvars i = store(1)+1; until is_prime(i) do i + 1 -> i; enduntil; i -> store(1); enddefine; define problem7(); vars prime_list = pdtolist(gen_prime); prime_list(10001)=> enddefine; /* Problem 8 """ Find the greatest product of five consecutive digits in the 1000-digit number. 73167176531330624919225119674426574742355349194934 96983520312774506326239578318016984801869478851843 85861560789112949495459501737958331952853208805511 12540698747158523863050715693290963295227443043557 66896648950445244523161731856403098711121722383113 62229893423380308135336276614282806444486645238749 30358907296290491560440772390713810515859307960866 70172427121883998797908792274921901699720888093776 65727333001053367881220235421809751254540594752243 52584907711670556013604839586446706324415722155397 53697817977846174064955149290862569321978468622482 83972241375657056057490261407972968652414535100474 82166370484403199890008895243450658541227588666881 16427171479924442928230863465674813919123162824586 17866458359124566529476545682848912883142607690042 24219022671055626321111109370544217506941658960408 07198403850962455444362981230987879927244284909188 84580156166097919133875499200524063689912560717606 05886116467109405077541002256983155200055935729725 71636269561882670428252483600823257530420752963450 """ Answer: 40824 */ vars p8_num = 7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450.unpackitem; define productlist(list) -> res; applist(1, list, nonop * ) -> res; enddefine; define problem8(); lvars i,j; last( sort( [%for i from 1 to p8_num.length - 4 do productlist([%for j from i to i+4 do p8_num(j) endfor%]) endfor% ] ) )=> enddefine; /* Problem 9 A Pythagorean triplet is a set of three natural numbers, a b c, for which, a^2 + b^2 = c^2 For example, 3^2 + 4^2 = 9 + 16 = 25 = 5^2. There exists exactly one Pythagorean triplet for which a + b + c = 1000. Find the product abc. Answer: [31875000 200 375 425] Note: This takes about 8 seconds. */ define is_pyth(a,b,c); a**2+b**2=c**2 enddefine; define problem9(); ;;; brute force lvars a,b,c; for c from 1 to 1000 do for b from 1 to c do for a from 1 to b do if a+b+c=1000 and is_pyth(a,b,c) then [^(a * b * c) ^a ^b ^c] endif endfor endfor endfor=> enddefine; /* Problem 10 """ The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17. Find the sum of all the primes below one million. """ Answer: 142913828922 Takes about 11 seconds. */ define problem10(); ;;; OK, we do a straight method lvars i; lvars res = 2; for i from 3 by 2 to 2000000 do if is_prime(i) then res + i -> res; endif; endfor; res => enddefine; /* Problem 11 """ In the 2020 grid below, four numbers along a diagonal line have been marked in red. 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 32 98 81 28 64 23 67 10|26|38 40 67 59 54 70 66 18 38 64 70 67 26 20 68 02 62 12 20 95|63|94 39 63 08 40 91 66 49 94 21 24 55 58 05 66 73 99 26 97 17|78|78 96 83 14 88 34 89 63 72 21 36 23 09 75 00 76 44 20 45 35|14|00 61 33 97 34 31 33 95 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 The product of these numbers is 26 x 63 x 78 x 14 = 1788696. What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20 x 20 grid? """ Answer: 70600674 : for i in [%'08 02 22'.split%] do strnumber(i)+1=> endfor; ** 9 ** 3 ** 23 Using split_with first : [%split_with(p11_matrix,'\n')%] -> x; : for i from 1 to x.length do for j in [%split(x(i))%] do strnumber(j)+1=> endfor endfor; Fills very inefficent : newarray([1 20 1 20]) -> aa; : for i from 1 to 20 do for j from 1 to 20 do strnumber([%x(i).split%](j)) -> aa(i,j) endfor endfor; */ ;;; note the \ at the end of line (is "\n") vars p11_matrix = '08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08\ 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00\ 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65\ 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91\ 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80\ 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50\ 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70\ 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21\ 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72\ 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95\ 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92\ 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57\ 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58\ 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40\ 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66\ 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69\ 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36\ 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16\ 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54\ 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48'; define problem11(); ;;; convert to matrix aa (and print it) lvars i,j, x, aa; [%split_with(p11_matrix,'\n')%] -> x; newarray([1 20 1 20]) -> aa; for i from 1 to 20 do for j from 1 to 20 do ;;; if j = 1 then ;;; npr(''); ;;;endif; strnumber([%x(i).split%](j)) -> aa(i,j); ;;; spr(aa(i,j)); endfor; endfor; npr(''); lvars across, col, row, a; ;;; npr('across'); [%for col from 1 to 20 do for a from 1 to 17 do productlist([% for row from a to a + 3 do aa(col, row) endfor; %]) endfor; endfor%] -> across; ;;; across=> lvars updown; ;;; npr('updown'); [%for row from 1 to 20 do for a from 1 to 17 do productlist([% for col from a to a + 3 do aa(col, row) endfor; %]) endfor; endfor%] -> updown; ;;; updown=> lvars diag_down; ;;; npr('diag_down'); [%for j from 1 to 17 do for i from 1 to 17 do productlist([% for a from 0 to 3 do aa(a + i, a+j) endfor; %]) endfor; endfor%] -> diag_down; ;;; diag_down=> lvars diag_up; ;;; npr('diag_up'); [%for j from 1 to 17 do for i from 4 to 20 do productlist([% for a from 0 to 3 do aa(i - a, j + a) endfor; %]) endfor; endfor%] -> diag_up; ;;; diag_up=> last(sort([^^across ^^updown ^^diag_down ^^diag_up]))=>; enddefine; /* Problem 12 """ The sequence of triangle numbers is generated by adding the natural numbers. So the 7th triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first ten terms would be: 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ... Let us list the factors of the first seven triangle numbers: 1: 1 3: 1,3 6: 1,2,3,6 10: 1,2,5,10 15: 1,3,5,15 21: 1,3,7,21 28: 1,2,4,7,14,28 We can see that the 7th triangle number, 28, is the first triangle number to have over five divisors. Which is the first triangle number to have over five-hundred divisors?") """ Answer: 76576500 Takes about 10 seconds. problem12(); ** [12375 576 76576500] */ define triangle_number(n); lvars i; sumlist([%for i from 1 to n do i endfor%]) enddefine; define num_divisors2(n); lvars s = 0; lvars i; for i from 1 to round(sqrt(n)) do if n mod i = 0 then s + 1 -> s; endif; endfor; return(s); enddefine; define problem12(); ;;; brute force.... ;;; lvars i = 2; ;;; lvars len = 2; ;;; lvars d = []; ;;; while len <= 500 do ;;; if is_prime(i) then ;;; [1 ^i] -> d; ;;; 2 -> len ;;; else ;;; divisors(triangle_number(i)) -> d; ;;; endif; ;;; length(d) -> len; ;;; i+1 -> i; ;;; [^i ^d ^len]=> ;;; endwhile; ;;; i=> lvars i = 2; lvars len = 0; lvars tnum; while 2*len <= 500 do triangle_number(i) -> tnum; num_divisors2(tnum) -> len; ;;;[^i ^(2*len) ^tnum] => i + 1 -> i; endwhile; [^(i-1) ^(len*2) ^tnum] => enddefine; /* Problem 13 Work out the first ten digits of the sum of the following one-hundred 50-digit numbers. 37107287533902102798797998220837590246510135740250 .... 20849603980134001723930671666823555245252804609722 53503534226472524250874054075591789781264330331690") Answer: 5537376230 */ vars problem13_string = '37107287533902102798797998220837590246510135740250\ 46376937677490009712648124896970078050417018260538\ 74324986199524741059474233309513058123726617309629\ 91942213363574161572522430563301811072406154908250\ 23067588207539346171171980310421047513778063246676\ 89261670696623633820136378418383684178734361726757\ 28112879812849979408065481931592621691275889832738\ 44274228917432520321923589422876796487670272189318\ 47451445736001306439091167216856844588711603153276\ 70386486105843025439939619828917593665686757934951\ 62176457141856560629502157223196586755079324193331\ 64906352462741904929101432445813822663347944758178\ 92575867718337217661963751590579239728245598838407\ 58203565325359399008402633568948830189458628227828\ 80181199384826282014278194139940567587151170094390\ 35398664372827112653829987240784473053190104293586\ 86515506006295864861532075273371959191420517255829\ 71693888707715466499115593487603532921714970056938\ 54370070576826684624621495650076471787294438377604\ 53282654108756828443191190634694037855217779295145\ 36123272525000296071075082563815656710885258350721\ 45876576172410976447339110607218265236877223636045\ 17423706905851860660448207621209813287860733969412\ 81142660418086830619328460811191061556940512689692\ 51934325451728388641918047049293215058642563049483\ 62467221648435076201727918039944693004732956340691\ 15732444386908125794514089057706229429197107928209\ 55037687525678773091862540744969844508330393682126\ 18336384825330154686196124348767681297534375946515\ 80386287592878490201521685554828717201219257766954\ 78182833757993103614740356856449095527097864797581\ 16726320100436897842553539920931837441497806860984\ 48403098129077791799088218795327364475675590848030\ 87086987551392711854517078544161852424320693150332\ 59959406895756536782107074926966537676326235447210\ 69793950679652694742597709739166693763042633987085\ 41052684708299085211399427365734116182760315001271\ 65378607361501080857009149939512557028198746004375\ 35829035317434717326932123578154982629742552737307\ 94953759765105305946966067683156574377167401875275\ 88902802571733229619176668713819931811048770190271\ 25267680276078003013678680992525463401061632866526\ 36270218540497705585629946580636237993140746255962\ 24074486908231174977792365466257246923322810917141\ 91430288197103288597806669760892938638285025333403\ 34413065578016127815921815005561868836468420090470\ 23053081172816430487623791969842487255036638784583\ 11487696932154902810424020138335124462181441773470\ 63783299490636259666498587618221225225512486764533\ 67720186971698544312419572409913959008952310058822\ 95548255300263520781532296796249481641953868218774\ 76085327132285723110424803456124867697064507995236\ 37774242535411291684276865538926205024910326572967\ 23701913275725675285653248258265463092207058596522\ 29798860272258331913126375147341994889534765745501\ 18495701454879288984856827726077713721403798879715\ 38298203783031473527721580348144513491373226651381\ 34829543829199918180278916522431027392251122869539\ 40957953066405232632538044100059654939159879593635\ 29746152185502371307642255121183693803580388584903\ 41698116222072977186158236678424689157993532961922\ 62467957194401269043877107275048102390895523597457\ 23189706772547915061505504953922979530901129967519\ 86188088225875314529584099251203829009407770775672\ 11306739708304724483816533873502340845647058077308\ 82959174767140363198008187129011875491310547126581\ 97623331044818386269515456334926366572897563400500\ 42846280183517070527831839425882145521227251250327\ 55121603546981200581762165212827652751691296897789\ 32238195734329339946437501907836945765883352399886\ 75506164965184775180738168837861091527357929701337\ 62177842752192623401942399639168044983993173312731\ 32924185707147349566916674687634660915035914677504\ 99518671430235219628894890102423325116913619626622\ 73267460800591547471830798392868535206946944540724\ 76841822524674417161514036427982273348055556214818\ 97142617910342598647204516893989422179826088076852\ 87783646182799346313767754307809363333018982642090\ 10848802521674670883215120185883543223812876952786\ 71329612474782464538636993009049310363619763878039\ 62184073572399794223406235393808339651327408011116\ 66627891981488087797941876876144230030984490851411\ 60661826293682836764744779239180335110989069790714\ 85786944089552990653640447425576083659976645795096\ 66024396409905389607120198219976047599490197230297\ 64913982680032973156037120041377903785566085089252\ 16730939319872750275468906903707539413042652315011\ 94809377245048795150954100921645863754710598436791\ 78639167021187492431995700641917969777599028300699\ 15368713711936614952811305876380278410754449733078\ 40789923115535562561142322423255033685442488917353\ 44889911501440648020369068063960672322193204149535\ 41503128880339536053299340368006977710650566631954\ 81234880673210146739058568557934581403627822703280\ 82616570773948327592232845941706525094512325230608\ 22918802058777319719839450180888072429661980811197\ 77158542502016545090413245809786882778948721859617\ 72107838435069186155435662884062257473692284509516\ 20849603980134001723930671666823555245252804609722\ 53503534226472524250874054075591789781264330331690'; define problem13(); lvars x = [%split_with(problem13_string,'\n')%]; lvars i,s, ss; sumlist([%for i from 1 to x.length do strnumber(x(i)) endfor%]) -> s; ;;; s=> s.unpackitem -> ss; ;;; ss=> [%for i from 1 to 10 do ss(i) endfor%].packitem =>; enddefine; /* Problem 14 """ The following iterative sequence is defined for the set of positive integers: n n/2 (n is even) n 3n + 1 (n is odd) Using the rule above and starting with 13, we generate the following sequence: 13 40 20 10 5 16 8 4 2 1 It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1. Which starting number, under one million, produces the longest chain? NOTE: Once the chain starts the terms are allowed to go above one million.") """ Answer: 837799 (the chain is 525 integers long) : uses time; : time problem14(); ** Res ** [max_i 837799 max_len 525] CPU TIME: 670.79 GC TIME: 69.0 I.e. about 11 minutes! With the new 64-bit machine: about 7 minutes. */ ;;; memoizes the collatz length vars c_len=newproperty([], 10, 0, "perm"); define collatz1(n); if n mod 2 = 0 then n/2; else 3*n + 1; endif; enddefine; define collatz_seq(n); lvars m = n; lvars seq = [^n]; while m > 1 do collatz1(m) -> m; [^^seq ^m] -> seq endwhile; seq.length -> c_len(n); seq; enddefine; define collatz_len(n); lvars len = c_len(n); if len = 0 then collatz_seq(n).length -> len; ;;; [calculating new ^n ^len] => ; len -> c_len(n) endif; return(len); enddefine; define problem14(); ;;;newmemo(collatz_len, 100) -> collatz_len; ;;;newmemo(collatz1, 100) -> collatz1; newmemo(collatz_seq, 100) -> collatz_seq; ;;; TESTING! lvars i, max_seq, seq; lvars len = 0; lvars max_len = 0; lvars max_i = 0; for i from 1 to 1000000 do collatz_seq(i) -> seq; seq.length -> len; len -> c_len(i); if len > max_len then seq -> max_seq ; len -> max_len; i -> max_i; endif; endfor; ;;; for i from 1 to 100000 do ;;; collatz_len(i) -> len; ;;; if len > max_len then ;;; len -> max_len; ;;; i -> max_i; ;;; endif; ;;; endfor; 'Res'=>, [max_i ^max_i max_len ^max_len]=> ;;; for i from 1 to 1000 do ;;; [^i ^(collatz_len(i))] => ;;;endfor; enddefine; ;;; ;;; range(from, to) -> list ;;; define range(x_low, x_up); lvars i; [%for i from x_low to x_up do i endfor%]; enddefine; /* Problem 15 Starting in the top left corner of a 2×2 grid, there are 6 routes (without backtracking) to the bottom right corner. How many routes are there through a 20×20 grid? Answer: 137846528820 */ define problem15(); productlist(range(21,40)) / productlist(range(2,20))=> enddefine; /* Problem 16 """ 2^15 = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26. What is the sum of the digits of the number 2^1000? """ Answer: 1366 */ define problem16(); ;;; nice (2**1000).unpackitem.sumlist=> ;;; With just basic operations ;;; lvars s, i; ;;; 0->s; for i in ((2**1000).unpackitem) do i+s -> s; endfor; ;;; s=> enddefine; /* Problem 17 """ If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total. If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used? NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage. """ Answer: 21124 Ah! Pop-11 has ~R (a la Lisp), which makes it much simpler. The lisp variant: (defun number-len (n) (length (delete #\- (delete #\Space (format nil "~r" n))))) (+ (* 3 (- 1000 9)) (loop for i from 1 to 1000 sum (number-len i))) from help format_print: format_print('next year it will be ~R ad', [1985]); next year it will be one thousand, nine hundred and eighty five ad format_print('~R', [1985]); Ah, but it prints directly to stdout and don't put anything on the stack. Can we redirect it to a string? (No) Note: this don't work!! */ define problem17(); define number_len(n); lvars str; (format_print('~R',{n})).datalist->str; str=> delete(`-`, str) -> str; delete(` `, str) -> str; str=> return(str.length); enddefine; lvars i; ;;; for i from 1 to 10 do number_len(i)=> endfor; for i from 1 to 100 do (format_print('~:(~R~)\n',[^i])) endfor; enddefine; ;;; From HELP CUCHAROUT, don't work as expected ;;; define print_literal(item)->result; ;;; define dlocal cucharout(character); ;;; format_print('~R',{result}); ;;; enddefine; ;;; ;;; pr(item); ;;; enddefine; ;;; print_literal(101)=>; ;;; ;;; run as: ;;; run_problem(1) ;;; define run_problem(n); [run problem ^n]=>; lvars problem = 'problem' >< n >< '()'; ;;; -> 'problem1()' problem.stringin.pop11_compile; ;;; I like this most. ;;; some variants: ;;; pop11_compile(stringin(problem)); ;;; or like this ;;; pop11_compile(stringin('problem' >< n >< '()')); ;;; or like this ;;; Note: the call () is after pop_11_compile here: ;;; ('problem' >< 1).stringin.pop11_compile();=>; enddefine; ;;; Note: this assumes that the problem() prints the result... ;;; lvars p; for p in [1 2 3 4 5 6 7 8 9 10 11 12 13 15 16] do ;;; for p in [1 2 3 4 5 6 7 8 ] do ;;; for p in [12] do run_problem(p); endfor; ;;; problem1b();