From 6394eb70bf82005eff70258aa91f133eea7ef10c Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Wed, 30 Jan 2008 00:50:18 -0500
Subject: [PATCH] Solution to Project Euler problem 37
---
extra/project-euler/037/037.factor | 52 ++++++++++++++++++++++++
extra/project-euler/project-euler.factor | 4 +-
2 files changed, 54 insertions(+), 2 deletions(-)
create mode 100644 extra/project-euler/037/037.factor
diff --git a/extra/project-euler/037/037.factor b/extra/project-euler/037/037.factor
new file mode 100644
index 0000000000..f2d5d17c4d
--- /dev/null
+++ b/extra/project-euler/037/037.factor
@@ -0,0 +1,52 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.parser math.primes sequences ;
+IN: project-euler.037
+
+! http://projecteuler.net/index.php?section=problems&id=37
+
+! DESCRIPTION
+! -----------
+
+! The number 3797 has an interesting property. Being prime itself, it is
+! possible to continuously remove digits from left to right, and remain prime
+! at each stage: 3797, 797, 97, and 7. Similarly we can work from right to
+! left: 3797, 379, 37, and 3.
+
+! Find the sum of the only eleven primes that are both truncatable from left to
+! right and right to left.
+
+! NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: r-trunc? ( n -- ? )
+ 10 /i dup 0 > [
+ dup prime? [ r-trunc? ] [ drop f ] if
+ ] [
+ drop t
+ ] if ;
+
+: reverse-digits ( n -- m )
+ number>string reverse 10 string>integer ;
+
+: l-trunc? ( n -- ? )
+ reverse-digits 10 /i reverse-digits dup 0 > [
+ dup prime? [ l-trunc? ] [ drop f ] if
+ ] [
+ drop t
+ ] if ;
+
+PRIVATE>
+
+: euler037 ( -- answer )
+ 23 1000000 primes-between [ r-trunc? ] subset [ l-trunc? ] subset sum ;
+
+! [ euler037 ] 100 ave-time
+! 768 ms run / 9 ms GC ave time - 100 trials
+
+MAIN: euler037
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index feef9dbfa8..fbb62961a9 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -11,8 +11,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
project-euler.025 project-euler.026 project-euler.027 project-euler.028
project-euler.029 project-euler.030 project-euler.031 project-euler.032
project-euler.033 project-euler.034 project-euler.035 project-euler.036
- project-euler.067 project-euler.134 project-euler.169 project-euler.173
- project-euler.175 ;
+ project-euler.037 project-euler.067 project-euler.134 project-euler.169
+ project-euler.173 project-euler.175 ;
IN: project-euler
<PRIVATE