AXIOM, 753 bytes
L==>List FRAC INT
macro M(q)==if c<m or(c=m and m<999 and reduce(max,map(denom,q))<xv)then(m:=c;a:=q;xv:=reduce(max,map(denom,a)))
f(x,n)==(y:=x;a:L:=[];c:=0;q:=denom x;q:=q^4;for i in n.. repeat((c:=c+1)>50=>(a:=[];break);1/i>y=>1;member?(1/i,a)=>1;a:=concat(a,1/i);(y:=y-1/i)=0=>break;numer(y)=1 and ~member?(y,a)=>(a:=concat(a,y);break);(i:=floor(1/y))>q=>(a:=[];break));a)
h(x:FRAC INT):L==(a:L:=[];x>1=>a;numer(x)=1=>[x];n:=max(2,floor(1/x));xv:=m:=999;d:=denom x;zd:=divisors d;z:=copy zd;for i in 2..30 repeat z:=concat(z,i*zd);d:=min(10*d,n+9*m);for i in n..d repeat((c:=maxIndex(b:=f(x,i)))=0=>1;c>m+1=>1;M(b);v:=reduce(+,delete(b,1));for j in z repeat((c:=1+maxIndex(q:=f(v,j)))=1=>1;member?(b.1,q)=>1;q:=concat(b.1,q);M(q)));reverse(sort a))
A idéia seria aplicar o "algoritmo ganancioso" com diferentes pontos iniciais e salvar a lista que tem tamanho mínimo. Mas nem sempre ela encontraria a solução mínima com menos difinida: "a matriz A será menor que a matriz B se e somente se A tiver poucos elementos de B, ou se o número de elementos de A for o mesmo número de elementos de B , que A é menor que B se o menor elemento de A for maior como número, que o menor elemento de B ". Ungolfed e teste
-- this would be the "Greedy Algorithm"
fracR(x,n)==
y:=x;a:L:=[];c:=0;q:=denom x;q:=q^4
for i in n.. repeat
(c:=c+1)>50 =>(a:=[];break)
1/i>y =>1
member?(1/i,a)=>1
a:=concat(a,1/i)
(y:=y-1/i)=0 =>break
numer(y)=1 and ~member?(y,a)=>(a:=concat(a,y);break)
(i:=floor(1/y))>q =>(a:=[];break)
a
-- Return one List a=[1/x1,...,1/xn] with xn PI and x=r/s=reduce(+,a) or return [] for fail
Frazione2SommaReciproci(x:FRAC INT):L==
a:L:=[]
x>1 =>a
numer(x)=1=>[x]
n:=max(2,floor(1/x));xv:=m:=999;d:=denom x;zd:=divisors d;z:=copy zd
for i in 2..30 repeat z:=concat(z,i*zd)
d:=min(10*d,n+9*m)
for i in n..d repeat
(c:=maxIndex(b:=fracR(x,i)))=0=>1
c>m+1 =>1
M(b)
v:=reduce(+,delete(b,1))
for j in z repeat
(c:=1+maxIndex(q:=fracR(v,j)))=1=>1
member?(b.1,q) =>1
q:=concat(b.1,q)
M(q)
reverse(sort a)
(7) -> [[i,h(i)] for i in [1/23,2/23,43/48,8/11,5/121,2020/2064,6745/7604,77/79,732/733]]
(7)
1 1 2 1 1 43 1 1 1 8 1 1 1 1
[[--,[--]], [--,[--,---]], [--,[-,-,--]], [--,[-,-,--,--]],
23 23 23 12 276 48 2 3 16 11 2 6 22 66
5 1 1 1 505 1 1 1 1 1
[---,[--,---,---]], [---,[-,-,-,---,----]],
121 33 121 363 516 2 3 7 602 1204
6745 1 1 1 1 1 1 77 1 1 1 1 1 1
[----,[-,-,--,---,-----,------]], [--,[-,-,-,--,---,---]],
7604 2 3 19 950 72238 570300 79 2 3 8 79 474 632
732 1 1 1 1 1 1 1
[---,[-,-,-,--,----,-----,-----]]]
733 2 3 7 45 7330 20524 26388
Type: List List Any
Time: 0.07 (IN) + 200.50 (EV) + 0.03 (OT) + 9.28 (GC) = 209.88 sec
(8) -> h(124547787/123456789456123456)
(8)
1 1 1
[---------, ---------------, ---------------------------------,
991247326 140441667310032 613970685539400439432280360548704
1
-------------------------------------------------------------------]
3855153765004125533560441957890277453240310786542602992016409976384
Type: List Fraction Integer
Time: 17.73 (EV) + 0.02 (OT) + 1.08 (GC) = 18.83 sec
(9) -> h(27538/27539)
1 1 1 1 1 1 1 1
(9) [-,-,-,--,---,-----,------,----------]
2 3 7 52 225 10332 826170 1100871525
Type: List Fraction Integer
Time: 0.02 (IN) + 28.08 (EV) + 1.28 (GC) = 29.38 sec
referência e números de: http://www.maths.surrey.ac.uk/hosted-sites/R.Knott/Fractions/egyptian.html
para adicionar algo, este abaixo seria o otimizado para encontrar a fração de comprimento mínimo que possui o denominador máximo menor (e não otimizado para o comprimento)
L==>List FRAC INT
-- this would be the "Greedy Algorithm"
fracR(x,n)==
y:=x;a:L:=[];c:=0;q:=denom x;q:=q^20
for i in n.. repeat
(c:=c+1)>1000 =>(a:=[];break)
1/i>y =>1
member?(1/i,a) =>1
a:=concat(a,1/i)
(y:=y-1/i)=0 =>break
numer(y)=1 and ~member?(y,a)=>(a:=concat(a,y);break)
(i:=floor(1/y))>q =>(a:=[];break)
a
-- Return one List a=[1/x1,...,1/xn] with xn PI and x=r/s=reduce(+,a) or return [] for fail
Frazione2SommaReciproci(x:FRAC INT):L==
a:L:=[]
x>1 =>a
numer(x)=1=>[x]
n:=max(2,floor(1/x));xv:=m:=999;d:=denom x;zd:=divisors d;z:=copy zd;
w1:= if d>1.e10 then 1000 else 300; w2:= if d>1.e10 then 1000 else if d>1.e7 then 600 else if d>1.e5 then 500 else if d>1.e3 then 400 else 100;
for i in 2..w1 repeat(mt:=(i*zd)::List PI;mv:=[yy for yy in mt|yy>=n];z:=sort(removeDuplicates(concat(z,mv)));#z>w2=>break)
for i in z repeat
(c:=maxIndex(b:=fracR(x,i)))=0=>1
c>m+1 =>1
if c<m or(c=m and m<999 and reduce(max,map(denom,b))<xv)then(m:=c;a:=b;xv:=reduce(max,map(denom,a)))
v:=reduce(+,delete(b,1))
for j in z repeat
(c:=1+maxIndex(q:=fracR(v,j)))=1=>1
member?(b.1,q) =>1
q:=concat(b.1,q)
if c<m or(c=m and m<999 and reduce(max,map(denom,q))<xv)then(m:=c;a:=q;xv:=reduce(max,map(denom,a)))
reverse(sort a)
os resultados:
(5) -> [[i,Frazione2SommaReciproci(i)] for i in [1/23,2/23,43/48,8/11,5/121,2020/2064,6745/7604,77/79,732/733]]
(5)
1 1 2 1 1 43 1 1 1 8 1 1 1 1
[[--,[--]], [--,[--,---]], [--,[-,-,--]], [--,[-,-,--,--]],
23 23 23 12 276 48 2 3 16 11 2 6 22 66
5 1 1 1 505 1 1 1 1 1
[---,[--,---,---]], [---,[-,-,-,---,----]],
121 33 121 363 516 2 3 7 602 1204
6745 1 1 1 1 1 1 77 1 1 1 1 1 1
[----,[-,-,--,---,-----,------]], [--,[-,-,-,--,---,---]],
7604 2 3 19 950 72238 570300 79 2 3 8 79 474 632
732 1 1 1 1 1 1 1
[---,[-,-,-,--,----,-----,-----]]]
733 2 3 7 45 7330 20524 26388
Type: List List Any
Time: 0.08 (IN) + 53.45 (EV) + 3.03 (GC) = 56.57 sec
(6) -> Frazione2SommaReciproci(124547787/123456789456123456)
(6)
1 1 1 1
[---------, ------------, ----------------, -------------------,
994074172 347757767307 2764751529594496 1142210063701888512
1
-------------------------------------]
2531144929865351036156388364636113408
Type: List Fraction Integer
Time: 0.15 (IN) + 78.30 (EV) + 0.02 (OT) + 5.28 (GC) = 83.75 sec
(7) -> Frazione2SommaReciproci(27538/27539)
1 1 1 1 1 1 1 1
(7) [-,-,-,--,----,-------,-------,-------]
2 3 7 43 1935 3717765 5204871 7105062
Type: List Fraction Integer
Time: 0.05 (IN) + 45.43 (EV) + 2.42 (GC) = 47.90 sec
Parece que muitos bons denominadores têm como divisores de fator o denominador da fração de entrada.
8, 11
e2, 6, 22, 66
certo?