Weird numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎Functional Python: Updated output formatting primitive)
Line 731: Line 731:
<lang python>'''Weird numbers'''
<lang python>'''Weird numbers'''


⚫
from functools import reduce
from itertools import islice, repeat
from itertools import islice, repeat
⚫
from functools import reduce
from math import sqrt
from math import sqrt
from time import time
from time import time
Line 852: Line 852:
(where needed) with instances of the value v.'''
(where needed) with instances of the value v.'''
def go(rows):
def go(rows):
if rows:
return paddedRows(
w = len(max(rows, key=len))
len(max(rows, key=len))
)(v)(rows)
return lambda rows: go(rows) if rows else []



⚫
def padded(xs):
# paddedRows :: Int -> a -> [[a]] -[[a]]
d = w - len(xs)
def paddedRows(n):
return xs if 0 == d else (
'''A list of rows padded (but never truncated)
⚫
xs + list(repeat(v, d))
)
to length n with copies of value v.'''
⚫
def go(v, xs):
return list(map(padded, rows))
else:
def pad(x):
return rows
d = n - len(x)
return lambda rows: go(rows)
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 []




Revision as of 13:02, 26 March 2019

Weird numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

In number theory, a weird number is a natural number that is abundant but not semiperfect.

In other words, the sum of the proper divisors (divisors including 1 but not itself) of the number is greater than the number, but no subset of those divisors sums to the number itself.

E.G. 12 is not a weird number. It is abundant; the proper divisors 1, 2, 3, 4 & 6 sum to 16, but it is semiperfect, 6 + 4 + 2 == 12.

70 is a weird number. It is abundant; the proper divisors 1, 2, 5, 7, 10, 14 & 35 sum to 74, but there is no subset of proper divisors that sum to 70.

Task

Find and display, here on this page, the first 25 weird numbers.

See also


AppleScript

Applescript is not the recommended apparatus for this kind of experiment.

(Though after about 6 seconds (on this system) it does yield the first 25, and intermediates can be logged in the Messages channel of macOS Script Editor).

<lang applescript>on run 

   take(25, weirds())
   -- Gets there, but takes about 6 seconds on this system,
   -- (logging intermediates through the Messages channel, for the impatient :-)

end run


-- weirds :: Gen [Int] on weirds() 

   script
       property x : 1
       property v : 0
       on |λ|()
           repeat until isWeird(x)
               set x to 1 + x
           end repeat
           set v to x
           log v
           set x to 1 + x
           return v
       end |λ|
   end script

end weirds

-- isWeird :: Int -> Bool on isWeird(n) 

   set ds to descProperDivisors(n)
   set d to sum(ds) - n
   0 < d and not hasSum(d, ds)

end isWeird

-- hasSum :: Int -> [Int] -> Bool on hasSum(n, xs) 

   if {} ≠ xs then
       set h to item 1 of xs
       set t to rest of xs
       if n < h then
           hasSum(n, t)
       else
           n = h or hasSum(n - h, t) or hasSum(n, t)
       end if
   else
       false
   end if

end hasSum

-- GENERIC ------------------------------------------------

-- descProperDivisors :: Int -> [Int] on descProperDivisors(n) 

   if n = 1 then
       {1}
   else
       set realRoot to n ^ (1 / 2)
       set intRoot to realRoot as integer
       set blnPerfect to intRoot = realRoot
       
       -- isFactor :: Int -> Bool 
       script isFactor
           on |λ|(x)
               n mod x = 0
           end |λ|
       end script
       
       -- Factors up to square root of n,
       set lows to filter(isFactor, enumFromTo(1, intRoot))
       
       -- and cofactors of these beyond the square root,
       
       -- integerQuotient :: Int -> Int
       script integerQuotient
           on |λ|(x)
               (n / x) as integer
           end |λ|
       end script
       
       set t to rest of lows
       if blnPerfect then
           set xs to t
       else
           set xs to lows
       end if
       map(integerQuotient, t) & (reverse of xs)
   end if

end descProperDivisors

-- enumFromTo :: (Int, Int) -> [Int] on enumFromTo(m, n) 

   if m ≤ n then
       set lst to {}
       repeat with i from m to n
           set end of lst to i
       end repeat
       return lst
   else
       return {}
   end if

end enumFromTo

-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs) 

   tell mReturn(f)
       set lst to {}
       set lng to length of xs
       repeat with i from 1 to lng
           set v to item i of xs
           if |λ|(v, i, xs) then set end of lst to v
       end repeat
       return lst
   end tell

