#!/bin/sh # # Self-erasure surviving numbers: as defined by Eric Angelini in # # # Tcl implementation by Michael A. Cleverly # # #\ exec tclsh "$0" ${1+"$@"} package require Tcl 8.2 proc pretty {digits candidate RE pos length} { array set map [list "!" "(1)" "@" "(2)" "#" "(3)" "$" "(4)" "%" "(5)" \ "^" "(6)" "&" "(7)" "*" "(8)" "(" "(9)" ")" "(0)" \ 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 0 0] set progress "" foreach char [split $digits ""] { append progress $map($char) } append progress \n for {set i 0} {$i <= $pos} {incr i} { if {[string is integer [string index $digits $i]]} then { append progress "^" } else { append progress " " } } for {} {$i < $length} {incr i} { if {[regexp "^$RE" [string range $digits $i end]]} then { append progress " " append progress [string repeat ! [string length $candidate]] append progress " " break } else { if {[string is integer [string index $digits $i]]} then { append progress " " } else { append progress " " } } } puts stderr [string trimright $progress] } proc SESN {candidate {infinity 20} {debug 0}} { set digits [string repeat $candidate $infinity] set length [string length $digits] set RE [format {[%1$s]%2$d[%1$s]} {!@#$%^&*()} $candidate] array set map [list 1 ! 2 @ 3 # 4 $ 5 % 6 ^ 7 & 8 * 9 ( 0 )] set pos -1 # ALGORITHM: # # 1. read the leftmost digit, X # 2. jump over X non-erased digits, erase the one to the right # 3. repeat until "(deleted) candidate (deleted)" if {$debug} then {puts stderr $digits} while {![regexp -- $RE $digits] && $pos < $length} { while {![string is integer [set n [string index $digits [incr pos]]]]} { } if {$n == ""} then break set move $pos for {set i 0} {$i <= $n && $move < $length && [incr move]} {} { if {[string is integer [set x [string index $digits $move]]]} then { incr i } } if {$x == ""} then break set digits [string replace $digits $move $move $map($x)] if {$debug} then {pretty $digits $candidate $RE $pos $length} } #if {$debug} then {pretty $digits $candidate $RE $pos $length} return [regexp -- $RE $digits] } if {!$tcl_interactive} then { set candidate [lindex $argv 0] if {![string is integer -strict $candidate] || $candidate < 0} then { puts stderr "Usage: $argv0 candidate-number ?depth-of-infinity?" exit 2 } set infinity [lindex $argv 1] if {![string is integer -strict $infinity] || $infinity < 0} then { set infinity 20 } set debug 1 if {[SESN $candidate $infinity $debug]} then { puts "$candidate is a Self-Erasure Surviving Number (SESN)!" exit 0 } else { set n_digits [string length [string repeat $candidate $infinity]] puts "$candidate has not proven itself to be a SESN within the span of\ its first $n_digits digits" exit 1 } }