[AdamSpeight2008]

Challenge: Factors + Perfect

Rating: Easy - Intermediate
Challenge Description:

This challenge comes in two parts;-

• Write a function that returns all of the perfect factors of an input integer.
  
• Write a function that returns true/false if the number is a perfect number.

Edit:- For the Adventurous write a method that that returns all of the Perfect Numbers within a given positive range. (Note: 1 - 100000)

VB.net is preferred programming language for this challenge.

Entries must state the .net framework being used. Eg .net: >= 3.5 (Client Profile)
Enclose your code inside the following tags (obviously without the spaces.)
[ spoiler ] [ code ] [ /code ][ / spoiler]
Working examples must be in a Zip archive (No naked binarys!)

Closing date for submissions to be eligible for Awards (Monday 5th Dec 23:59 GMT).
Submissions can be posted afterwards.

Awards for
- Shortest Amount of Code
- Fastest Code (when run on my machine)
- Most interesting.

This post has been edited by AdamSpeight2008: 29 November 2011 - 07:09 PM

[cfoley]

Could you clarify the second part please? When you say "if the number is a perfect number", do you mean "if the integer is a perfect number"?

Not asking to be picky: It makes a difference to my implementation.

I guess another question is are you providing the test/benchmark code or should we provide a main method to go with the functions?

This post has been edited by cfoley: 29 November 2011 - 08:55 AM

[SwiftStriker00]

by perfect factor, you mean a factor that is a perfect number. Correct?

[SwiftStriker00]

Here ya go. I went for creative over speed, and it turns out the larger perfect number you go, the faster mine gets.

Spoiler

'Is Perfect Number:
Private Function isPerfectNumberViaBinary(num As Long) As Boolean
        'Cause why not
        Dim binNum As String = Convert.ToString(num, 2)
        Dim length As Integer = binNum.Length

        'Perfect numbers in binary form have P 1's and P-1'0s, where P is prime
        '6 is smallest perfect number aka "110"
        If length Mod 2 = 0 OrElse length < 3 Then
            Return False
        End If

        Dim count As Integer = length \ 2 + 1

        'make sure all the 1's are on the left and all the 0's on the right
        Dim zeroCheck As Integer = binNum.IndexOf("0", 0, count)
        Dim onesCheck As Integer = binNum.IndexOf("1", count)

        If zeroCheck = -1 AndAlso onesCheck = -1 AndAlso isPrime(count) Then
            Return True
        End If
        Return False
    End Function


    Private Function isPrime(num As Long) As Boolean
        If num = 2 Then
            Return True
        End If
        If num Mod 2 = 0 Then
            Return False
        End If
        For i As Integer = 3 To Math.Sqrt(num) Step 2
            If num Mod i = 0 Then
                Return False
            End If
        Next
        Return True
    End Function'

'Perfect Factors:
Private Shared Function allPerfectFactors(num As Long) As List(Of Long)
	Dim factors As New List(Of Long)()
	For i As Long = 1 To (num \ 2) - 1
		If num Mod i = 0 Then
			If isPerfectNumberViaBinary(i) Then
				factors.Add(i)
			End If
		End If
	Next
	factors.Add(num)

	Return factors
End Function

This post has been edited by SwiftStriker00: 29 November 2011 - 02:18 PM

[cfoley]