end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs) 

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       repeat with i from 1 to lng
           set v to |λ|(v, item i of xs, i, xs)
       end repeat
       return v
   end tell

end foldl

-- map :: (a -> b) -> [a] -> [b] on map(f, xs) 

   tell mReturn(f)
       set lng to length of xs
       set lst to {}
       repeat with i from 1 to lng
           set end of lst to |λ|(item i of xs, i, xs)
       end repeat
       return lst
   end tell

end map

-- sum :: [Num] -> Num on sum(xs) 

   script add
       on |λ|(a, b)
           a + b
       end |λ|
   end script
   
   foldl(add, 0, xs)

end sum

-- take :: Int -> Gen [a] -> [a] on take(n, xs) 

   set ys to {}
   repeat with i from 1 to n
       set v to xs's |λ|()
       if missing value is v then
           return ys
       else
           set end of ys to v
       end if
   end repeat
   return ys

end take

-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: First-class m => (a -> b) -> m (a -> b) on mReturn(f) 

   if script is class of f then
       f
   else
       script
           property |λ| : f
       end script
   end if

end mReturn</lang>

Output:
{70, 836, 4030, 5830, 7192, 7912, 9272, 10430, 10570, 10792, 10990, 11410, 11690, 12110, 12530, 12670, 13370, 13510, 13790, 13930, 14770, 15610, 15890, 16030, 16310}

Go

This takes advantage of Hout's analysis (see talk page) when testing for primitive semi-perfect numbers.

It also uses a sieve so we can make use of the fact that all multiples of a semi-perfect number are themselves semi-perfect.

Runs in about 40 ms on a Celeron N3050 @1.6Ghz. The first fifty (with a sieve size of 27000) takes roughly double that. <lang go>package main

import "fmt"

func divisors(n int) []int { 

   divs := []int{1}
   divs2 := []int{}
   for i := 2; i*i <= n; i++ {
       if n%i == 0 {
           j := n / i
           divs = append(divs, i)
           if i != j {
               divs2 = append(divs2, j)
           }
       }
   }
   for i := len(divs) - 1; i >= 0; i-- {
       divs2 = append(divs2, divs[i])
   }
   return divs2

}

func abundant(n int, divs []int) bool { 

   sum := 0
   for _, div := range divs {
       sum += div
   }
   return sum > n

}

func semiperfect(n int, divs []int) bool { 

   le := len(divs)
   if le > 0 {
       h := divs[0]
       t := divs[1:]
       if n < h {
           return semiperfect(n, t)
       } else {
           return n == h || semiperfect(n-h, t) || semiperfect(n, t)
       }
   } else {
       return false
   }

}

func sieve(limit int) []bool { 

   // false denotes abundant and not semi-perfect.
   // Only interested in even numbers >= 2
   w := make([]bool, limit)
   for i := 2; i < limit; i += 2 {
       if w[i] {
           continue
       }
       divs := divisors(i)
       if !abundant(i, divs) {
           w[i] = true
       } else if semiperfect(i, divs) {
           for j := i; j < limit; j += i {
               w[j] = true
           }
       }
   }
   return w

}

func main() { 

   w := sieve(17000)
   count := 0
   const max = 25
   fmt.Println("The first 25 weird numbers are:")
   for n := 2; count < max; n += 2 {
       if !w[n] {
           fmt.Printf("%d ", n)
           count++
       }
   }
   fmt.Println()

}</lang>

Output:
The first 25 weird numbers are:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Haskell

Translation of: Python

<lang haskell>weirds :: [Int] weirds = filter abundantNotSemiperfect [1 ..]

abundantNotSemiperfect :: Int -> Bool abundantNotSemiperfect n = 

 let ds = descProperDivisors n
     d = sum ds - n
 in 0 < d && not (hasSum d ds)

hasSum :: Int -> [Int] -> Bool hasSum _ [] = False hasSum n (x:xs) 

 | n < x = hasSum n xs
 | otherwise = (n == x) || hasSum (n - x) xs || hasSum n xs

descProperDivisors 

 :: Integral a
 => a -> [a]

descProperDivisors n = 

 let root = (floor . sqrt) (fromIntegral n :: Double)
     lows = filter ((0 ==) . rem n) [root,root - 1 .. 1]
 in tail $
    reverse (quot n <$> lows) ++
    (if n == root * root
       then tail
       else id)
      lows

main :: IO () main = 

 (putStrLn . unlines) $
 zipWith (\i x -> show i ++ (" -> " ++ show x)) [1 ..] (take 25 weirds)</lang>
Output:
1 -> 70
2 -> 836
3 -> 4030
4 -> 5830
5 -> 7192
6 -> 7912
7 -> 9272
8 -> 10430
9 -> 10570
10 -> 10792
11 -> 10990
12 -> 11410
13 -> 11690
14 -> 12110
15 -> 12530
16 -> 12670
17 -> 13370
18 -> 13510
19 -> 13790
20 -> 13930
21 -> 14770
22 -> 15610
23 -> 15890
24 -> 16030
25 -> 16310

JavaScript

ES6

Translation of: Python
Translation of: Haskell

<lang JavaScript>(() => { 

   'use strict';

   // main :: IO ()
   const main = () =>
       take(25, weirds());



   // weirds :: Gen [Int]
   function* weirds() {
       let
           x = 1,
           i = 1;
       while (true) {
           x = until(isWeird, succ, x)
           console.log(i.toString() + ' -> ' + x)
           yield x;
           x = 1 + x;
           i = 1 + i;
       }
   }



   // isWeird :: Int -> Bool
   const isWeird = n => {
       const
           ds = descProperDivisors(n),
           d = sum(ds) - n;
       return 0 < d && !hasSum(d, ds)
   };

   // hasSum :: Int -> [Int] -> Bool
   const hasSum = (n, xs) => {
       const go = (n, xs) =>
           0 < xs.length ? (() => {
               const
                   h = xs[0],
                   t = xs.slice(1);
               return n < h ? (
                   go(n, t)
               ) : (
                   n == h || hasSum(n - h, t) || hasSum(n, t)
               );
           })() : false;
       return go(n, xs);
   };



   // descProperDivisors :: Int -> [Int]
   const descProperDivisors = n => {
       const
           rRoot = Math.sqrt(n),
           intRoot = Math.floor(rRoot),
           blnPerfect = rRoot === intRoot,
           lows = enumFromThenTo(intRoot, intRoot - 1, 1)
           .filter(x => (n % x) === 0);
       return (
           reverse(lows)
           .slice(1)
           .map(x => n / x)
       ).concat((blnPerfect ? tail : id)(lows))
   };



   // GENERIC FUNCTIONS ----------------------------



   // enumFromThenTo :: Int -> Int -> Int -> [Int]
   const enumFromThenTo = (x1, x2, y) => {
       const d = x2 - x1;
       return Array.from({
           length: Math.floor(y - x2) / d + 2
       }, (_, i) => x1 + (d * i));
   };

   // id :: a -> a
   const id = x => x;

   // reverse :: [a] -> [a]
   const reverse = xs =>
       'string' !== typeof xs ? (
           xs.slice(0).reverse()
       ) : xs.split().reverse().join();

   // succ :: Enum a => a -> a
   const succ = x => 1 + x;

   // sum :: [Num] -> Num
   const sum = xs => xs.reduce((a, x) => a + x, 0);

   // tail :: [a] -> [a]
   const tail = xs => 0 < xs.length ? xs.slice(1) : [];

   // take :: Int -> [a] -> [a]
   // take :: Int -> String -> String
   const take = (n, xs) =>
       'GeneratorFunction' !== xs.constructor.constructor.name ? (
           xs.slice(0, n)
       ) : [].concat.apply([], Array.from({
           length: n
       }, () => {
           const x = xs.next();
           return x.done ? [] : [x.value];
       }));

   // until :: (a -> Bool) -> (a -> a) -> a -> a
   const until = (p, f, x) => {
       let v = x;
       while (!p(v)) v = f(v);
       return v;
   };

   // MAIN ---
   return main();

})();</lang>

