Anonymous user
Find largest left truncatable prime in a given base: Difference between revisions
Find largest left truncatable prime in a given base (view source)
Revision as of 08:41, 8 October 2012
, 11 years ago→Tcl: Added implementation
m (use internal link) |
(→Tcl: Added implementation) |
||
Line 405:
</pre>
That is going to be big!
=={{header|Tcl}}==
<lang tcl>package require Tcl 8.5
proc tcl::mathfunc::modexp {a b n} {
for {set c 1} {$b} {set a [expr {$a*$a%$n}]} {
if {$b & 1} {
set c [expr {$c*$a%$n}]
}
set b [expr {$b >> 1}]
}
return $c
}
# Based on Miller-Rabin primality testing, but with small prime check first
proc is_prime {n {count 10}} {
# fast check against small primes
foreach p {
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
} {
if {$n == $p} {return true}
if {$n % $p == 0} {return false}
}
# write n-1 as 2^s·d with d odd by factoring powers of 2 from n-1
set d [expr {$n - 1}]
for {set s 0} {$d & 1 == 0} {incr s} {
set d [expr {$d >> 1}]
}
for {} {$count > 0} {incr count -1} {
set a [expr {2 + int(rand()*($n - 4))}]
set x [expr {modexp($a, $d, $n)}]
if {$x == 1 || $x == $n - 1} continue
for {set r 1} {$r < $s} {incr r} {
set x [expr {modexp($x, 2, $n)}]
if {$x == 1} {return false}
if {$x == $n - 1} break
}
if {$x != $n-1} {return false}
}
return true
}
proc max_left_truncatable_prime {base} {
set stems {}
for {set i 2} {$i < $base} {incr i} {
if {[is_prime $i]} {
lappend stems $i
}
}
set primes $stems
set size 0
for {set b $base} {[llength $stems]} {set b [expr {$b * $base}]} {
# Progress monitoring is nice once we get to 10 and beyond...
if {$base > 9} {
puts "\t[llength $stems] candidates at length [incr size]"
}
set primes $stems
set stems {}
foreach s $primes {
for {set i 1} {$i < $base} {incr i} {
set n [expr {$b*$i + $s}]
if {[is_prime $n 1]} {
lappend stems $n
}
}
}
}
# Could be several at same length; choose largest
return [tcl::mathfunc::max {*}$primes]
}
for {set i 3} {$i <= 20} {incr i} {
puts "$i: [max_left_truncatable_prime $i]"
}</lang>
{{out|Output up to base 12 (tab-indented parts are progress messages)}}
<pre>
3: 23
4: 4091
5: 7817
6: 4836525320399
7: 817337
8: 14005650767869
9: 1676456897
4 candidates at length 1
11 candidates at length 2
39 candidates at length 3
99 candidates at length 4
192 candidates at length 5
326 candidates at length 6
429 candidates at length 7
521 candidates at length 8
545 candidates at length 9
517 candidates at length 10
448 candidates at length 11
354 candidates at length 12
276 candidates at length 13
212 candidates at length 14
117 candidates at length 15
72 candidates at length 16
42 candidates at length 17
24 candidates at length 18
13 candidates at length 19
6 candidates at length 20
5 candidates at length 21
4 candidates at length 22
3 candidates at length 23
1 candidates at length 24
10: 357686312646216567629137
4 candidates at length 1
8 candidates at length 2
15 candidates at length 3
18 candidates at length 4
15 candidates at length 5
8 candidates at length 6
4 candidates at length 7
2 candidates at length 8
1 candidates at length 9
11: 2276005673
5 candidates at length 1
23 candidates at length 2
119 candidates at length 3
409 candidates at length 4
1126 candidates at length 5
2504 candidates at length 6
4746 candidates at length 7
7727 candidates at length 8
11257 candidates at length 9
14860 candidates at length 10
17375 candidates at length 11
18817 candidates at length 12
19027 candidates at length 13
17594 candidates at length 14
15192 candidates at length 15
12106 candidates at length 16
9292 candidates at length 17
6621 candidates at length 18
4466 candidates at length 19
2889 candidates at length 20
1799 candidates at length 21
1109 candidates at length 22
601 candidates at length 23
346 candidates at length 24
181 candidates at length 25
103 candidates at length 26
49 candidates at length 27
19 candidates at length 28
8 candidates at length 29
2 candidates at length 30
1 candidates at length 31
1 candidates at length 32
12: 13092430647736190817303130065827539
5 candidates at length 1
13 candidates at length 2
20 candidates at length 3
23 candidates at length 4
17 candidates at length 5
11 candidates at length 6
7 candidates at length 7
4 candidates at length 8
13: 812751503
</pre>
I think I'll need to find a faster computer to calculate much more of the sequence, but memory consumption is currently negligible so there's no reason to expect there to be any major problems.
| |||