Here is my effort. VB 2010 Express. Small code and fast (I'm sure a seasoned VB veteran would be able to make this smaller and faster)

Spoiler

Module PerfectFactors

    ' There are only 5 perfect numbers below Integer.MaxValue:
    Private perfectIntegers As List(Of Integer) = {6, 28, 496, 8128, 33550336}.ToList

    Function perfectFactors(ByVal n As Integer)
        Return perfectIntegers.FindAll(Function(x) n Mod x = 0)
    End Function

    Function isPerfect(ByVal n As Integer)
        Return perfectIntegers.Contains(n)
    End Function

End Module

You may think this is cheating so by way of explanation...

Spoiler

A routine to calculate (or check for) the kind of special number you want would normally be the preferred solution to this type of problem. However, perfect numbers are so sparse that this approach is actually very practical.

Turns out it scales very well too. I thought it would be a huge list if I changed to the Long data type but actually, there are only 8 perfect numbers that fit into the 19 Long decimal digits. According to Wikipedia, there are only 47 known perfect numbers, and the longest is 25956377 digits long (that's the length, not the number itself) so this approach would still be feasible (and the only practical one) if there was no limit to the number of digits.

One shortcoming is that it is not known if the list if perfect numbers has any gaps. In particular, it is not known if there are any odd perfect numbers. This fact hints at how infeasibly slow an approach that algorithmically checks the input number would be for large numbers.

[cfoley]

A wee addition:

Spoiler

There is a formula to generate perfect numbers if you know the right prime number to feed them. You'd generate the larger ones using the formula. It's not practical to type or even paste a 25956377 digit number.

[AdamSpeight2008]

Perfect Factor is a Divisor of a number that leaves a no remainder, itself does not have to be a Perfect Number.

cfoley: Including a list of Perfect Number, I would class a not calculating - thus cheating.

[cfoley]

Your competition, your rules.

I'll see if I can summon the energy to write a factorisation method.

[AdamSpeight2008]

My version just for fun.

Using features from the VS2011 version of VB and .net4.5

Spoiler

Uses the Global. feature to merge this module Iterators into the System.Linq namespace.

Spoiler

Namespace Global.System.Linq
  Public Module Iterators

    Public Iterator Function Divisors(ByVal Number As Integer) As IEnumerable(Of Integer)
      Yield Number
      If Number > 1 Then Yield 1
      If Number = 2 Then Yield 2
      If Number > 2 Then
        Dim Remainer, Result As Integer
        ' Even number divisor?
        'Result = Number
        'Dim y = 2
        'Do
        '  Result = Math.DivRem(Result, 2, Remainer)
        '  If Remainer > 0 Then Exit Do
        '  Yield Result
        '  Yield y
        '  y <<= 1
        'Loop Until False
        ' Square Root Divisor?
        Dim SquareRootOfNumber = CInt(Math.Sqrt(Number))
        If (SquareRootOfNumber * SquareRootOfNumber) = Number Then Yield SquareRootOfNumber
        ' If Math.IEEERemainder(SquareRootOfNumber, 2) = 0 Then SquareRootOfNumber -= 1
        ' Odd Divisor?
        For Value = SquareRootOfNumber To 2 Step -1
          Result = Math.DivRem(Number, Value, Remainer)
          If Remainer = 0 Then
            Yield Result
            Yield Value
          End If

        Next
      End If
    End Function

    Public Iterator Function FromRange(_from As Integer, upto As Integer, Optional stepping As Integer = 1) As IEnumerable(Of Integer)
      For x = _from To upto Step stepping
        Yield x
      Next
    End Function
    ' Generic IDENTITY function.
    Public Function ID_Func(Of T)() As Func(Of T, T)
      Return Function(Value As T) Value
    End Function
  End Module
End Namespace

If anyone can get the Even part to work correctly then the Odd part can be made to use a step of -2, rather that -1

So now with our Divisors iterator we can write a Sum of Dibvisors function like so.

Module NumberStuff
  <Extension> Public Function SumOfDivisors(ByVal x As Integer, Optional InculdeSelf As Boolean = False) As Integer
    Return Divisors(x).Sum() - If(InculdeSelf, 0, x)
  End Function
 

And thus making writing a Function to see if the Number is a Perfect Number rather trivial

  <Extension> Public Function IsPerfectNumber(ByVal x As Integer) As Boolean
    Return x.SumOfDivisors() = x
  End Function

End Module

A simple method to display them

 Public Sub ShowDivisors(Number As Integer)
    Console.Write("{0,8} ::= ", Number)
    For Each numb In Iterators.Divisors(Number).OrderBy(ID_Func(Of Integer))
      Console.Write("{0} ", numb)
    Next
    Console.WriteLine()
  End Sub

A Perfect Number Finder

Spoiler

Public Class PerfectNumberFinder
  Public Event Found(ByVal x As Integer)
  Public Event Progress()
  Protected _f, _t, _r As Integer
  Public Sub New(f As Integer, t As Integer, r As Integer)
    _f = f : _t = t : _r = r
  End Sub
  Public Function Start() As Task
    Return Task.Factory.StartNew(Sub()
                                   Parallel.ForEach(FromRange(_f, _t), Sub(n)
                                                                         If IsPerfectNumber(n) Then
                                                                           RaiseEvent Found(n)
                                                                         ElseIf n Mod _r = 0 Then
                                                                           RaiseEvent Progress()
                                                                         End If
                                                                       End Sub)
                                 End Sub)
  End Function
  Private Function GetThePerfectNumbers(_from As Integer, upto As Integer) As IEnumerable(Of Integer)
    Return From x In FromRange(_from, upto).AsParallel Where IsPerfectNumber(x)
  End Function

End Class

Let's use it to find the Perfect Numbers between 1 - 100000 (inclusive) (the 50000 is the report progress after x iterations.)

Spoiler

Module Module1
  Sub Main()
  Dim r2 = Timings.TimeSub(Sub()
                               Dim pnf As New PerfectNumberFinder(1, 100000, 50000)
                               AddHandler pnf.Found, Sub(x) Console.WriteLine("{0} ", x)
                               AddHandler pnf.Progress, Sub() Console.Write("|")

                               Dim t = pnf.Start()
                               t.Wait()
                             End Sub)
    ' 
    Console.WriteLine()
    Console.WriteLine("Taken: {0}", r2)
    Console.Beep()
    Console.ReadKey()
  End Sub
End Module

It takes about ~2 secs to complete.

For the interested, here is the code used to do the Timings.

Spoiler

Namespace Global.Timings
  Public Module MethodTiming

    Public Function TimeSub(ByVal fn As Action) As TimeSpan
      Dim sw As New Diagnostics.Stopwatch
      sw.Start()
      fn()
      sw.Stop()
      Return sw.Elapsed
    End Function
    Public Function TimeSub(Of P1, P2)(ByVal _Sub As Action(Of P1, P2), _P1 As P1, _p2 As P2) As TimeSpan
      Dim sw As New Diagnostics.Stopwatch
      sw.Start()
      _Sub(_P1, _p2)
      sw.Stop()
      Return sw.Elapsed

    End Function
    Public Function TimeFN(Of T, U)(ByVal fn As Func(Of T, U), input As T) As Tuple(Of U, TimeSpan)
      Dim sw As New Diagnostics.Stopwatch
      sw.Start()
      Dim rs = fn(input)
      sw.Stop()
      Return New Tuple(Of U, TimeSpan)(rs, sw.Elapsed)

    End Function
    Public Function TimeFN(Of P1, P2, Res)(ByVal fn As Func(Of P1, P2, Res), _P1 As P1, _p2 As P2) As Tuple(Of Res, TimeSpan)
      Dim sw As New Diagnostics.Stopwatch
      sw.Start()
      Dim rs = fn(_P1, _p2)
      sw.Stop()
      Return New Tuple(Of Res, TimeSpan)(rs, sw.Elapsed)

    End Function
  End Module
End Namespace

This post has been edited by AdamSpeight2008: 29 November 2011 - 07:18 PM

[Beach_Coder]

With respect to Part 1 of the Challenge, should Integer be interpreted as any Integer, any Whole Number, any Integer up to the limit of the Int32 datatype or any other subset of all Integers?



Also, if I may, due to the unnerving degree to which mathematicians disagree on the definition of various terms (as well my own OCD and mal-appropriate perfectionism) and I suppose with some risk of creating more confusion in an effort of disambiguity:

A Factor of any given Integer is commonly (and disturbingly) interpreted to mean Prime Factor. This is to such a degree that the term is effectively ambiguous. If one means Factor, one is better off specifying either All Factors or Prime Factors (or whatever other precisely descriptive term is appropriate to the situation). Further, the term Divisor is preferred over Factor because of the common interpretation of Factor to mean Prime Factor. All of this despite Divisor of an integer and Factor of an integer having the same meaning.

A Proper Divisor of a given positive Integer is a positive Divisor of the Integer other than the Integer itself which leaves a Remainder of zero. The terms Perfect Divisor and Perfect Factor are not widely used. However, in determining if a number is a Perfect Number, one evaluates the sum of the Proper Divisors in comparison to the number.

[Beach_Coder]

AdamSpeight2008, on 28 November 2011 - 09:15 PM, said:

Challenge: Factors + Perfect

Rating: Easy - Intermediate
Challenge Description:

...
Awards for

- Fastest Code (when run on my machine)

How many processors does your machine have?
32 or 64 Bit?
What operating system?

I don't know if it's appropriate to ask, or even how to best exploit the differences among various scenarios here (yet), but I decided it couldn't hurt to ask.

[AdamSpeight2008]

You lot know how to suck the fun, out a challenge.

OK it an Int32, so it doesn't matter about the bit-ness of the OS.

Tt'll be tested either (not decided which yet)

1.8Ghz Dual Core Windows 7 Machine with 2Gb
or I may test run them on the Old Server I have with Dual Xeon (Hyperthreaded) 3.2Ghz 64-Bit 6GB RAMHypertreaded (OS: Windows Server 2008r2)

[lordofduct]

All these competitions do is make me want Visual Studio 2010 at my office... I have it at home, but not here at work. So I don't get the Yield functionality, which I love from C#...

[Beach_Coder]

So I suppose I could have just submitted the functions alone days ago, but I proceeded with creating an application (that has the wrong connotation though, little program more appropriate) which might have been a mistake since working my way around the publishing wizard is like throwing darts at a board.

Note: There is a proof that the smallest odd perfect number is at least 10 E 300.
I think 300 zeros might be in the area of super polynomial time to factor. If not it's close. Of course I didn't know that until after I spent a couple of days trying to remember some formula I though I forgot from high school that, as it turns out, doesn't yet exist.
Last week I stumbled across a paper that endeavors to demonstrate that the smallest odd perfect number is at least 10 E 1500. I'd comment on it, but it may as well have been written in Ancient Greek.

Spoiler

I used:
Visual Basic Express 2010
.Net 4
Option Strict On
Option Explicit On
Option Infer On
My os is Windows XP SP3
My processor is an Intel Core Duo 2 4400 2GHZ x86
I've got 2GB of Ram
Oh! I made this a Console Application (Sorry everyone; I just love the black screen and green font)
The only Imports thing I have is System.Console

'=====================================================================================================

ITEM 1:  RETURN THE PROPER DIVISORS OF AN ENTERED INTEGER


Function Proper_Divisors(Num As Int32) As List(Of Int32)

        Dim Proper_Divisor_List As New List(Of Int32)
        Dim Loop_Max As Int32 = Num
        Dim Divisor As Int32 = 2

        '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

        Do While Divisor < Loop_Max And Divisor < Num
            If Num Mod Divisor = 0 Then
                Proper_Divisor_List.Add(Divisor)
                Proper_Divisor_List.Add(Num \ Divisor)
                Loop_Max = Num \ Divisor
            End If
            Divisor = Divisor + 1
        Loop

        '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

        Proper_Divisor_List = Proper_Divisor_List.Distinct.ToList
        Proper_Divisor_List.Add(1)
        Proper_Divisor_List.Sort()
        Return Proper_Divisor_List

    End Function

'=====================================================================================================

ITEM 2:  DETERMINE IF AN ENTERED INTEGER IS A PERFECT NUMBER


 Function Perfect_Number_Check(ByVal Num As Int32) As String

        Dim Quotient As Int32
        Dim Divisor As Int32 = 2
        Dim Dividend As Int32 = Num
        Dim Interval As Int32
        Dim Divisor_Sum As Decimal = 1D
        Dim Perfect_Number As Boolean = False

        '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

        If Dividend Mod 2 = 0 Then
            Interval = 1
        Else
            Divisor = 3
            Interval = 2
        End If

        '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

        Do Until Divisor >= Math.Sqrt(Num)
            If Dividend Mod Divisor = 0 Then
                Quotient = Dividend \ Divisor
                Divisor_Sum = Divisor_Sum + Quotient + Divisor
                If Divisor_Sum > Num Then
                    Exit Do
                End If
            End If
            Divisor = Divisor + Interval
        Loop

        '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

        If Divisor_Sum = Num Then
            Perfect_Number = True
            Return Strings.UCase(Perfect_Number.ToString)
        ElseIf Divisor_Sum > Num Then
            Return Strings.UCase(Perfect_Number.ToString) & ".  THE NUMBER IS ABUNDANT."
        ElseIf Divisor_Sum < Num Then
            Return Strings.UCase(Perfect_Number.ToString) & ".  THE NUMBER IS DEFICIENT."
        Else
            Return "Function Failed."
        End If

    End Function


'=====================================================================================================


ITEM 3:  RETURN ALL OF THE PERFECT NUMBERS WITHIN A GIVEN RANGE
         CODING THIS WAS FUN
         KNOWING THERE ARE ONLY A HANDFUL THAT AN INT32 CAN HOLD MAKES THE OUTPUT A LITTLE BIT OF LET DOWN THOUGH
         I ACTUALLY USE A SERIES OF FUNCTIONS FOR THIS BIT:

	Dim Lp As Decimal = Math.Truncate(Calc_Range_of_p(Input_Number(0)))
        Dim Hp As Decimal = Math.Truncate(Calc_Range_of_p(Input_Number(1))) + 1
        Dim Primes As New List(Of Decimal)
        Dim Mersenne_Primes As New List(Of Decimal)
        Dim Preliminary_Perfects As New List(Of Decimal)
        Dim Perfects As New List(Of Decimal)

 	Primes = Check_Prime_Factors(Lp, Hp)
        Mersenne_Primes = Select_Mersennes_Primes(Primes)
        Preliminary_Perfects = Perfect_Prelim(Mersenne_Primes)
        Perfects = Verify_Perfect_Numbers(Preliminary_Perfects)



A)  THIS FUNCTION RUNS TWICE. ONCE WITH THE INTEGER FOR THE LOW END OF THE INPUT RANGE, ONCE WITH THE HIGH NUMBER.
    IT RETURNS THE DERIVED RANGE WITHIN WHICH THE LOWEST AND GREATEST PRIME FACTORS FOR THE INPUT RANGE ARE

 	Function Calc_Range_of_p(ByVal N As Int32) As Decimal

        If N < 2D Then
            Return 2D
        Else
            Return CDec((((Math.Log(N) / Math.Log(2D)) + 1D) / 2D))
        End If

   	 End Function

B)/>  THIS BIT EXAMINES EACH OF THE INTEGERS IN THE RANGE DERIVED FROM STEP A AND 
    DETERMINES WHICH OF THEM ARE ACTUALLY PRIME NUMBERS.

 	Function Check_Prime_Factors(ByVal p1 As Decimal, ByVal p2 As Decimal) As List(Of Decimal)

        Dim Prime_Factor_List As New List(Of Decimal)

        If p1 <= 2D Then
            Prime_Factor_List.Add(p1)
            p1 = 3D
        End If

        For p = p1 To p2 Step 2
            If Check_Primality(p) = True Then
                Prime_Factor_List.Add(p)
            End If
        Next

        Return Prime_Factor_List

    	End Function

	Function Check_Primality(ByVal p As Decimal) As Boolean

        Dim Return_Value As Boolean = True

        For i = 2D To p - 1
            If p Mod i = 0 Then
                Return_Value = False
                Exit For
            End If
        Next

        Return Return_Value

    	End Function



C)	THIS BIT EXAMINES EACH OF THE CONFIRMED PRIME NUMBERS FROM PART B ABOVE AND DETERMINES
        WHICH OF THEM ARE MERSENNES PRIMES.

	Function Select_Mersennes_Primes(ByVal Prime_List As List(Of Decimal)) As List(Of Decimal)

        Dim Mersenne_List As New List(Of Decimal)

        For Each p In Prime_List
            If Check_Primality(CDec(2D ^ p - 1D)) = True Then
                Mersenne_List.Add(p)
            End If
        Next

        Return Mersenne_List

        End Function




D)      THIS BIT APPLIES THE EULER EUCLID FORMULA (OR SOME SUCH) TO EACH OF THE MERSENNES PRIMES
        AND DETERMINES THE THEORETICALLY ASSOCIATED PERFECT NUMBER.
        GIVEN THE LIMITS OF THIS CHALLENGE (INT32) THIS METHOD IS PERFECTLY APPROPRIATE.
        FAR BELOW THE SIZE OF NUMBER WHERE ONE WONDERS IF THERE IS ONE HIDDEN IN THERE NO ONE HAS FOUND YET.
        AND EVEN FARTHER BELOW THE SIZE OF NUMBER AND ODD PERFECT NUMBER WOULD HAVE TO BE.


	Function Perfect_Prelim(ByVal List_Of_Mersenne_Primes As List(Of Decimal)) As List(Of Decimal)
        Dim Perfect_List_Draft As New List(Of Decimal)

        For Each p In List_Of_Mersenne_Primes
            Perfect_List_Draft.Add(CDec((2D ^ (p - 1D)) * ((2D ^ p) - 1D)))
        Next

        Return Perfect_List_Draft

   	End Function


E)	JUST IN CASE MY CODE WAS OFF
	(FIGURING OUT HOW TO CODE THE EULER EUCLID FORMULA WAS A LITTLE TEDIOUS, HALF THE FOLKS ON DIC
        PROBABLY WEREN'T BORN THE LAST TIME I HAD A MATH CLASS)
	OR EUCLID REALLY WASN'T ON TO ANYTHING AND I MISUNDERSTOOD EULER,
        THESE TWO FUNCTIONS DOUBLE CHECK THE PERFECTION, IF YOU WILL, OF THE PERFECT
        NUMBERS DERIVED FROM PART D.
        



	Function Verify_Perfect_Numbers(ByVal Prelim_List As List(Of Decimal)) As List(Of Decimal)

        Dim Perfect_Numbers As New List(Of Decimal)

        For Each PN In Prelim_List
            If Validate_Perfect_Number(PN) = True Then
                Perfect_Numbers.Add(PN)
            End If
        Next

        Return Perfect_Numbers

    	End Function



	Function Validate_Perfect_Number(ByVal PPN As Decimal) As Boolean

        Dim Quotient As Decimal
        Dim Divisor As Decimal = 2D
        Dim Dividend As Decimal = PPN
        Dim Interval As Decimal
        Dim Divisor_Sum As Decimal = 1D
        Dim Perfect_Number As Boolean = False

        If Dividend Mod 2D = 0 Then
            Interval = 1D
        Else
            Divisor = 3D
            Interval = 2D
        End If

        Do Until Divisor >= Math.Sqrt(PPN)
            If Dividend Mod Divisor = 0 Then
                Quotient = Dividend / Divisor
                Divisor_Sum = Divisor_Sum + Quotient + Divisor
                If Divisor_Sum > PPN Then
                    Exit Do
                End If
            End If
            Divisor = Divisor + Interval
        Loop

        If Divisor_Sum = PPN Then
            Perfect_Number = True
        End If

        Return Perfect_Number

   	End Function

Okay I think I did this right (the posting that is). I am slightly less confident in how I used the publishing wizard and zip thing. My apologies if I did something awful.

Attached File(s)

•  DIC_Challenge_Factors_And_Perfect.zip (198.48K)
  Number of downloads: 55

[Beach_Coder]

So, who won the challenge?