Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,131 +0,0 @@
|
|||
with Ada.Text_IO;
|
||||
with Ada.Strings.Fixed;
|
||||
|
||||
procedure Kaprekar2 is
|
||||
use Ada.Strings.Fixed;
|
||||
|
||||
To_Digit : constant String := "0123456789abcdefghijklmnopqrstuvwxyz";
|
||||
|
||||
type Int is mod 2 ** 64;
|
||||
subtype Base_Number is Int range 2 .. 36;
|
||||
|
||||
From_Digit : constant array (Character) of Int :=
|
||||
('0' => 0,
|
||||
'1' => 1,
|
||||
'2' => 2,
|
||||
'3' => 3,
|
||||
'4' => 4,
|
||||
'5' => 5,
|
||||
'6' => 6,
|
||||
'7' => 7,
|
||||
'8' => 8,
|
||||
'9' => 9,
|
||||
'a' => 10,
|
||||
'b' => 11,
|
||||
'c' => 12,
|
||||
'd' => 13,
|
||||
'e' => 14,
|
||||
'f' => 15,
|
||||
'g' => 16,
|
||||
'h' => 17,
|
||||
'i' => 18,
|
||||
'j' => 19,
|
||||
'k' => 20,
|
||||
'l' => 21,
|
||||
'm' => 22,
|
||||
'n' => 23,
|
||||
'o' => 24,
|
||||
'p' => 25,
|
||||
'q' => 26,
|
||||
'r' => 27,
|
||||
's' => 28,
|
||||
't' => 29,
|
||||
'u' => 30,
|
||||
'v' => 31,
|
||||
'w' => 32,
|
||||
'x' => 33,
|
||||
'y' => 34,
|
||||
'z' => 35,
|
||||
others => 0);
|
||||
|
||||
function To_String (Item : Int; Base : Base_Number := 10) return String is
|
||||
Value : Int := Item;
|
||||
Digit_Index : Natural;
|
||||
Result : String (1 .. 64);
|
||||
First : Natural := Result'Last;
|
||||
begin
|
||||
while Value > 0 loop
|
||||
Digit_Index := Natural (Value mod Base);
|
||||
Result (First) := To_Digit (Digit_Index + 1);
|
||||
Value := Value / Base;
|
||||
First := First - 1;
|
||||
end loop;
|
||||
return Result (First + 1 .. Result'Last);
|
||||
end To_String;
|
||||
|
||||
procedure Get (From : String; Item : out Int; Base : Base_Number := 10) is
|
||||
begin
|
||||
Item := 0;
|
||||
for I in From'Range loop
|
||||
Item := Item * Base;
|
||||
Item := Item + From_Digit (From (I));
|
||||
end loop;
|
||||
end Get;
|
||||
|
||||
function Is_Kaprekar (N : Int; Base : Base_Number := 10) return Boolean is
|
||||
Square : Int;
|
||||
begin
|
||||
if N = 1 then
|
||||
return True;
|
||||
else
|
||||
Square := N ** 2;
|
||||
declare
|
||||
Image : String := To_String (Square, Base);
|
||||
A, B : Int;
|
||||
begin
|
||||
for I in Image'First .. Image'Last - 1 loop
|
||||
exit when Count (Image (I + 1 .. Image'Last), "0")
|
||||
= Image'Last - I;
|
||||
Get (From => Image (Image'First .. I),
|
||||
Item => A,
|
||||
Base => Base);
|
||||
Get (From => Image (I + 1 .. Image'Last),
|
||||
Item => B,
|
||||
Base => Base);
|
||||
if A + B = N then
|
||||
return True;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
return False;
|
||||
end Is_Kaprekar;
|
||||
|
||||
Count : Natural := 0;
|
||||
begin
|
||||
for I in Int range 1 .. 10_000 loop
|
||||
if Is_Kaprekar (I) then
|
||||
Count := Count + 1;
|
||||
Ada.Text_IO.Put (To_String (I) & ",");
|
||||
end if;
|
||||
end loop;
|
||||
Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));
|
||||
|
||||
for I in Int range 10_001 .. 1_000_000 loop
|
||||
if Is_Kaprekar (I) then
|
||||
Count := Count + 1;
|
||||
end if;
|
||||
end loop;
|
||||
Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000:" &
|
||||
Integer'Image (Count));
|
||||
|
||||
Count := 0;
|
||||
Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000 in base 17:");
|
||||
for I in Int range 1 .. 17 ** 6 loop
|
||||
if Is_Kaprekar (I, 17) then
|
||||
Count := Count + 1;
|
||||
Ada.Text_IO.Put (To_String (I, 17) & ",");
|
||||
end if;
|
||||
end loop;
|
||||
Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));
|
||||
end Kaprekar2;
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
k?: function [n][
|
||||
kaprekar?: function [n][
|
||||
n2: to :string n*n
|
||||
loop 0..dec size n2 'i [
|
||||
a: (i > 0)? -> to :integer slice n2 0 dec i -> 0
|
||||
|
|
@ -9,5 +9,5 @@ k?: function [n][
|
|||
]
|
||||
|
||||
loop 1..10000 'x [
|
||||
if k? x -> print x
|
||||
if kaprekar? x -> print x
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,25 +0,0 @@
|
|||
function Test-Kaprekar ([int]$Number)
|
||||
{
|
||||
if ($Number -eq 1)
|
||||
{
|
||||
return $true
|
||||
}
|
||||
|
||||
[int64]$a = $Number * $Number
|
||||
[int64]$b = 10
|
||||
|
||||
while ($b -lt $a)
|
||||
{
|
||||
[int64]$remainder = $a % $b
|
||||
[int64]$quotient = ($a - $remainder) / $b
|
||||
|
||||
if ($remainder -gt 0 -and $remainder + $quotient -eq $Number)
|
||||
{
|
||||
return $true
|
||||
}
|
||||
|
||||
$b *= 10
|
||||
}
|
||||
|
||||
return $false
|
||||
}
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
"Kaprekar numbers less than 10,000:"
|
||||
1..10000 | ForEach-Object {if (Test-Kaprekar -Number $_) {"{0,6}" -f $_}} | Format-Wide {$_} -Column 17 -Force
|
||||
|
||||
"Kaprekar numbers less than 1,000,000:"
|
||||
1..1000000 | ForEach-Object {if (Test-Kaprekar -Number $_) {"{0,6}" -f $_}} | Format-Wide {$_} -Column 18 -Force
|
||||
|
|
@ -1,26 +1,182 @@
|
|||
/*REXX pgm generates & counts (& maybe shows) some Kaprekar #s using the cast─out─9 test*/
|
||||
parse arg A B . /*obtain optional arguments from the CL*/
|
||||
if A=='' | A="," then A= 10000 /*Not specified? Then use the default.*/
|
||||
if B=='' | B="," then B= -1000000 /* " " " " " " */
|
||||
call Kaprekar A /*gen Kaprekar numbers and display 'em.*/
|
||||
call Kaprekar B /* " " " don't " " */
|
||||
exit 0 /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Kaprekar: procedure; parse arg N; aN= abs(N) /*obtain the limit; use │N│ value. */
|
||||
numeric digits max(9, 2 * length(aN) ) /*use enough decimal digits for square.*/
|
||||
d= digits(); tell= N>0 /*set D to number of digits; set TELL.*/
|
||||
#= 0; if aN>0 then do; #= 1; if tell then say right(1, d); end
|
||||
/* [↑] handle case of N being unity.*/
|
||||
if aN>1 then do j=9 for aN-9; /*calculate the square of J (S). */
|
||||
jc= j//9 /*JC: J modulo 9 (cast out nines). */
|
||||
if jc >2 then iterate /*Is J mod 9 > two? Then skip this J.*/
|
||||
s= j*j /*calculate the square of J (S). */
|
||||
if jc==s//9 then do k=1 for length(s)%2 /*≡ casted out 9's? */
|
||||
parse var s L +(k) R
|
||||
if j\==L+R then iterate
|
||||
#= # + 1; if tell then say right(j, d); leave
|
||||
end /*k*/
|
||||
end /*j*/
|
||||
say
|
||||
say center(" There're " # ' Kaprekar numbers below ' aN" ", 79, "═")
|
||||
return
|
||||
-- 15 Nov 2025
|
||||
include Setting
|
||||
numeric digits 30
|
||||
|
||||
say 'KAPREKAR NUMBERS'
|
||||
say version
|
||||
say
|
||||
-- Brute-force
|
||||
call Task1 1E4
|
||||
call Task1 1E6
|
||||
call Timer 'r'
|
||||
-- Generator
|
||||
call Generator 1E9
|
||||
call Task2 1E9
|
||||
call Timer 'r'
|
||||
-- Generator stretched
|
||||
call Generator 1E15
|
||||
call Task2 1E12
|
||||
call Task3 1E15
|
||||
call Timer 'r'
|
||||
-- Definition base NN
|
||||
call Task4 1E6,17
|
||||
call Task4 1E6,36
|
||||
call Timer 'r'
|
||||
exit
|
||||
|
||||
Task1:
|
||||
-- Shows Kaprekar numbers below threshold
|
||||
-- Brute-force casting out nines
|
||||
procedure
|
||||
arg xx
|
||||
say 'Brute-force: Kaprekar numbers up to' xx
|
||||
call CharOut ,Right(1,14)
|
||||
n=1
|
||||
do i=9 for xx-9
|
||||
a=i//9
|
||||
if a>2 then
|
||||
iterate i
|
||||
s=i*i
|
||||
if a=s//9 then do
|
||||
do j=1 to Length(s)%2
|
||||
parse var s l +(j) r
|
||||
if i<>l+r then
|
||||
iterate j
|
||||
n+=1
|
||||
call CharOut ,Right(i,14)
|
||||
if n//5=0 then
|
||||
say
|
||||
leave
|
||||
end j
|
||||
end
|
||||
end i
|
||||
say
|
||||
say n 'found'
|
||||
say
|
||||
return
|
||||
|
||||
Generator:
|
||||
-- Generate Kaprekar numbers up to threshold*10
|
||||
-- Cf paper 'The Kaprekar numbers' Iannuci 2000
|
||||
procedure expose Divi. Kapr. Memo. Udiv.
|
||||
arg xx
|
||||
say 'Generate up to 10x'xx'...'
|
||||
xx*=10
|
||||
Kapr.=1; n=1
|
||||
do y=1 until yy=xx-1
|
||||
yy=10**y-1; n+=1; Kapr.n=yy
|
||||
u=UnitDivs(yy)
|
||||
do i=2 to u%2
|
||||
d=Udiv.i; k=d*ModMultInv(d,(yy)/d); n+=1; Kapr.n=k
|
||||
k=yy-k+1; n+=1; Kapr.n=k
|
||||
end i
|
||||
end y
|
||||
Kapr.0=n
|
||||
call Sort 'Kapr.'
|
||||
say n 'found'
|
||||
say
|
||||
return 0
|
||||
|
||||
UnitDivs:
|
||||
-- Unitary divisors of an integer
|
||||
procedure expose Divi. Memo. Udiv.
|
||||
arg xx
|
||||
-- Fast
|
||||
Udiv.=1
|
||||
if xx=1 then
|
||||
return 1
|
||||
call DivisorS xx
|
||||
rr=1
|
||||
do i=2 to Divi.0
|
||||
a=Divi.i
|
||||
if Gcd(a,xx/a)=1 then do
|
||||
rr+=1; Udiv.rr=a
|
||||
end
|
||||
end
|
||||
Udiv.0=rr
|
||||
return rr
|
||||
|
||||
ModMultInv:
|
||||
-- Modular multiplicative inverse
|
||||
-- Extended Euclidian algorithm
|
||||
procedure
|
||||
arg xx,yy
|
||||
if yy=1 then
|
||||
return 1
|
||||
rr=0; nr=1; aa=yy; na=xx
|
||||
do while na <> 0
|
||||
q=aa%na
|
||||
parse value nr rr-q*nr with rr nr
|
||||
parse value na aa-q*na with aa na
|
||||
end
|
||||
if aa>1 then
|
||||
rr=0
|
||||
if rr<0 then
|
||||
rr+=yy
|
||||
return rr
|
||||
|
||||
Task2:
|
||||
-- Shows numbers from the generated array
|
||||
procedure expose Kapr.
|
||||
arg xx
|
||||
say 'Generator: Kaprekar numbers up to' xx
|
||||
do i=1 to Kapr.0 until Kapr.i=xx-1
|
||||
call CharOut ,Right(Kapr.i,14)
|
||||
if i//5=0 then
|
||||
say
|
||||
end
|
||||
say
|
||||
say i 'found'
|
||||
say
|
||||
return 0
|
||||
|
||||
Task3:
|
||||
-- Shows count from the generated array
|
||||
procedure expose Kapr.
|
||||
arg xx
|
||||
say 'Generator: Kaprekar number count'
|
||||
p=1; pp=10
|
||||
do i=1 to Kapr.0
|
||||
if Kapr.i>pp then do
|
||||
say 'There are' Right(i-1,3) 'Kaprekar numbers below 10^'p
|
||||
p+=1; pp*=10
|
||||
end
|
||||
end
|
||||
say
|
||||
return 0
|
||||
|
||||
Task4:
|
||||
-- Shows Kaprekar numbers below threshold in base 17
|
||||
-- Brute-force method cf definition
|
||||
procedure
|
||||
arg xx,yy
|
||||
say 'Brute-force: Kaprekar numbers up to' xx 'in base'yy
|
||||
say 'No Base10 Base'yy 'Square Sum'
|
||||
say 1
|
||||
n=1
|
||||
do i=2 to xx
|
||||
ib=D2n(i,yy); j=i*i; jb=D2n(j,yy); jl=Length(jb)
|
||||
do k=2 to jl%2+1
|
||||
lb=Left(jb,k-1); rb=Right(jb,jl-k+1)
|
||||
if rb=0 then
|
||||
leave k
|
||||
if AddB(lb,rb,yy)=ib then do
|
||||
n+=1
|
||||
say Left(n,3) Left(i,7) Left(ib,6) Left(jb,10) Left(lb'+'rb,10)
|
||||
end
|
||||
end k
|
||||
end i
|
||||
say
|
||||
return
|
||||
|
||||
-- AddB (add 2 numbers in base n)
|
||||
-- D2n (convert decimal to base n)
|
||||
include Base
|
||||
-- DivisorS (find all divisors)
|
||||
include Sequence
|
||||
-- Gcd (greatest common divisor)
|
||||
include Special
|
||||
-- Sort (sort array)
|
||||
include Utility
|
||||
-- Timer
|
||||
include Timer
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue