Data update

This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions

View file

@ -0,0 +1,120 @@
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Fraction_Reduction is
type Int_Array is array (Natural range <>) of Integer;
function indexOf(haystack : Int_Array; needle : Integer) return Integer is
idx : Integer := 0;
begin
for straw of haystack loop
if straw = needle then
return idx;
else
idx := idx + 1;
end if;
end loop;
return -1;
end IndexOf;
function getDigits(n, le : in Integer;
digit_array : in out Int_Array) return Boolean is
n_local : Integer := n;
le_local : Integer := le;
r : Integer;
begin
while n_local > 0 loop
r := n_local mod 10;
if r = 0 or indexOf(digit_array, r) >= 0 then
return False;
end if;
le_local := le_local - 1;
digit_array(le_local) := r;
n_local := n_local / 10;
end loop;
return True;
end getDigits;
function removeDigit(digit_array : Int_Array;
le, idx : Integer) return Integer is
sum : Integer := 0;
pow : Integer := 10 ** (le - 2);
begin
for i in 0 .. le - 1 loop
if i /= idx then
sum := sum + digit_array(i) * pow;
pow := pow / 10;
end if;
end loop;
return sum;
end removeDigit;
lims : constant array (0 .. 3) of Int_Array (0 .. 1) :=
((12, 97), (123, 986), (1234, 9875), (12345, 98764));
count : Int_Array (0 .. 4) := (others => 0);
omitted : array (0 .. 4) of Int_Array (0 .. 9) :=
(others => (others => 0));
begin
Ada.Integer_Text_IO.Default_Width := 0;
for i in lims'Range loop
declare
nDigits, dDigits : Int_Array (0 .. i + 1);
digit, dix, rn, rd : Integer;
begin
for n in lims(i)(0) .. lims(i)(1) loop
nDigits := (others => 0);
if getDigits(n, i + 2, nDigits) then
for d in n + 1 .. lims(i)(1) + 1 loop
dDigits := (others => 0);
if getDigits(d, i + 2, dDigits) then
for nix in nDigits'Range loop
digit := nDigits(nix);
dix := indexOf(dDigits, digit);
if dix >= 0 then
rn := removeDigit(nDigits, i + 2, nix);
rd := removeDigit(dDigits, i + 2, dix);
-- 'n/d = rn/rd' is same as 'n*rd = rn*d'
if n*rd = rn*d then
count(i) := count(i) + 1;
omitted(i)(digit) :=
omitted(i)(digit) + 1;
if count(i) <= 12 then
Put (n);
Put ("/");
Put (d);
Put (" = ");
Put (rn);
Put ("/");
Put (rd);
Put (" by omitting ");
Put (digit);
Put_Line ("'s");
end if;
end if;
end if;
end loop;
end if;
end loop;
end if;
end loop;
end;
New_Line;
end loop;
for i in 2 .. 5 loop
Put ("There are ");
Put (count(i - 2));
Put (" ");
Put (i);
Put_Line ("-digit fractions of which:");
for j in 1 .. 9 loop
if omitted(i - 2)(j) /= 0 then
Put (omitted(i - 2)(j), Width => 6);
Put (" have ");
Put (j);
Put_Line ("'s omitted");
end if;
end loop;
New_Line;
end loop;
end Fraction_Reduction;

View file

@ -0,0 +1,175 @@
! Fraction reduction
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.10
! GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0 on Kubuntu 25.10
! VSI Fortran x86-64 V8.7-001 on OpenVMS x86_64 V9.2-3
! No Non-standard features used, should compile on any fairly recent Fortran.
! U.B., February 2026
!=========================================================================================
program digit_cancel
implicit none
integer, dimension(4,2) :: lims
integer, dimension(4) :: count
integer, dimension(4,10):: omitted
integer :: i, j, n, d
integer :: nix, dix, digit
integer :: rn, rd
integer :: le
logical :: nOk, dOk
integer, allocatable :: nDigits(:)
integer, allocatable :: dDigits(:)
lims(1,:) = [12, 97]
lims(2,:) = [123, 986]
lims(3,:) = [1234, 9875]
lims(4,:) = [12345, 98764]
count = 0
omitted = 0
do i = 1, size(lims,1)
le = i + 1
allocate(nDigits(le))
allocate(dDigits(le))
do n = lims(i,1), lims(i,2)
nDigits = 0
nOk = getDigits(n, le, nDigits)
if (.not. nOk) cycle
do d = n + 1, lims(i,2) + 1
dDigits = 0
dOk = getDigits(d, le, dDigits)
if (.not. dOk) cycle
do nix = 1, le
digit = nDigits(nix)
dix = indexOf(dDigits, digit)
if (dix >= 1) then
rn = removeDigit(nDigits, le, nix)
rd = removeDigit(dDigits, le, dix)
if (rd /= 0) then
! Use integer multiplication instead of floating point division
if (n*rd == rn*d) then
count(i) = count(i) + 1
omitted(i, digit) = omitted(i, digit) + 1
if (count(i) <= 12) then
write(*,'(i0,"/",i0," = ",i0,"/",i0," by omitting ",i0,"''s")') &
n, d, rn, rd, digit
end if
end if
end if
end if
end do
end do
end do
write(*,*)
deallocate(nDigits, dDigits)
end do
do i = 2, 5
write(*,'("There are ",i0," ",i0,"-digit fractions of which:")') count(i-1), i
do j = 1, 9
if (omitted(i-1,j) == 0) cycle
write(*,'(i6," have ",i0,"''s omitted")') omitted(i-1,j), j
end do
write(*,*)
end do
contains
integer function indexOf(haystack, needle)
implicit none
integer, intent(in) :: haystack(:)
integer, intent(in) :: needle
integer :: k
indexOf = -1
do k = 1, size(haystack)
if (haystack(k) == needle) then
indexOf = k
return
end if
end do
end function indexOf
logical function getDigits(n, le, digits)
implicit none
integer, intent(in) :: n, le
integer, intent(inout) :: digits(:)
integer :: tmp, r, pos
tmp = n
pos = le
do while (tmp > 0)
r = mod(tmp, 10)
if (r == 0 .or. indexOf(digits, r) >= 1) then
getDigits = .false.
return
end if
digits(pos) = r
pos = pos - 1
tmp = tmp / 10
end do
getDigits = .true.
end function getDigits
integer function removeDigit(digits, le, idx)
implicit none
integer, intent(in) :: digits(:)
integer, intent(in) :: le, idx
integer, dimension(5) :: pows = [1,10,100,1000,10000]
integer :: i, pow, sum
sum = 0
! Important: le-1 and NOT le-2 (C++ 0-based vs Fortran 1-based)
pow = pows(le-1)
do i = 1, le
if (i == idx) cycle
sum = sum + digits(i) * pow
pow = pow / 10
end do
removeDigit = sum
end function removeDigit
end program digit_cancel

View file

