Task: Weird numbers







Python: 

from itertools import chain, count, islice, repeat
from functools import reduce
from math import sqrt
from time import time



def weirds():
    
    def go(n):
        ds = descPropDivs(n)
        d = sum(ds) - n
        return [n] if 0 < d and not hasSum(d, ds) else []
    return concatMap(go)(count(1))



def hasSum(n, xs):
    
    def go(n, xs):
        if xs:
            h, t = xs[0], xs[1:]
            if n < h:  
                return go(n, t)
            else:
                
                
                
                
                return n == h or go(n - h, t) or go(n, t)
        else:
            return False
    return go(n, xs)



def descPropDivs(n):
    
    root = sqrt(n)
    intRoot = int(root)
    blnSqr = root == intRoot
    lows = [x for x in range(1, 1 + intRoot) if 0 == n % x]
    return [
        n // x for x in (
            lows[1:-1] if blnSqr else lows[1:]
        )
    ] + list(reversed(lows))





def main():
    

    start = time()
    n = 50
    xs = take(n)(weirds())

    print(
        (tabulated('First ' + str(n) + ' weird numbers:\n')(
            lambda i: str(1 + i)
        )(str)(5)(
            index(xs)
        )(range(0, n)))
    )
    print(
        '\nApprox computation time: ' +
        str(int(1000 * (time() - start))) + ' ms'
    )





def chunksOf(n):
    
    return lambda xs: reduce(
        lambda a, i: a + [xs[i:n + i]],
        range(0, len(xs), n), []
    ) if 0 < n else []



def compose(g):
    
    return lambda f: lambda x: g(f(x))



def concatMap(f):
    
    return lambda xs: chain.from_iterable(map(f, xs))



def index(xs):
    
    return lambda n: None if 0 > n else (
        xs[n] if (
            hasattr(xs, "__getitem__")
        ) else next(islice(xs, n, None))
    )



def paddedMatrix(v):
    
    def go(rows):
        return paddedRows(
            len(max(rows, key=len))
        )(v)(rows)
    return lambda rows: go(rows) if rows else []



def paddedRows(n):
    
    def go(v, xs):
        def pad(x):
            d = n - len(x)
            return (x + list(repeat(v, d))) if 0 < d else x
        return list(map(pad, xs))
    return lambda v: lambda xs: go(v, xs) if xs else []



def showColumns(n):
    
    def go(xs):
        def fit(col):
            w = len(max(col, key=len))

            def pad(x):
                return x.ljust(4 + w, ' ')
            return ''.join(map(pad, col))

        q, r = divmod(len(xs), n)
        return unlines(map(
            fit,
            transpose(paddedMatrix('')(
                chunksOf(q + int(bool(r)))(
                    xs
                )
            ))
        ))
    return lambda xs: go(xs)



def succ(x):
    
    return 1 + x if isinstance(x, int) else (
        chr(1 + ord(x))
    )






def tabulated(s):
    
    def go(xShow, fxShow, intCols, f, xs):
        w = max(map(compose(len)(xShow), xs))
        return s + '\n' + showColumns(intCols)([
            xShow(x).rjust(w, ' ') + ' -> ' + fxShow(f(x)) for x in xs
        ])
    return lambda xShow: lambda fxShow: lambda nCols: (
        lambda f: lambda xs: go(
            xShow, fxShow, nCols, f, xs
        )
    )




def take(n):
    
    return lambda xs: (
        xs[0:n]
        if isinstance(xs, list)
        else list(islice(xs, n))
    )



def transpose(m):
    
    if m:
        inner = type(m[0])
        z = zip(*m)
        return (type(m))(
            map(inner, z) if tuple != inner else z
        )
    else:
        return m



def unlines(xs):
    
    return '\n'.join(xs)



def until(p):
    
    def go(f, x):
        v = x
        while not p(v):
            v = f(v)
        return v
    return lambda f: lambda x: go(f, x)



if __name__ == '__main__':
    main()


