RosettaCodeData/Task/Lychrel-numbers/EasyLang/lychrel-numbers.easy
2026-04-30 12:34:36 -04:00

118 lines
2.6 KiB
Text

func[] bn s$ .
i = len s$ - 7 + 1
while i >= -5
r[] &= number substr s$ i 7
i -= 7
.
return r[]
.
func$ bns bn[] .
s$ = bn[$]
for i = len bn[] - 1 downto 1
h$ = bn[i]
s$ &= substr "0000000" 1 (7 - len h$) & h$
.
return s$
.
func[] bnadd a[] b[] .
if len b[] > len a[] : swap a[] b[]
len r[] len a[]
for i = 1 to len r[]
v = 0
if i <= len b[] : v = b[i]
h += a[i] + v
r[i] = h mod 10000000
h = h div 10000000
.
if h > 0 : r[] &= h
while len r[] > 1 and r[$] = 0 : len r[] -1
return r[]
.
func[] bnrev a[] .
for c$ in strchars bns a[] : r$ = c$ & r$
return bn r$
.
func bnpal a[] .
s$[] = strchars bns a[]
for i = 1 to len s$[] div 2
if s$[i] <> s$[$ - i + 1] : return 0
.
return 1
.
global seeds$[] lnkkey$[] lnkval$[] .
func idxof a$[] key$ .
for i = 1 to len a$[] : if a$[i] = key$ : return i
return 0
.
func maphas k$ .
return if idxof lnkkey$[] k$ <> 0
.
func$ mapget k$ .
p = idxof lnkkey$[] k$
if p = 0 : return ""
return lnkval$[p]
.
proc mapset k$ v$ .
p = idxof lnkkey$[] k$
if p = 0
lnkkey$[] &= k$
lnkval$[] &= v$
else
lnkval$[p] = v$
.
.
func isrelated k$ .
v$ = mapget k$
while v$ <> "" and maphas v$ = 1
v$ = mapget v$
.
return if idxof seeds$[] v$ <> 0
.
proc check_bn val[] .
num$ = bns val[]
if maphas num$ = 1 : return
for n = 1 to 500
rev[] = bnrev val[]
val[] = bnadd val[] rev[]
val$ = bns val[]
if maphas val$ = 1
mapset num$ mapget val$
return
.
if bnpal val[] = 1 : return
mapset val$ num$
.
seeds$[] &= num$
.
func related_cnt maxlen .
for k$ in lnkkey$[]
if len k$ <= maxlen and isrelated k$ = 1 : cnt += 1
.
return cnt
.
func[] pal_lychrel maxlen .
for s$ in seeds$[]
if len s$ <= maxlen and bnpal bn s$ = 1
res[] &= number s$
.
.
for s$ in lnkkey$[]
if len s$ <= maxlen and isrelated s$ = 1 and bnpal bn s$ = 1
res[] &= number s$
.
.
for i = 1 to len res[] - 1
for j = i + 1 to len res[]
if res[j] < res[i] : swap res[j] res[i]
.
.
return res[]
.
for n = 1 to 10000 : check_bn bn n
#
print "Found " & len seeds$[] & " candidate seed Lychrel numbers between 1 and 10000."
write "These candidate seed Lychrel numbers are: "
print strjoin seeds$[] " "
print "Found " & related_cnt 4 & " candidate related Lychrel numbers between 1 and 10000."
write "Palindromic candidate Lychrel numbers between 1 and 10000 are: "
print strjoin pal_lychrel 4 " "