Output:
1 -> 70
2 -> 836
3 -> 4030
4 -> 5830
5 -> 7192
6 -> 7912
7 -> 9272
8 -> 10430
9 -> 10570
10 -> 10792
11 -> 10990
12 -> 11410
13 -> 11690
14 -> 12110
15 -> 12530
16 -> 12670
17 -> 13370
18 -> 13510
19 -> 13790
20 -> 13930
21 -> 14770
22 -> 15610
23 -> 15890
24 -> 16030
25 -> 16310

Julia

<lang Julia>using Primes, Combinatorics

function isweird(n) 

   if n < 70
       return false
   else
       f = [one(n)]
       for (p, x) in factor(n)
           f = reduce(vcat, [f*p^i for i in 1:x], init=f)
       end
       pop!(f)
       return sum(f) > n && all(x -> sum(x) != n, powerset(f))
   end

end

function testweird(N) 

   println("The first $N weird numbers are: ")
   count, n = 0, 69
   while count < N
       if isweird(n)
           count += 1
           print("$n ")
       end
       n += 1
   end

end

testweird(25)

</lang>

Output:
The first 25 weird numbers are:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Kotlin

Translation of: Go

<lang scala>// Version 1.3.21

fun divisors(n: Int): List<Int> { 

   val divs = mutableListOf(1)
   val divs2 = mutableListOf<Int>()
   var i = 2
   while (i * i <= n) {
       if (n % i == 0) {
           val j = n / i
           divs.add(i)
           if (i != j) divs2.add(j)
       }
       i++
   }
   divs2.addAll(divs.asReversed())
   return divs2

}

fun abundant(n: Int, divs: List<Int>) = divs.sum() > n

fun semiperfect(n: Int, divs: List<Int>): Boolean { 

   if (divs.size > 0) {
       val h = divs[0]
       val t = divs.subList(1, divs.size)
       if (n < h) {
           return semiperfect(n, t)
       } else {
           return n == h || semiperfect(n-h, t) || semiperfect(n, t)
       }
   } else {
       return false
   }

}

fun sieve(limit: Int): BooleanArray { 

   // false denotes abundant and not semi-perfect.
   // Only interested in even numbers >= 2
   val w = BooleanArray(limit)
   for (i in 2 until limit step 2) {
       if (w[i]) continue
       val divs = divisors(i)
       if (!abundant(i, divs)) {
           w[i] = true
       } else if (semiperfect(i, divs)) {
           for (j in i until limit step i) w[j] = true
       }
   }
   return w

}

fun main() { 

   val w = sieve(17000)
   var count = 0
   val max = 25
   println("The first 25 weird numbers are:")
   var n = 2
   while (count < max) {
       if (!w[n]) {
           print("$n ")
           count++
       }
       n += 2
   }
   println()

}</lang>

Output:
The first 25 weird numbers are:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Perl

Translation of: Perl 6
Library: ntheory

<lang perl>use strict; use feature 'say';

use List::Util 'sum'; use POSIX 'floor'; use Algorithm::Combinatorics 'subsets'; use ntheory <is_prime divisors>;

sub abundant { 

   my($x) = @_;
   my $s = sum( my @l = is_prime($x) ? 1 : grep { $x != $_ } divisors($x) );
   $s > $x ? ($s, sort { $b <=> $a } @l) : ();

}

my(@weird,$n); while () { 

   $n++;
   my ($sum, @div) = abundant($n);
   next unless $sum;        # Weird number must be abundant, skip it if it isn't.
   next if $sum / $n > 1.1; # There aren't any weird numbers with a sum:number ratio greater than 1.08 or so.

   if ($n >= 10430 and (! int $n%70) and is_prime(int $n/70)) {
       # It's weird. All numbers of the form 70 * (a prime 149 or larger) are weird
   } else {
       my $next;
       my $l = shift @div;
       my $iter = subsets(\@div);
       while (my $s = $iter->next) {
           ++$next and last if sum(@$s) == $n - $l;
       }
       next if $next;
   }
   push @weird, $n;
   last if @weird == 25;

}

say "The first 25 weird numbers:\n" . join ' ', @weird;</lang>

Output:
The first 25 weird numbers:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Simpler and faster solution:

Translation of: Sidef
Library: ntheory