VB: Module Module1

    Dim resu As New List(Of Integer)

    Function TestAbundant(n As Integer, ByRef divs As List(Of Integer)) As Boolean
        divs = New List(Of Integer)
        Dim sum As Integer = -n : For i As Integer = Math.Sqrt(n) To 1 Step -1
            If n Mod i = 0 Then divs.Add(i) : Dim j As Integer = n / i : divs.Insert(0, j) : sum += i + j
        Next : divs(0) = sum - divs(0) : Return divs(0) > 0
    End Function

    Function subList(src As List(Of Integer), Optional first As Integer = Integer.MinValue) As List(Of Integer)
        subList = src.ToList : subList.RemoveAt(1)
    End Function

    Function semiperfect(divs As List(Of Integer)) As Boolean
        If divs.Count < 2 Then Return False
        Select Case divs.First.CompareTo(divs(1))
            Case 0 : Return True
            Case -1 : Return semiperfect(subList(divs))
            Case 1 : Dim t As List(Of Integer) = subList(divs) : t(0) -= divs(1)
                If semiperfect(t) Then Return True Else t(0) = divs.First : Return semiperfect(t)
        End Select : Return False 
    End Function

    Function Since(et As TimeSpan) As String 
        If et > New TimeSpan(2000000) Then
            Dim s As String = " " & et.ToString(), p As Integer = s.IndexOf(":"), q As Integer = s.IndexOf(".")
            If q < p Then s = s.Insert(q, "Days") : s = s.Replace("Days.", "Days, ")
            p = s.IndexOf(":") : s = s.Insert(p, "h") : s = s.Replace("h:", "h ")
            p = s.IndexOf(":") : s = s.Insert(p, "m") : s = s.Replace("m:", "m ")
            s = s.Replace(" 0", " ").Replace(" 0h", " ").Replace(" 0m", " ") & "s"
            Return s.TrimStart()
        Else
            If et > New TimeSpan(1500) Then
                Return et.TotalMilliseconds.ToString() & "ms"
            Else
                If et > New TimeSpan(15) Then
                    Return (et.TotalMilliseconds * 1000.0).ToString() & "µs"
                Else
                    Return (et.TotalMilliseconds * 1000000.0).ToString() & "ns"
                End If
            End If
        End If
    End Function

    Sub Main(args As String())
        Dim sw As New Stopwatch, st As Integer = 2, stp As Integer = 1020, count As Integer = 0
        Dim max As Integer = 25, halted As Boolean = False
        If args.Length > 0 Then _
            Dim t As Integer = Integer.MaxValue : If Integer.TryParse(args(0), t) Then max = If(t > 0, t, Integer.MaxValue)
        If max = Integer.MaxValue Then
            Console.WriteLine("Calculating weird numbers, press a key to halt.")
            stp *= 10
        Else
            Console.WriteLine("The first {0} weird numbers:", max)
        End If
        If max < 25 Then stp = 140
        sw.Start()
        Do : Parallel.ForEach(Enumerable.Range(st, stp),
            Sub(n)
                Dim divs As List(Of Integer) = Nothing
                If TestAbundant(n, divs) AndAlso Not semiperfect(divs) Then
                    SyncLock resu : resu.Add(n) : End SyncLock
                End If
            End Sub)
            If resu.Count > 0 Then
                resu.Sort()
                If count + resu.Count > max Then
                    resu = resu.Take(max - count).ToList
                End If
                Console.Write(String.Join(" ", resu) & " ")
                count += resu.Count : resu.Clear()
            End If
            If Console.KeyAvailable Then Console.ReadKey() : halted = True : Exit Do
            st += stp
        Loop Until count >= max
        sw.Stop()
        If max < Integer.MaxValue Then
            Console.WriteLine(vbLf & "Computation time was {0}.", Since(sw.Elapsed))
            If halted Then Console.WriteLine("Halted at number {0}.", count)
        Else
            Console.WriteLine(vbLf & "Computation time was {0} for the first {1} weird numbers.", Since(sw.Elapsed), count)
        End If
    End Sub
End Module