Unitary Amicable Pair

Author

Eric W. Weisstein
February 1, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/NumberTheory/UnitaryAmicablePair.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/UnitaryAmicablePair.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Enumeration

<<DiscreteMath`Combinatorica`

u=UnitaryDivisorSigma[1,#]&/@Range[25000];//Timing

uniq=First/@Select[Split[Sort[u]],Length[#]>1&];

Flatten[DeleteCases[Function[pair,Select[KSubsets[Flatten[Position[u,pair]],2],Plus@@#==u[[#[[1]]]]&]]/@uniq,{}],1]//Timing

Large Unitary Amicable Pairs

Kohmoto (date?)

a=Flatten[FactorInteger/@{2^2,3^2,5^9,7^3 ,11,13,17^2,19,29,41,43,47,79,157,163,223,433,1303,1399,2053,2719,5167,13187,16787,52747,98543,2848337,500739672615943,7010355416623201,16506961423173486727453,10109028245165675006759491729,53,9163813886186194062277465733355041},1];
b=Flatten[FactorInteger/@{2^2,3^2,5^9,7^3,11,13,17^2,19,29,41,43,47,79,157,163,223,433,1303,1399,2053,2719,5167,13187,16787,52747,98543,2848337,500739672615943,7010355416623201,16506961423173486727453,10109028245165675006759491729,494845949854054479362983149601172267},1];

Times@@Power@@@#&/@{a,b}

Length/@IntegerDigits/@(Times@@Times@@@#&/@{a,b})

{UnitaryDivisorSigma[1,a],UnitaryDivisorSigma[1,b],Plus@@(Times@@Power@@@#&/@{a,b})}

Equal@@%

Kohmoto?

2^2*3^2*5^9*7^3*11*13*17^2*19*29*41*43*47*79*157*163*223*433*1303*1399*2053*2719*5167*13187*16787*52747*98543*2848337*500739672615943*7010355416623201*16506961423173486727453*10109028245165675006759491729*{53*9163813886186194062277465733355041,494845949854054479362983149601172267}

Length/@IntegerDigits/@%

Kohmoto 2001

a=Flatten[FactorInteger/@{2^2,3^2,5^9,7^4,11,13,17^2,19,29,41,43,47,79,157,163,223,433,601,1201,1303,1399,2053,2719,5167,13187,16787,52747,98543,2848337,500739672615943,7010355416623201,16506961423173486727453,10109028245165675006759491729,53,9163813886186194062277465733355041,228493422236252646229906698810905701952497928588074391826432954923},1];
b=Flatten[FactorInteger/@{2^2,3^2,5^9,7^4,11,13,17^2,19,29,41,43,47,79,157,163,223,433,601,1201,1303,1399,2053,2719,5167,13187,16787,52747,98543,2848337,500739672615943,7010355416623201,16506961423173486727453,10109028245165675006759491729,494845949854054479362983149603295787,228493422236252646229906698809925173866676005823410702992961841963},1];

Length/@IntegerDigits/@(Times@@Power@@@#&/@{a,b})

{UnitaryDivisorSigma[1,a],UnitaryDivisorSigma[1,b],Plus@@(Times@@Power@@@#&/@{a,b})}

Equal@@%

Kohmoto 2004

Date: Fri, 30 Jan 2004 00:21:30 -0500                                           
From: y.kohmoto <zbi74583@boat.zero.ad.jp>                                      
To: NMBRTHRY@LISTSERV.NODAK.EDU

I found a record of Unitary AP which has 317 digits.

a=Flatten[FactorInteger/@{2^4,3,5^4,7^5,11,13,19^2,23,29,31,97,101,127,137,151,181,191,227,251,313^2,1523,17569,18119,22193,42767,133157,1594471,3592427,12755767,16563721580414291,3692133344284919899954037,1107640003285475969986211099,509326829322602570550995760607650943,756709374175283588981851230229946163884862251,106459317187994137773100168718026852747401678766160269617017644971540715800242987},1];
b=Flatten[FactorInteger/@{2^4,3,5^4,7^5,11,13,19^2,23,29,31,97,101,127,137,151,181,191,227,251,313^2,1523,17569,18119,22193,42767,133157,1594471,3592427,12755767,16563721580414291,3692133344284919899954037,1107640003285475969986211099,509326829322602570550995760607650943,53,14013136558801547944108356115369373207909921,106459317187994137773100168718026854246807290557925899636611749316063659704331051},1];

Length/@IntegerDigits/@(Times@@Power@@@#&/@{a,b})

{UnitaryDivisorSigma[1,a],UnitaryDivisorSigma[1,b],Plus@@(Times@@Power@@@#&/@{a,b})}

Equal@@%