@ -20,9 +20,9 @@ assert -. common 1 2 3
o=: '123456789' {~ [: -.@:common"1 Filter odometer@:(#&9) NB. o is y unique digits, all of them
f=: ,:"1/&g~ NB. f computes a table of all numerators and denominators pairs
f=: ,:"1/&g~ NB. f computes a table of all numerators and denominators pairs
mask=: [: </~&i. # NB. the lower triangle will become proper fractions
mask=: [: </~&i. # NB. the lower triangle will become proper fractions
av=: (([: , mask) # ,/)@:f NB. anti-vulgarization

View file

@ -0,0 +1,87 @@
function indexOf(haystack, needle) {
for (let i = 0; i < haystack.length; i++) {
if (haystack[i] === needle) {
return i;
}
}
return -1;
}
function getDigits(n, le, digits) {
while (n > 0) {
const r = n % 10;
if (r === 0 || indexOf(digits, r) >= 0) {
return false;
}
le--;
digits[le] = r;
n = Math.floor(n / 10);
}
return true;
}
function removeDigit(digits, le, idx) {
const pows = [1, 10, 100, 1000, 10000];
let sum = 0;
let pow = pows[le - 2];
for (let i = 0; i < le; i++) {
if (i === idx) continue;
sum += digits[i] * pow;
pow /= 10;
}
return sum;
}
function main() {
const lims = [[12, 97], [123, 986], [1234, 9875], [12345, 98764]];
const count = [0, 0, 0, 0, 0];
const omitted = Array.from({ length: 5 }, () => new Array(10).fill(0));
for (let i = 0; i < lims.length; i++) {
const nDigits = new Array(i + 2).fill(0);
const dDigits = new Array(i + 2).fill(0);
for (let n = lims[i][0]; n <= lims[i][1]; n++) {
nDigits.fill(0);
const nOk = getDigits(n, i + 2, nDigits);
if (!nOk) {
continue;
}
for (let d = n + 1; d <= lims[i][1] + 1; d++) {
dDigits.fill(0);
const dOk = getDigits(d, i + 2, dDigits);
if (!dOk) {
continue;
}
for (let nix = 0; nix < nDigits.length; nix++) {
const digit = nDigits[nix];
const dix = indexOf(dDigits, digit);
if (dix >= 0) {
const rn = removeDigit(nDigits, i + 2, nix);
const rd = removeDigit(dDigits, i + 2, dix);
if ((n / d) === (rn / rd)) {
count[i]++;
omitted[i][digit]++;
if (count[i] <= 12) {
console.log(`${n}/${d} = ${rn}/${rd} by omitting ${digit}'s`);
}
}
}
}
}
}
console.log();
}
for (let i = 2; i <= 5; i++) {
console.log(`There are ${count[i - 2]} ${i}-digit fractions of which:`);
for (let j = 1; j <= 9; j++) {
if (omitted[i - 2][j] === 0) {
continue;
}
console.log(`${omitted[i - 2][j].toString().padStart(6)} have ${j}'s omitted`);
}
console.log();
}
}
main();

View file

@ -0,0 +1,106 @@
Rebol [
title: "Rosetta code: Fraction reduction"
file: %Fraction_reduction.r3
url: https://rosettacode.org/wiki/Fraction_reduction
needs: 3.21.5
]
unless native? :idivide [
;; backward compatibility
idivide: func[a b][to integer! (a / b)]
]
fraction-reduction: function/with [
lo [integer!] "lower bound of range"
hi [integer!] "upper bound of range"
/verbose
][
len: length? form hi ;; number of digits
omitted: array/initial 9 0 ;; ommitted digits counters
n-digits: clear [] ;; digit buffer for numerator
d-digits: clear [] ;; digit buffer for denominator
count: 0
for n lo hi 1 [
unless get-digits n len n-digits [continue] ;; skip numbers that don't qualify
for d n + 1 hi + 1 1 [
;; extract and validate denominator digits
unless get-digits d len d-digits [continue] ;; skip invalid denominators
repeat ni len [
all [
nv: n-digits/:ni ;; get numerator digit
di: index? find d-digits nv ;; find matching digit in denominator
rn: remove-digit n-digits len ni ;; numerator with shared digit removed
rd: remove-digit d-digits len di ;; denominator with shared digit removed
n * rd == (rn * d) ;; cross-multiply to check n/d = rn/rd
++ count ;; increment match counter
omitted/:nv: omitted/:nv + 1 ;; track which digit was cancelled
verbose ;; check if output is needed
prin [CR n "/" d "=" rn "/" rd "by omitting" nv "'s"]
count <= 12 ;; only print first 12 matches
prin LF ;; newline after match
]
]
]
]
if verbose [print "^M^[[K"] ;; clear last line
;; return output as a map
compose/only #[
digit: (len)
count: (count)
omitted: (omitted)
]
][
get-digits: function/with [
;; extract digits of n, reject if invalid (zero digit, repeated digit)
num len digits
][
if invalid/:num [return false]
n: num
append/dup clear digits 0 len ;; reset digit buffer
while [n > 0][
r: n % 10
if find digits r [
invalid/:num: true
return false
]
digits/:len: r
-- len
n: idivide n 10
]
true
][
;; cache invalid numbers
invalid: make bitset! []
]
remove-digit: function [digits len idx][
sum: 0
pow: pick [1 10 100 1000 10000] len - 1
repeat i len [
if i = idx [continue]
sum: sum + (digits/:i * pow)
pow: idivide pow 10
]
sum
]
]
ranges: [
12 97
123 986
1234 9875
;12345 98764
]
foreach [lo hi] ranges [
print [as-yellow "Using range:" lo "to" hi]
res: fraction-reduction/verbose lo hi
print rejoin ["There are " res/count " " res/digit "-digit fractions of which:"]
repeat i 9 [
unless zero? v: res/omitted/:i [
print rejoin [pad v -6 " have " i "'s omitted"]
]
]
print ""
]

View file

@ -15,21 +15,21 @@ fcn nDigits(n){
found:=False;
foreach i in ([n-1..0, -1]){
d:=digits[i];
if(not used[d-1]) println("ack!");
used[d-1]=0;
foreach j in ([d..8]){
if(not used[j]){
used[j]=1;
digits[i]=j+1;
foreach k in ([i+1..n-1]){
digits[k] = used.find(0) + 1;
used[digits[k] - 1]=1;
}
found=True;
break;
}
}
if(found) break;
if(not used[d-1]) println("ack!");
used[d-1]=0;
foreach j in ([d..8]){
if(not used[j]){
used[j]=1;
digits[i]=j+1;
foreach k in ([i+1..n-1]){
digits[k] = used.find(0) + 1;
used[digits[k] - 1]=1;
}
found=True;
break;
}
}
if(found) break;
}//foreach i
if(not found) break;
}//while
@ -42,16 +42,16 @@ foreach n in ([2..5]){
xn,rn := rs[i];
foreach j in ([i+1..rsz]){
xd,rd := rs[j];
foreach k in ([0..8]){
yn,yd := rn[k],rd[k];
if(yn!=0 and yd!=0 and
xn.toFloat()/xd.toFloat() == yn.toFloat()/yd.toFloat()){
count+=1;
omitted[k]+=1;
if(count<=12)
println("%d/%d --> %d/%d (removed %d)".fmt(xn,xd,yn,yd,k+1));
}
}
foreach k in ([0..8]){
yn,yd := rn[k],rd[k];
if(yn!=0 and yd!=0 and
xn.toFloat()/xd.toFloat() == yn.toFloat()/yd.toFloat()){
count+=1;
omitted[k]+=1;
if(count<=12)
println("%d/%d --> %d/%d (removed %d)".fmt(xn,xd,yn,yd,k+1));
}
}
}
}
println("%d-digit fractions found: %d, omitted %s\n"