0
|
716 Views
|
2 Replies
|
1 Total Likes
View groups...
Share
GROUPS:

# Trying to find divisors of perfect numbers (new to WL)

Posted 4 months ago
 I asked this question on stack overflow but i think this is a better place since im using mathematica. I'm new to coding and want to make a code in wolfram mathematica. What I want to do is decompose a perfect number into fractions for each digit. Example for the 2nd perfect number: I want 28 to be written as 20/100 and 8/100. I want to do this for the bigger perfect numbers aswell so I need a general code. Next I want to find the ammount common divisors of 20 and 100. (which is 6) and the amount of common divisors of 8 and 100 (which is 3). the list I calculated found was: 1st (x) 3 2nd (y) 6 3 3rd (z) 12 4 2 4th (g) 16 9 6 4 5th (t) 64 49 42 30 0 9 4 2 6th (r) 110 90 88 49 54 30 16 0 6 2  the code i made up until now works for the 4th perfect number. from the 5th i also want to filter out the 0's and I get wrong awnsers from the 5th and up. this is the code i made: perfectNumber = PerfectNumber[6]; digits = IntegerDigits[perfectNumber]; numDigits = Length[digits]; positionedDigits = MapIndexed[#1 10^(numDigits - #2[[1]]) &, digits]; dividedDigits = Map[#/10^numDigits &, positionedDigits]; divisorspower = 10^numDigits; divisors100 = Divisors[divisorspower/10]; gcds = Map[GCD[#, divisors100] &, dividedDigits]; numeratorDivisors = Map[Divisors, gcds]; numDivisors = Map[Length, numeratorDivisors]; positionedDigitsDivisors = Map[Divisors, positionedDigits]; divisors100List = Table[divisors100, {Length[positionedDigitsDivisors]}]; commonDivisors = MapThread[Intersection, {positionedDigitsDivisors, divisors100List}]; numCommonDivisors = Map[Length, commonDivisors] 
2 Replies
Sort By:
Posted 4 months ago
 I'm probably misunderstanding something, because my results vary slightly from yours. Here's what I think you described: perfectNumber = PerfectNumber[2]; Length[Intersection[Divisors[10^IntegerLength[perfectNumber]], #]] & /@ Divisors /@ DeleteCases[NumberExpand[perfectNumber], 0] (* {6, 3} *) If we bundle this into a function, we can use it repeatedly. FancyFunction[n_] := With[ {perf = PerfectNumber[n]}, Length[Intersection[Divisors[10^IntegerLength[perf]], #]] & /@ Divisors /@ DeleteCases[NumberExpand[perf], 0]]; FancyFunction[1] (* {2} , which is different from your results*) FancyFunction[2] (* {6, 3} *) FancyFunction[3] (* {12, 4, 2} *) FancyFunction[4] (* {20, 9, 6, 4} , another deviation from your results *) FancyFunction[5] (* {64, 49, 42, 30, 9, 4, 2} *) FancyFunction[6] (* {110, 90, 88, 49, 54, 30, 16, 6, 2} *) 
Posted 4 months ago
 thanks for the quick response. the deviaton from 4 is correct i think i miscalculated there thanks for the quick respose and the 1st is also correct, i think the problem is that i first calculated the series with chat gpt (rookie mistake). and then turned to wolfram alfa, but due to size constraints i downloaded mathematica. this helps me a lot thanks again!
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.