<lang perl>use 5.010; use strict; use ntheory qw(vecsum divisors divisor_sum);

sub is_pseudoperfect { 

   my ($n, $d, $s, $m) = @_;

   $d //= do { my @d = divisors($n); pop(@d); \@d };
   $s //= vecsum(@$d);
   $m //= $#$d;

   return 0 if $m < 0;

   while ($d->[$m] > $n) {
       $s -= $d->[$m--];
   }

   return 1 if ($n == $s or $d->[$m] == $n);

   is_pseudoperfect($n-$d->[$m], $d, $s-$d->[$m], $m - 1) ||
   is_pseudoperfect($n,          $d, $s-$d->[$m], $m - 1);

}

sub is_weird { 

   my ($n) = @_;
   divisor_sum($n) > 2*$n and not is_pseudoperfect($n);

}

my @weird; for (my $k = 1 ; @weird < 25 ; ++$k) { 

   push(@weird, $k) if is_weird($k);

}

say "The first 25 weird numbers:\n@weird";</lang>

Output:
The first 25 weird numbers:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Perl 6

<lang perl6>sub abundant (\x) { 

   my @l = x.is-prime ?? 1 !! flat
   1, (2 .. x.sqrt.floor).map: -> \d {
        my \y = x div d;
        next if y * d !== x;
        d !== y ?? (d, y) !! d
   };
   (my $s = @l.sum) > x ?? ($s, |@l.sort(-*)) !! ();

}

my @weird = (2, 4, {|($_ + 4, $_ + 6)} ... *).map: -> $n { 

   my ($sum, @div) = $n.&abundant;
   next unless $sum;        # Weird number must be abundant, skip it if it isn't.
   next if $sum / $n > 1.1; # There aren't any weird numbers with a sum:number ratio greater than 1.08 or so.
   if $n >= 10430 and ($n %% 70) and ($n div 70).is-prime {
       # It's weird. All numbers of the form 70 * (a prime 149 or larger) are weird
   } else {
       my $next;
       my $l = @div.shift;
       ++$next and last if $_.sum == $n - $l for @div.combinations;
       next if $next;
   }
   $n

}

put "The first 25 weird numbers:\n", @weird[^25];</lang>

Output:
The first 25 weird numbers:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Python

Functional

The first 50 seem to take c. 300 ms

Works with: Python version 3

<lang python>Weird numbers

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


  1. weirds :: Gen [Int]

def weirds(): 

   Generator for weird numbers.
      (Abundant, but not semi-perfect)
   x = 1
   while True:
       x = until(isWeird)(succ)(x)
       yield x
       x = 1 + x


  1. isWeird :: Int -> Bool

def isWeird(n): 

   Predicate :: abundant and not semi-perfect ?
   ds = descPropDivs(n)
   d = sum(ds) - n
   return 0 < d and not hasSum(d, ds)


  1. hasSum :: Int -> [Int] -> Bool

def hasSum(n, xs): 

   Does any subset of xs sum to n ?
      (Assuming xs to be sorted in descending
      order of magnitude)
   def go(n, xs):
       if xs:
           h, t = xs[0], xs[1:]
           if n < h:  # Head too big. Forget it. Tail ?
               return go(n, t)
           else:
               # The head IS the target ?
               # Or the tail contains a sum for the
               # DIFFERENCE between the head and the target ?
               # Or the tail contains some OTHER sum for the target ?
               return n == h or go(n - h, t) or go(n, t)
       else:
           return False
   return go(n, xs)


  1. descPropDivs :: Int -> [Int]

def descPropDivs(n): 

   Descending positive divisors of n,
      excluding n itself.
   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))


  1. TEST ----------------------------------------------------


  1. main :: IO ()

def main(): 

   Test

   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'
   )


  1. GENERIC -------------------------------------------------


  1. chunksOf :: Int -> [a] -> a

def chunksOf(n): 

   A series of lists of length n,
      subdividing the contents of xs.
      Where the length of xs is not evenly divible,
      the final list will be shorter than n.
   return lambda xs: reduce(
       lambda a, i: a + [xs[i:n + i]],
       range(0, len(xs), n), []
   ) if 0 < n else []


  1. compose (<<<) :: (b -> c) -> (a -> b) -> a -> c

def compose(g): 

   Right to left function composition.
   return lambda f: lambda x: g(f(x))


  1. index (!!) :: [a] -> Int -> a

def index(xs): 

   Item at given (zero-based) index.
   return lambda n: None if 0 > n else (
       xs[n] if (
           hasattr(xs, "__getitem__")
       ) else next(islice(xs, n, None))
   )


  1. paddedMatrix :: a -> a -> a

def paddedMatrix(v): 

   'A list of rows padded to equal length
       (where needed) with instances of the value v.
   def go(rows):
       return paddedRows(
           len(max(rows, key=len))
       )(v)(rows)
   return lambda rows: go(rows) if rows else []


  1. paddedRows :: Int -> a -> a -a

def paddedRows(n): 

   A list of rows padded (but never truncated)
      to length n with copies of value v.
   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 []


  1. showColumns :: Int -> [String] -> String

def showColumns(n): 

   A column-wrapped string
      derived from a list of rows.
   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)


  1. succ :: Enum a => a -> a

def succ(x): 

   The successor of a value. For numeric types, (1 +).
   return 1 + x if isinstance(x, int) else (
       chr(1 + ord(x))
   )


  1. tabulated :: String -> (a -> String) ->
  2. (b -> String) ->
  3. Int ->
  4. (a -> b) -> [a] -> String

def tabulated(s): 

   Heading -> x display function -> fx display function ->
         number of columns -> f -> value list -> tabular string.
   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
       )
   )


  1. take :: Int -> [a] -> [a]
  2. take :: Int -> String -> String

def take(n): 

   The prefix of xs of length n,
      or xs itself if n > length xs.
   return lambda xs: (
       xs[0:n]
       if isinstance(xs, list)
       else list(islice(xs, n))
   )


  1. transpose :: Matrix a -> Matrix a

def transpose(m): 

   The rows and columns of the argument transposed.
      (The matrix containers and rows can be lists or tuples).
   if m:
       inner = type(m[0])
       z = zip(*m)
       return (type(m))(
           map(inner, z) if tuple != inner else z
       )
   else:
       return m


  1. unlines :: [String] -> String

def unlines(xs): 

   A single string derived by the intercalation
      of a list of strings with the newline character.
   return '\n'.join(xs)


  1. until :: (a -> Bool) -> (a -> a) -> a -> a

def until(p): 

   The result of repeatedly applying f until p holds.
      The initial seed value is x.
   def go(f, x):
       v = x
       while not p(v):
           v = f(v)
       return v
   return lambda f: lambda x: go(f, x)


  1. MAIN ----------------------------------------------------

if __name__ == '__main__': 

   main()</lang>
Output:
First 50 weird numbers:

 1 -> 70       11 -> 10990    21 -> 14770    31 -> 18410    41 -> 22190    
 2 -> 836      12 -> 11410    22 -> 15610    32 -> 18830    42 -> 23170    
 3 -> 4030     13 -> 11690    23 -> 15890    33 -> 18970    43 -> 23590    
 4 -> 5830     14 -> 12110    24 -> 16030    34 -> 19390    44 -> 24290    
 5 -> 7192     15 -> 12530    25 -> 16310    35 -> 19670    45 -> 24430    
 6 -> 7912     16 -> 12670    26 -> 16730    36 -> 19810    46 -> 24710    
 7 -> 9272     17 -> 13370    27 -> 16870    37 -> 20510    47 -> 25130    
 8 -> 10430    18 -> 13510    28 -> 17272    38 -> 21490    48 -> 25690    
 9 -> 10570    19 -> 13790    29 -> 17570    39 -> 21770    49 -> 26110    
10 -> 10792    20 -> 13930    30 -> 17990    40 -> 21910    50 -> 26530    

Approx computation time: 278 ms

Sidef

<lang ruby>func is_pseudoperfect(n, d = n.divisors.slice(0, -2), s = d.sum, m = d.end) { 

   return false if (m < 0)

   while (d[m] > n) {
       s -= d[m--]
   }

   return true if (n == s)
   return true if (d[m] == n)

   __FUNC__(n-d[m], d, s-d[m], m-1) || __FUNC__(n, d, s-d[m], m-1)

}

func is_weird(n) { 

   (n.sigma > 2*n) && !is_pseudoperfect(n)

}

var w = (1..Inf -> lazy.grep(is_weird).first(25)) say "The first 25 weird numbers:\n#{w.join(' ')}"</lang>

Output:
The first 25 weird numbers:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310

Visual Basic .NET

Performance isn't quite on par with the python version, (this can produce the first 50 in ~590ms), but I tried to apply what I could after reading the comments made by Hout on the discussion page. This program is similar to the structure of the Go example. I found a couple of tweaks here and there to help with performance. For example, the divisors list is built "sorted", so a call to sort() is unnecessary. The Boolean array for screening the semi-perfect numbers is half as wide and 3 rows less. And only a portion of that is evaluated, not the entire array. <lang vbnet>Module Program 

   Sub test(n As Integer) ' creates sorted divisor list, screens out non-abundant, calls semi
       Dim sum As Integer = n \ 2, res As New List(Of Integer), ups As List(Of Integer) = {sum}.ToList : sum += 3
       For i As Integer = 4 To Math.Sqrt(n)
           If n Mod i = 0 Then Dim j As Integer = n \ i : sum += i : res.Add(i) : If i <> j Then sum += j : ups.Insert(0, j)
       Next : If sum <= n Then Exit Sub
       res.AddRange(ups) : semi(n, res.ToArray())
   End Sub

   Sub semi(n As Integer, divs As Integer()) ' tests for semi-perfections, adds to resu list when found
       Dim le As Integer = divs.Count + 2, l As Integer = 0,
       ss(le, divs.Last) As Boolean : For i As Integer = 0 To le : ss(i, 0) = True : ss(i, 1) = True
           Dim s3 As Integer = divs(le - 3) - divs(le - 4) - divs(le - 5)
           Select Case i
               Case 2 : ss(2, 2) = True : ss(2, 3) = True
               Case le - 4
                   Dim kk As Integer = s3 - divs(l - 1) : If kk < 2 Then kk = 2
                   For j As Integer = kk To s3
                       Dim k As Integer = j - divs(l - 2)
                       ss(i, j) = If(k < 0, ss(l, j), ss(l, j) Or ss(l, k))
                   Next
               Case le - 3
                   Dim k As Integer = s3 - divs(l - 2)
                   If Not ss(l, If(k < 0, s3, k)) Then SyncLock resu : resu.Add(n) : End SyncLock : Exit Sub
               Case > 2
                   For j As Integer = 2 To divs.Last
                       Dim k As Integer = j - divs(l - 2)
                       ss(i, j) = If(k < 0, ss(l, j), ss(l, j) Or ss(l, k))
                   Next
           End Select
           l = i
       Next
   End Sub

   Dim resu As New List(Of Integer) ' results list

   ' parallel calculations enhance performance, which is around 3/4 second at Tio.run, or 217ms at home (core i7)
   Sub Main(args As String())                     ' un-remark this to remove the parallel advantage----V
       Dim lim = 25, sw As New Stopwatch(), st As Integer = 2, stp As Integer = 16310 - 1 : sw.Start() ' : stp = 1
       Console.WriteLine("The first {0} weird numbers are:", lim)
       Do : Parallel.ForEach(Enumerable.Range(st, stp).Where(Function(x) _
            x >= 70 AndAlso x Mod 2 = 0 AndAlso x Mod 3 <> 0).Reverse().ToArray(), Sub(n)
                                                                                       test(n)
                                                                                   End Sub)
           st += stp : Loop Until resu.Count >= lim : sw.Stop() : resu.Sort()
       Dim g As Integer() = Enumerable.Range(1, resu.Count).Take(lim).ToArray()
       Dim both = g.Zip(resu, Function(a, b) String.Format("{1,5} ", a, b))
       Console.WriteLine(String.Join("", both))
       Console.WriteLine(vbLf & "Computation time was {0}ms.", CInt(sw.Elapsed.TotalMilliseconds))
   End Sub

End Module</lang>

Output:
The first 25 weird numbers are:
   70   836  4030  5830  7192  7912  9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310 

Computation time was 747ms.

I may eventually update this to continue running until stopped by a keypress. (like the Pi/spigot task)

Retrieved from "https://rosettacode.org/wiki/Weird_numbers?oldid=288920"