#!/bin/python
from __future__ import print_function

def EncodeNegBase(n, b): #Converts from decimal
	if n == 0:
		return "0"
	out = []
	while n != 0:
		n, rem = divmod(n, b)
		if rem < 0:
			n += 1
			rem -= b
		out.append(rem)
	return "".join(map(str, out[::-1]))

def DecodeNegBase(nstr, b): #Converts to decimal
	if nstr == "0":
		return 0

	total = 0
	for i, ch in enumerate(nstr[::-1]):
		total += int(ch) * b**i
	return total

if __name__=="__main__":

	print ("Encode 10 as negabinary (expect 11110)")
	result = EncodeNegBase(10, -2)
	print (result)
	if DecodeNegBase(result, -2) == 10: print ("Converted back to decimal")
	else: print ("Error converting back to decimal")

	print ("Encode 146 as negaternary (expect 21102)")
	result = EncodeNegBase(146, -3)
	print (result)
	if DecodeNegBase(result, -3) == 146: print ("Converted back to decimal")
	else: print ("Error converting back to decimal")

	print ("Encode 15 as negadecimal (expect 195)")
	result = EncodeNegBase(15, -10)
	print (result)
	if DecodeNegBase(result, -10) == 15: print ("Converted back to decimal")
	else: print ("Error converting back to decimal")


  [ dup dip /mod
    over iff
      [ - dip 1+ ]
    else drop ]            is /mod+       ( n n --> n n )

  [ over 0 = iff
      [ 2drop $ "0" ]
      done
    temp put
    $ "" swap
    [ temp share /mod+
      digit
      rot join swap
      dup 0 = until ]
    drop
    temp release ]         is ->negabase$ ( n n --> $   )

  [ over $ "0" = iff
      [ 2drop 0 ]
      done
    temp put
    0 swap
    witheach
      [ dip
          [ temp share * ]
        char->n + ]
    temp release ]         is negabase$-> ( $ n --> n   )

   10 dup echo say " -> "
   -2 ->negabase$ dup echo$ say " -> "
   -2 negabase$-> echo cr
  146 dup echo say " -> "
   -3 ->negabase$ dup echo$ say " -> "
   -3 negabase$-> echo cr
   15 dup echo say " -> "
  -10 ->negabase$ dup echo$ say " -> "
  -10 negabase$-> echo cr


#lang racket

(define all-digits (string->list "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-"))

(define d->i-map (for/hash ((i (in-naturals)) (d all-digits)) (values d i)))

(define max-base (length all-digits))

(define (q/r n d)
  (let-values (((q r) (quotient/remainder n d)))
    (if (negative? r)
        (values (+ q 1) (- r d))
        (values q r))))

(define (negabase-convertors base)
  (when (not (integer? base)) (raise "Non-integer base."))
  (when (not (<= 2 (abs base) max-base)) (raise (format "(abs base) must be inside [2 ~a] interval." max-base)))
  (values
   (let ((q/r_base (curryr q/r base)))
     (λ (num)
       (define (checked->base num dig)
         (match num
           [0 (apply string dig)]
           [(app q/r_base num/ rst) (checked->base num/ (cons (list-ref all-digits rst) dig))]))
       (if (integer? num)
           (checked->base num  (if (zero? num) '(#\0) '()))
           (raise "Non-integer number."))))

   (λ (dig)
     (define (loop digs acc)
       (match digs [(list) acc] [(cons a d) (loop d (+ (* acc base) (hash-ref d->i-map a)))]))
     (loop (string->list dig) 0))))

(define-values (->negabinary negabinary->) (negabase-convertors -2))

(define-values (->negaternary negaternary->) (negabase-convertors -3))

(define-values (->negadecimal negadecimal->) (negabase-convertors -10))

(define-values (->nega63ary nega63ary->) (negabase-convertors (- max-base)))

(module+ main
  (->negaternary 146)
  (->negabinary 10)
  (->negadecimal 15)
  (->nega63ary -26238001742))

(module+ test
  (require rackunit)

  ;; tests from wikipedia page
  (check-equal? (call-with-values (λ () (q/r 146 -3)) cons) '(-48 . 2))
  (check-equal? (call-with-values (λ () (q/r -48 -3)) cons) '(16 . 0))
  (check-equal? (call-with-values (λ () (q/r 16 -3)) cons) '(-5 . 1))
  (check-equal? (call-with-values (λ () (q/r -5 -3)) cons) '(2 . 1))
  (check-equal? (call-with-values (λ () (q/r 2 -3)) cons) '(0 . 2))

  (define-values (->hexadecimal hexadecimal->) (negabase-convertors 16))
  (check-equal? (->hexadecimal 31) "1F"))


multi sub base ( Int $value is copy, Int $radix where -37 < * < -1) {
    my $result;
    while $value {
        my $r = $value mod $radix;
        $value div= $radix;
        if $r < 0 {
            $value++;
            $r -= $radix
        }
        $result ~= $r.base(-$radix);
    }
    flip $result || ~0;
}

multi sub base ( Real $num, Int $radix where -37 < * < -1, :$precision = -15 ) {
    return '0' unless $num;
    my $value  = $num;
    my $result = '';
    my $place  = 0;
    my $upper-bound = 1 / (-$radix + 1);
    my $lower-bound = $radix * $upper-bound;

    $value = $num / $radix ** ++$place until $lower-bound <= $value < $upper-bound;

    while ($value or $place > 0) and $place > $precision {
        my $digit = ($radix * $value - $lower-bound).Int;
        $value    =  $radix * $value - $digit;
        $result ~= '.' unless $place or $result.contains: '.';
        $result ~= $digit == -$radix ?? ($digit-1).base(-$radix)~'0' !! $digit.base(-$radix);
        $place--
    }
    $result
}

multi sub parse-base (Str $str, Int $radix where -37 < * < -1) {
    return -1 * $str.substr(1).&parse-base($radix) if $str.substr(0,1) eq '-';
    my ($whole, $frac) = $str.split: '.';
    my $fraction = 0;
    $fraction = [+] $frac.comb.kv.map: { $^v.parse-base(-$radix) * $radix ** -($^k+1) } if $frac;
    $fraction + [+] $whole.flip.comb.kv.map: { $^v.parse-base(-$radix) * $radix ** $^k }
}

# TESTING
for <4 -4 0 -7  10 -2  146 -3  15 -10  -19 -10  107 -16
    227.65625 -16  2.375 -4 -1.3e2 -8 41371457.268272761 -36> -> $v, $r {
    my $nbase = $v.&base($r, :precision(-5));
    printf "%20s.&base\(%3d\) = %-11s : %13s.&parse-base\(%3d\) = %s\n",
      $v, $r, $nbase, "'$nbase'", $r, $nbase.&parse-base($r);
}

# 'Illegal' negative-base value
say q|  '-21'.&parse-base(-10) = |, '-21'.&parse-base(-10);


/*REXX pgm converts & displays a base ten integer to a negative base number (up to -10).*/
@=' converted to base ';      numeric digits 300 /*be able to handle ginormous numbers. */
n=  10;  b=  -2;   q= nBase(n, b);   say right(n, 20)   @   right(b, 3)  '────►'  q   ok()
n= 146;  b=  -3;   q= nBase(n, b);   say right(n, 20)   @   right(b, 3)  '────►'  q   ok()
n=  15;  b= -10;   q= nBase(n, b);   say right(n, 20)   @   right(b, 3)  '────►'  q   ok()
n= -15;  b= -10;   q= nBase(n, b);   say right(n, 20)   @   right(b, 3)  '────►'  q   ok()
n=   0;  b=  -5;   q= nBase(n, b);   say right(n, 20)   @   right(b, 3)  '────►'  q   ok()
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
nBase: procedure; parse arg x,r;             $=  /*obtain args; $ is the integer result.*/
       if r<-10 | r>-2 then do; say 'base' r "must be in range: -2 ───► -10"; exit 13; end
                    do  while x\==0              /*keep processing while  X  isn't zero.*/
                    z= x // r;        x= x % r   /*calculate remainder; calculate int ÷.*/
                    if z<0  then do;  z= z - r   /*subtract a negative  R  from  Z ◄──┐ */
                                      x= x + 1   /*bump  X  by one.                   │ */
                                 end             /*                   Funny "add" ►───┘ */
                    $= z || $                    /*prepend new digit (numeral) to result*/
                    end   /*while*/
       return word($ 0, 1)                       /*possibly adjust for a  zero  value.  */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ok:    ?=;  if pBase(q, b)\=n  then ?= ' ◄──error in negative base calculation';  return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
pBase: procedure; parse arg x,r;   p= 0;   $= 0  /*obtain args; $ is the integer result.*/
       if r<-10 | r>-2 then do; say 'base' r "must be in range: -2 ───► -10"; exit 13; end
            do j=length(x)  by -1  for length(x) /*process each of the numerals in  X.  */
            $= $ + substr(x,j,1) *    r ** p     /*add value of a numeral to $ (result).*/
            p= p + 1                             /*bump the power by 1.                 */
            end   /*j*/                          /* [↓]  process the number "bottom-up".*/
       return $


# Project : Negative base numbers

negs = [[146,-3],[21102,-3],[10,-2],[11110,-2],[15,-10],[195,-10]]
for n = 1 to len(negs) step 2
     enc = encodeNegBase(negs[n][1],negs[n][2])
     encstr = showarray(enc)
     dec = decodeNegBase(negs[n+1][1],negs[n+1][2])
     see "" + negs[n][1] + " encoded in base " + negs[n][2] + " = " + encstr + nl
     see "" + negs[n+1][1] + " decoded in base " + negs[n+1][2] + " = " + dec + nl
next

func encodeNegBase(n,b)
       out = []
       while n != 0
               rem = (n%b)
               if rem < 0
                  rem = rem - b
               ok
               n = ceil(n/b)
               rem = fabs(rem)
               add(out,rem)
       end
       out = reverse(out)
       return out

func decodeNegBase(n,b)
        out = 0
        n = string(n)
        for nr = len(n) to 1 step -1
             out = out + n[nr]*pow(b,len(n)-nr)
        next
        return out

func showarray(vect)
        svect = ""
        for n = 1 to len(vect)
              svect = svect + vect[n]
        next
        return svect


DIGITS = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'

# convert a base 10 integer into a negative base value (as a string)

def negative_base_encode(n, b)
  raise 'base out of range' if (b < -62) || (b > -2)
  return '0' if n == 0
  revdigs = []
  while n != 0 do
    n, r = n.divmod(b)
    if r < 0
      n += 1
      r -= b
    end
    revdigs << r
  end
  return revdigs.reduce('') { |digstr, digit| DIGITS[digit] + digstr }
end

# convert a negative base value (as a string) into a base 10 integer

def negative_base_decode(n, b)
  raise 'base out of range' if (b < -62) || (b > -2)
  value = 0
  n.reverse.each_char.with_index do |ch, inx|
    value += DIGITS.index(ch) * b**inx
  end
  return value
end

# do the task

[ [10, -2], [146, -3], [15, -10], [0, -31], [-6221826, -62] ].each do |pair|
  decimal, base = pair
  encoded = negative_base_encode(decimal, base)
  decoded = negative_base_decode(encoded, base)
  puts("Enc: %8i base %-3i = %5s base %-3i  Dec: %5s base %-3i = %8i base %-3i" %
       [decimal, 10, encoded, base, encoded, base, decoded, 10])
end


const DIGITS: [char;62] = ['0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'];

fn main() {
  let nums_and_bases: [(i64,i64);5] = [(10,-2),(146,-3),(15,-10),(-6222885,-62),(1488588316238,-62)];

  for (n,b) in nums_and_bases.iter() {
    let ns = encode_neg_base(*n, *b);
    println!("{} encoded in base {} = {}", *n, *b, &ns);
    let nn = decode_neg_base(&ns, *b);
    println!("{} decoded in base {} = {}\n", &ns, *b, nn);
  }
}

fn decode_neg_base(ns: &str, b: i64) -> i64 {
    if b < -62 || b > -1 {
        panic!("base must be between -62 and -1 inclusive")
    }
    if ns == "0" {
        return 0
    }
    let mut total: i64 = 0;
    let mut bb: i64 = 1;
    for c in ns.chars().rev() {
        total += (DIGITS.iter().position(|&d| d==c).unwrap() as i64) * bb;
        bb *= b;
    }
    return total;
}

fn encode_neg_base(mut n: i64, b: i64) -> String {
  if b < -62 || b > -1 {
    panic!("base must be between -62 and -1 inclusive");
  }
  if n == 0 {
      return "0".to_string();
  }
  let mut out = String::new();
  while n != 0 {
    let mut rem = n % b;
      n /= b;
      if rem < 0 {
          n+=1;
          rem -= b;
      }
      out.push(DIGITS[rem as usize]);
  }
  return out.chars().rev().collect();
}


object NegativeBase {
  val digits = ('0' to '9') ++ ('a' to 'z') ++ ('A' to 'Z')

  def intToStr(n: Int, b: Int): String = {
    def _fromInt(n: Int): List[Int] = {
      if (n == 0) {
        Nil
      } else {
        val r = n % b
        val rp = if (r < 0) r + b else r
        val m = -(n - rp)/b
        rp :: _fromInt(m)
      }
    }
    _fromInt(n).map(digits).reverse.mkString
  }

  def strToInt(s: String, b: Int): Int = {
    s.map(digits.indexOf).foldRight((0, 1)){ case (x, (sum, pow)) =>
      (sum + x * pow, pow * -b)
    }._1
  }
}


$ include "seed7_05.s7i";

const string: DIGITS is "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";

const func string: encodeNegativeBase (in var integer: number, in integer: base) is func
  result
    var string: encoded is "";
  local
    var integer: remainder is 0;
  begin
    if base < -62 or base > -1 then
      raise RANGE_ERROR;
    elsif number = 0 then
      encoded := "0";
    else
      while number <> 0 do
        remainder := number rem base;
        number := number div base;
        if remainder < 0 then
          incr(number);
          remainder -:= base;
        end if;
        encoded &:= DIGITS[succ(remainder)];
      end while;
      encoded := reverse(encoded);
    end if;
  end func;

const func integer: decodeNegativeBase (in string: encoded, in integer: base) is func
  result
    var integer: decoded is 0;
  local
    var integer: factor is 1;
    var integer: index is 0;
    var integer: digit is 0;
  begin
    if base < -62 or base > -1 then
      raise RANGE_ERROR;
    elsif encoded = "0" then
      decoded := 0;
    else
      for index range length(encoded) downto 1 do
        digit := pred(pos(DIGITS, encoded[index]));
        if digit = -1 then
          raise RANGE_ERROR;
        else
          decoded +:= digit * factor;
          factor *:= base;
        end if;
      end for;
    end if;
  end func;

const proc: doCheck (in integer: number, in integer: base) is func
  local
    var string: encoded is "";
    var integer: decoded is 0;
  begin
    encoded := encodeNegativeBase(number, base);
    writeln(number lpad 10 <& " encoded in base " <& base lpad 3 <& " = " <& encoded);
    decoded := decodeNegativeBase(encoded, base);
    writeln(encoded lpad 10 <& " decoded in base " <& base lpad 3 <& " = " <& decoded);
  end func;

const proc: main is func
  begin
    doCheck(10, -2);
    doCheck(146, -3);
    doCheck(15, -10);
    doCheck(404355637, -62);
  end func;


func EncodeNegBase(Num n, Num b { .~~ (-36 .. -2) }) {
    var out = []
    var r = 0
    while (n) {
        (n, r) = divmod(n, b)
        if (r < 0) {
            n += 1
            r -= b
        }
        out << r.base(-b)
    }
    return (out.join.flip || "0")
}

func DecodeNegBase(Str s, Num b { .~~ (-36 .. -2) }) {
    var total = 0
    for i,c in (s.flip.chars.kv) {
        total += (Num(c, -b) * b**i)
    }
    return total
}

say (" 10 in base  -2: ", EncodeNegBase(10, -2))
say ("146 in base  -3: ", EncodeNegBase(146, -3))
say (" 15 in base -10: ", EncodeNegBase(15, -10))

say '-'*25

say ("11110 from base  -2: ", DecodeNegBase("11110", -2))
say ("21102 from base  -3: ", DecodeNegBase("21102", -3))
say ("  195 from base -10: ", DecodeNegBase("195",  -10))

say '-'*25

# Extra
say ("25334424 in base -31: ", EncodeNegBase(25334424, -31))
say ("sidef  from base -31: ", DecodeNegBase("sidef", -31))


Const DIGITS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Dim Str(63) As String
Private Function mod2(a As Long, b As Integer) As Long
    mod2 = a - (a \ b) * b
End Function
Private Function swap(a As String, b As String)
    Dim t As String
    t = a
    a = b
    b = t
End Function
Private Function EncodeNegativeBase(ByVal n As Long, base As Integer) As String
    Dim ptr, idx As Long
    Dim rem_ As Long
    Dim result As String
    If base > -1 Or base < -62 Then
        EncodeNegativeBase = result
    Else
        If n = 0 Then
            EncodeNegativeBase = "0"
        Else
            ptr = 0
            Do While n <> 0
                rem_ = mod2(n, base)
                n = n \ base
                If rem_ < 0 Then
                    n = n + 1
                    rem_ = rem_ - base
                End If
                result = result & Mid(DIGITS, rem_ + 1, 1)
            Loop
        End If
    End If
    EncodeNegativeBase = StrReverse(result)
End Function
Private Function DecodeNegativeBase(ns As String, base As Integer) As Long
    Dim total As Long, bb As Long
    Dim i As Integer, j As Integer
    If base < -62 Or base > -1 Then DecodeNegativeBase = 0
    If Mid(ns, 1, 1) = 0 Or (Mid(ns, 1, 1) = "0" And Mid(ns, 2, 1) = 0) Then DecodeNegativeBase = 0
    i = Len(ns)
    total = 0
    bb = 1
    Do While i >= 1
        j = InStr(1, DIGITS, Mid(ns, i, 1), vbTextCompare) - 1
        total = total + j * bb
        bb = bb * base
        i = i - 1
    Loop
    DecodeNegativeBase = total
End Function
Private Sub Driver(n As Long, b As Integer)
    Dim ns As String
    Dim p As Long
    ns = EncodeNegativeBase(n, b)
    Debug.Print CStr(n); " encoded in base "; b; " = "; ns
    p = DecodeNegativeBase(ns, b)
    Debug.Print ns; " decoded in base "; b; " = "; p
    Debug.Print
End Sub
Public Sub main()
    Driver 10, -2
    Driver 146, -3
    Driver 15, -10
    Driver 118492, -62
End Sub


import "/fmt" for Fmt

var digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

var encodeNegBase = Fn.new { |n, b|
    if (b < -62 || b > -1) Fiber.abort("Base must be between -1 and -62")
    if (n == 0) return "0"
    var out = ""
    while (n != 0) {
        var rem = n % b
        n = (n/b).truncate
        if (rem < 0) {
            n = n + 1
            rem = rem -b
        }
        out = out + digits[rem]
    }
    return out[-1..0]
}

var decodeNegBase = Fn.new { |ns, b|
    if (b < -62 || b > -1) Fiber.abort("Base must be between -1 and -62")
    if (ns == "0") return 0
    var total = 0
    var bb = 1
    for (c in ns[-1..0]) {
        total = total + digits.indexOf(c)*bb
        bb = bb * b
    }
    return total
}

var nbl = [ [10, -2], [146, -3], [15, -10], [-7425195, -62] ]
for (p in nbl) {
    var ns = encodeNegBase.call(p[0], p[1])
    Fmt.print("$8d encoded in base $-3d = $s", p[0], p[1], ns)
    var n = decodeNegBase.call(ns, p[1])
    Fmt.print("$8s decoded in base $-3d = $d\n", ns, p[1], n)
}


fcn toNBase(n,radix){
   var [const] cs=[0..9].chain(["a".."z"]).pump(String);  //"0123456789abcd..z"
   _assert_(-37 < radix < -1,"invalid radix");
   digits:=List();
   while(n){ reg r;
      n,r=n.divr(radix);	// C compiler semantics
      if(r<0){ n+=1; r-=radix; }
      digits.append(r);
   }
   digits.reverse().pump(String,cs.get);
}

fcn toInt(str,radix){  // the toInt(radix) method radix is 2..36
   str.reduce('wrap(s,d,rdx){ s*radix + d.toInt(rdx); },0,radix.abs());
}


F narcissists(m)
   [Int] result
   L(digits) 0..
      V digitpowers = (0.<10).map(i -> i ^ @digits)
      L(n) Int(10 ^ (digits - 1)) .< 10 ^ digits
         V (div, digitpsum) = (n, 0)
         L div != 0
            (div, V mod) = divmod(div, 10)
            digitpsum += digitpowers[mod]
         I n == digitpsum
            result [+]= n
            I result.len == m
               R result

L(n) narcissists(25)
   print(n, end' ‘ ’)
   I (L.index + 1) % 5 == 0
      print()


with Ada.Text_IO;

procedure Narcissistic is

   function Is_Narcissistic(N: Natural) return Boolean is
      Decimals: Natural := 1;
      M: Natural := N;
      Sum: Natural := 0;
   begin
      while M >= 10 loop
	 M := M / 10;
	 Decimals := Decimals + 1;
      end loop;
      M := N;
      while M >= 1 loop
	 Sum := Sum + (M mod 10) ** Decimals;
	 M := M/10;
      end loop;
      return Sum=N;
   end Is_Narcissistic;

   Count, Current: Natural := 0;

begin
   while Count < 25 loop
      if Is_Narcissistic(Current) then
	 Ada.Text_IO.Put(Integer'Image(Current));
	 Count := Count + 1;
      end if;
      Current := Current + 1;
   end loop;
end Narcissistic;


scope
    # print the first 25 narcissistic numbers

    local power := reg( 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 );
    local count      := 0;
    local maxCount   := 25;
    local candidate  := 0;
    local prevDigits := 0;
    local digits     := 1;

    for d9 from 0 to 2 while count < maxCount do
        if d9 > 0 and digits < 9 then digits := 9 fi;
        for d8 from 0 to 9 while count < maxCount do
            if d8 > 0 and digits < 8 then digits := 8 fi;
            for d7 from 0 to 9 while count < maxCount do
                if d7 > 0 and digits < 7 then digits := 7 fi;
                for d6 from 0 to 9 while count < maxCount do
                    if d6 > 0 and digits < 6 then digits := 6 fi;
                    for d5 from 0 to 9 while count < maxCount do
                        if d5 > 0 and digits < 5 then digits := 5 fi;
                        for d4 from 0 to 9 while count < maxCount do
                            if d4 > 0 and digits < 4 then digits := 4 fi;
                            for d3 from 0 to 9 while count < maxCount do
                                if d3 > 0 and digits < 3 then digits := 3 fi;
                                for d2 from 0 to 9 while count < maxCount do
                                    if d2 > 0 and digits < 2 then digits := 2 fi;
                                    for d1 from 0 to 9 do
                                        if prevDigits <> digits then
                                            # number of digits has increased - increase the powers
                                            prevDigits := digits;
                                            for i from 2 to 9 do mul power[ i + 1 ], i od;
                                        fi;
                                        # sum the digits'th powers of the digits of candidate
                                        local sum := power[ d1 + 1 ] + power[ d2 + 1 ] + power[ d3 + 1 ]
                                                   + power[ d4 + 1 ] + power[ d5 + 1 ] + power[ d6 + 1 ]
                                                   + power[ d7 + 1 ] + power[ d8 + 1 ] + power[ d9 + 1 ]
                                                   ;
                                        if candidate = sum
                                        then
                                            # found another narcissistic decimal number
                                            io.write( " ", candidate );
                                            inc count, 1
                                        fi;
                                        inc candidate, 1
                                    od; # d1
                                od; # d2
                            od; # d3
                        od; # d4
                    od; # d5
                od; # d6
            od; # d7
        od; # d8
    od; # d9
    io.writeline()

epocs


# find some narcissistic decimal numbers                                      #

# returns TRUE if n is narcissitic, FALSE otherwise; n should be >= 0         #
PROC is narcissistic = ( INT n )BOOL:
     BEGIN
        # count the number of digits in n                                     #
        INT digits := 0;
        INT number := n;
        WHILE digits +:= 1;
              number OVERAB 10;
              number > 0
        DO SKIP OD;
        # sum the digits'th powers of the digits of n                         #
        INT sum := 0;
        number  := n;
        TO digits DO
            sum +:= ( number MOD 10 ) ^ digits;
            number OVERAB 10
        OD;
        # n is narcissistic if n = sum                                        #
        n = sum
     END # is narcissistic # ;

# print the first 25 narcissistic numbers                                     #
INT count := 0;
FOR n FROM 0 WHILE count < 25 DO
    IF is narcissistic( n ) THEN
        # found another narcissistic number                                   #
        print( ( " ", whole( n, 0 ) ) );
        count +:= 1
    FI
OD;
print( ( newline ) )


begin
    % print the first 25 narcissistic numbers                                 %

    integer array  power( 0 :: 9 );
    integer count, candidate, prevDigits, digits;

    power( 0 ) := 0;
    for i := 1 until 9 do power( i ) := 1;

    count      := 0;
    candidate  := 0;
    prevDigits := 0;
    digits     := 1;

    for d9 := 0 until 2 do begin
        if d9 > 0 and digits < 9 then digits := 9;
        for d8 := 0 until 9 do begin
            if d8 > 0 and digits < 8 then digits := 8;
            for d7 := 0 until 9 do begin
                if d7 > 0 and digits < 7 then digits := 7;
                for d6 := 0 until 9 do begin
                    if d6 > 0 and digits < 6 then digits := 6;
                    for d5 := 0 until 9 do begin
                        if d5 > 0 and digits < 5 then digits := 5;
                        for d4 := 0 until 9 do begin
                            if d4 > 0 and digits < 4 then digits := 4;
                            for d3 := 0 until 9 do begin
                                if d3 > 0 and digits < 3 then digits := 3;
                                for d2 := 0 until 9 do begin
                                    if d2 > 0 and digits < 2 then digits := 2;
                                    for d1 := 0 until 9 do begin
                                        integer number, sum;
                                        if prevDigits <> digits then begin
                                            % number of digits has increased %
                                            % - increase the powers          %
                                            prevDigits := digits;
                                            for i := 2 until 9 do power( i ) := power( i ) * i;
                                        end;

                                        % sum the digits'th powers of the    %
                                        % digits of candidate                %
                                        sum := power( d1 ) + power( d2 ) + power( d3 )
                                             + power( d4 ) + power( d5 ) + power( d6 )
                                             + power( d7 ) + power( d8 ) + power( d9 )
                                             ;
                                        if candidate = sum then begin
                                            % found another narcissistic    %
                                            % decimal number                %
                                            writeon( i_w := 1, s_w := 1, candidate );
                                            count := count + 1;
                                            if count >= 25 then goto done
                                        end;
                                        candidate := candidate + 1
                                    end d1;
                                end d2;
                            end d3;
                        end d4;
                    end d5;
                end d6;
            end d7;
        end d8;
    end d9;
done:
    write()

end.


∇r ← digitsOf n;digitList
  digitList ← ⍬
loop:→((⌊n)=0)/done
  digitList ← digitList,(⌊n|⍨10)
  n ← n÷10
  →loop
done: r ← ⊖digitList
∇

∇r ← getASN n;idx;list
  idx ← 0
  list ← 0⍴0
loop:
  →(n=⍴list)/done
  →(isArmstrongNumber idx)/add
  →next
add:
  list ← list,idx
next:
  idx ← idx+1
  →loop
done:
  r ← list
∇

∇r ← isArmstrongNumber n;digits;nd
  digits ← digitsOf n  ⍝⍝ (⍎¨⍕n) is equivalent, but about 45% slower!!
  nd ← ≢ digits
  r ← n = +/digits * nd
∇

      getASN 25
0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315


------------------------- NARCISSI -----------------------

-- isDaffodil :: Int -> Int -> Bool
on isDaffodil(e, n)
    set ds to digitList(n)
    (e = length of ds) and (n = powerSum(e, ds))
end isDaffodil

-- digitList :: Int -> [Int]
on digitList(n)
    if n > 0 then
        {n mod 10} & digitList(n div 10)
    else
        {}
    end if
end digitList

-- powerSum :: Int -> [Int] -> Int
on powerSum(e, ns)
    script
        on |λ|(a, x)
            a + x ^ e
        end |λ|
    end script

    foldl(result, 0, ns) as integer
end powerSum

-- narcissiOfLength :: Int -> [Int]
on narcissiOfLength(nDigits)
    script nthPower
        on |λ|(x)
            {x, x ^ nDigits as integer}
        end |λ|
    end script
    set powers to map(nthPower, enumFromTo(0, 9))

    script combn
        on digitTree(n, parents)
            if n > 0 then
                if parents ≠ {} then
                    script nextLayer
                        on |λ|(pair)
                            set {digit, intSum} to pair
                            script addPower
                                on |λ|(dp)
                                    set {d, p} to dp
                                    {d, p + intSum}
                                end |λ|
                            end script

                            map(addPower, items 1 thru (digit + 1) of powers)
                        end |λ|
                    end script

                    set nodes to concatMap(nextLayer, parents)
                else
                    set nodes to powers
                end if
                digitTree(n - 1, nodes)
            else
                script
                    on |λ|(pair)
                        isDaffodil(nDigits, item 2 of pair)
                    end |λ|
                end script

                filter(result, parents)
            end if
        end digitTree
    end script

    script snd
        on |λ|(ab)
            item 2 of ab
        end |λ|
    end script
    map(snd, combn's digitTree(nDigits, {}))
end narcissiOfLength

--------------------------- TEST -------------------------
on run

    {0} & concatMap(narcissiOfLength, enumFromTo(1, 5))
    -- 4 seconds, 20 narcissi

    -- {0} & concatMap(narcissiOfLength, enumFromTo(1, 6))
    -- 103 seconds, 21 narcissi

    -- {0} & concatMap(narcissiOfLength, enumFromTo(1, 7))
    -- 13.75 minutes, 25 narcissi

end run

-------------------- GENERIC FUNCTIONS -------------------

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lst to {}
    set lng to length of xs
    tell mReturn(f)
        repeat with i from 1 to lng
            set lst to (lst & |λ|(item i of xs, i, xs))
        end repeat
    end tell
    return lst
end concatMap

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if n < m then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
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

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


powers: map 0..9 'x [
    map 0..9 'y [
        x ^ y
    ]
]

getPair: function [p,sz].memoize[
    if not? numeric? last p -> return powers\[to :integer to :string first p]\[sz]
    return powers\[to :integer to :string first p]\[sz] + powers\[to :integer to :string last p]\[sz]
]

narcissistic?: function [n][
    digs: digits n
    sdigs: size digs
    n = sum map split.every:2 to :string n 'p -> getPair p sdigs
]

i: new 0
counter: new 0
while [counter < 25][
    if narcissistic? i [
        print i
        inc 'counter
    ]
    inc 'i
]


#NoEnv ; Do not try to use environment variables
SetBatchLines, -1 ; Execute as quickly as you can

StartCount := A_TickCount
Narc := Narc(25)
Elapsed := A_TickCount - StartCount

MsgBox, Finished in %Elapsed%ms`n%Narc%
return

Narc(m)
{
	Found := 0, Lower := 0
	Progress, B2
	Loop
	{
		Max := 10 ** Digits:=A_Index
		Loop, 10
			Index := A_Index-1, Powers%Index% := Index**Digits
		While Lower < Max
		{
			Sum := 0
			Loop, Parse, Lower
				Sum += Powers%A_LoopField%
			Loop, 10
			{

				if (Lower + (Index := A_Index-1) == Sum + Powers%Index%)
				{
					Out .= Lower+Index . (Mod(++Found,5) ? ", " : "`n")
					Progress, % Found/M*100
					if (Found >= m)
					{
						Progress, Off
						return Out
					}
				}
			}
			Lower += 10
		}
	}
}


# syntax: GAWK -f NARCISSISTIC_DECIMAL_NUMBER.AWK
BEGIN {
    for (n=0;;n++) {
      leng = length(n)
      sum = 0
      for (i=1; i<=leng; i++) {
        c = substr(n,i,1)
        sum += c ^ leng
      }
      if (n == sum) {
        printf("%d ",n)
        if (++count == 25) { break }
      }
    }
    exit(0)
}


B10 ← 10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
IsNarc ← {𝕩=+´⋆⟜≠B10 𝕩}

/IsNarc¨ ↕1e7


#include <stdio.h>
#include <gmp.h>

#define MAX_LEN 81

mpz_t power[10];
mpz_t dsum[MAX_LEN + 1];
int cnt[10], len;

void check_perm(void)
{
	char s[MAX_LEN + 1];
	int i, c, out[10] = { 0 };

	mpz_get_str(s, 10, dsum[0]);
	for (i = 0; s[i]; i++) {
		c = s[i]-'0';
		if (++out[c] > cnt[c]) return;
	}

	if (i == len)
		gmp_printf(" %Zd", dsum[0]);
}

void narc_(int pos, int d)
{
	if (!pos) {
		check_perm();
		return;
	}

	do {
		mpz_add(dsum[pos-1], dsum[pos], power[d]);
		++cnt[d];
		narc_(pos - 1, d);
		--cnt[d];
	} while (d--);
}

void narc(int n)
{
	int i;
	len = n;
	for (i = 0; i < 10; i++)
		mpz_ui_pow_ui(power[i], i, n);

	mpz_init_set_ui(dsum[n], 0);

	printf("length %d:", n);
	narc_(n, 9);
	putchar('\n');
}

int main(void)
{
	int i;

	for (i = 0; i <= 10; i++)
		mpz_init(power[i]);
	for (i = 1; i <= MAX_LEN; i++) narc(i);

	return 0;
}


using System;

namespace Narcissistic
{
    class Narcissistic
    {
        public bool isNarcissistic(int z)
        {
            if (z < 0) return false;
            string n = z.ToString();
            int t = 0, l = n.Length;
            foreach (char c in n)
                t += Convert.ToInt32(Math.Pow(Convert.ToDouble(c - 48), l));

            return t == z;
        }
    }

    class Program
    {
        static void Main(string[] args)
        {
            Narcissistic n = new Narcissistic();
            int c = 0, x = 0;
            while (c < 25)
            {
                if (n.isNarcissistic(x))
                {
                    if (c % 5 == 0) Console.WriteLine();
                    Console.Write("{0,7} ", x);
                    c++;
                }
                x++;
            }
            Console.WriteLine("\n\nPress any key to continue...");
            Console.ReadKey();
        }
    }
}


#include <iostream>
#include <vector>
using namespace std;
typedef unsigned int uint;

class NarcissisticDecs
{
public:
    void makeList( int mx )
    {
	uint st = 0, tl; int pwr = 0, len;
        while( narc.size() < mx )
	{
	    len = getDigs( st );
	    if( pwr != len )
	    {
		pwr = len;
		fillPower( pwr );
	    }
            tl = 0;
	    for( int i = 1; i < 10; i++ )
		tl += static_cast<uint>( powr[i] * digs[i] );

	    if( tl == st ) narc.push_back( st );
	    st++;
	}
    }

    void display()
    {
	for( vector<uint>::iterator i = narc.begin(); i != narc.end(); i++ )
	    cout << *i << " ";
	cout << "\n\n";
    }

private:
    int getDigs( uint st )
    {
	memset( digs, 0, 10 * sizeof( int ) );
	int r = 0;
	while( st )
	{
	    digs[st % 10]++;
	    st /= 10;
	    r++;
	}
        return r;
    }

    void fillPower( int z )
    {
	for( int i = 1; i < 10; i++ )
	    powr[i] = pow( static_cast<float>( i ), z );
    }

    vector<uint> narc;
    uint powr[10];
    int digs[10];
};

int main( int argc, char* argv[] )
{
    NarcissisticDecs n;
    n.makeList( 25 );
    n.display();
    return system( "pause" );
}


(ns narcissistic.core
  (:require [clojure.math.numeric-tower :as math]))

(defn digits [n] ;; digits of a number.
  (->> n str (map (comp read-string str))))

(defn narcissistic? [n] ;; True if the number is a Narcissistic one.
  (let [d (digits n)
        s (count d)]
    (= n (reduce + (map #(math/expt % s) d)))))

(defn firstNnarc [n] ;;list of the first "n" Narcissistic numbers.
  (take n (filter narcissistic? (range))))


       PROGRAM-ID. NARCISSIST-NUMS.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

           01 num-length PIC 9(2) value 0.
           01 in-sum PIC  9(9) value 0.
           01 counter PIC  9(9) value 0.
           01 current-number PIC  9(9) value 0.
           01 narcissist PIC Z(9).
           01 temp PIC  9(9) value 0.
           01 modulo PIC  9(9) value 0.
           01 answer PIC  9 .

       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
           DISPLAY "the first 20 narcissist numbers:" .

           MOVE 20 TO counter.
           PERFORM UNTIL counter=0

               PERFORM 000-NARCISSIST-PARA

                   IF answer = 1
                       SUBTRACT 1 from counter
                       GIVING counter
                       MOVE current-number TO narcissist
                       DISPLAY narcissist
                   END-IF

                   ADD 1 TO current-number

               END-PERFORM

            STOP RUN.

       000-NARCISSIST-PARA.

             MOVE ZERO TO in-sum.
             MOVE current-number TO temp.
             COMPUTE num-length =1+  FUNCTION Log10(temp)

             PERFORM  UNTIL temp=0

                  DIVIDE temp BY 10 GIVING temp
                            REMAINDER  modulo

                  COMPUTE modulo=modulo**num-length
                  ADD modulo to in-sum GIVING in-sum

            END-PERFORM.

               IF current-number=in-sum
                   MOVE 1 TO answer
                   ELSE MOVE 0 TO answer
               END-IF.

       END PROGRAM NARCISSIST-NUMS.


(defun integer-to-list (n)
  (map 'list #'digit-char-p (prin1-to-string n)))

(defun narcissisticp (n)
  (let* ((lst (integer-to-list n))
         (e (length lst)))
        (= n
	   (reduce #'+ (mapcar (lambda (x) (expt x e)) lst)))))

(defun start ()
  (loop for c from 0
        while (< narcissistic 25)
        counting (narcissisticp c) into narcissistic
        do (if (narcissisticp c) (print c))))


void main() {
    import std.stdio, std.algorithm, std.conv, std.range;

    immutable isNarcissistic = (in uint n) pure @safe =>
        n.text.map!(d => (d - '0') ^^ n.text.length).sum == n;
    writefln("%(%(%d %)\n%)",
             uint.max.iota.filter!isNarcissistic.take(25).chunks(5));
}


defmodule RC do
  def narcissistic(m) do
    Enum.reduce(1..10, [0], fn digits,acc ->
      digitPowers = List.to_tuple(for i <- 0..9, do: power(i, digits))
      Enum.reduce(power(10, digits-1) .. power(10, digits)-1, acc, fn n,result ->
        sum = divsum(n, digitPowers, 0)
        if n == sum do
          if length(result) == m-1, do: throw Enum.reverse(result, [n])
          [n | result]
        else
          result
        end
      end)
    end)
  end

  defp divsum(0, _, sum), do: sum
  defp divsum(n, digitPowers, sum) do
    divsum(div(n,10), digitPowers, sum+elem(digitPowers,rem(n,10)))
  end

  defp power(n, m), do: power(n, m, 1)

  defp power(_, 0, pow), do: pow
  defp power(n, m, pow), do: power(n, m-1, pow*n)
end

try do
  RC.narcissistic(25)
catch
  x -> IO.inspect x
end


PROGRAM NARCISISTIC

!$DOUBLE

BEGIN
    N=0
    LOOP
      C$=MID$(STR$(N),2)
      LENG=LEN(C$)
      SUM=0
      FOR I=1 TO LENG DO
        C=VAL(MID$(C$,I,1))
        SUM+=C^LENG
      END FOR
      IF N=SUM THEN
        PRINT(N;)
        COUNT=COUNT+1
        EXIT IF COUNT=25
      END IF
      N=N+1
    END LOOP
END PROGRAM


//Naïve solution of Narcissitic number: Nigel Galloway - Febryary 18th., 2015
open System
let rec _Digits (n,g) = if n < 10 then n::g else _Digits(n/10,n%10::g)

seq{0 .. Int32.MaxValue} |> Seq.filter (fun n ->
  let d = _Digits (n, [])
  d |> List.fold (fun a l -> a + int ((float l) ** (float (List.length d)))) 0 = n) |> Seq.take(25) |> Seq.iter (printfn "%A")


USING: io kernel lists lists.lazy math math.functions
math.text.utils prettyprint sequences ;
IN: rosetta-code.narcissistic-decimal-number

: digit-count ( n -- count ) log10 floor >integer 1 + ;

: narcissist? ( n -- ? ) dup [ 1 digit-groups ]
    [ digit-count [ ^ ] curry ] bi map-sum = ;

: first25 ( -- seq ) 25 0 lfrom [ narcissist? ] lfilter
    ltake list>array ;

: main ( -- ) first25 [ pprint bl ] each ;

MAIN: main


 : dig.num                           \ returns input number and the number of its digits ( n -- n n1 )
	 dup
	 0 swap
     begin
	 swap 1 + swap
	 dup 10 >= while
	 10 /
     repeat
	 drop ;

 : zero.divmod                         \ /mod that returns zero if number is zero
	   dup
	   0 = if drop 0 else
           /mod
	   then ;

 : zero.div                            \ division that returns zero if divisor is zero
	 dup
	 0 = if drop else
         /
	 then ;

 : next.last
	 depth 2 - roll ;                 \ gets next-to-last number from the stack

 : ten.to			          \ ( n -- 10^n ) returns 1 for zero and negative
	  dup 0 <= if drop 1 else
	  dup 1 = if drop 10 else
	  10 swap
	  1 do
	  10 *
	  loop then then ;

 : split.div                                        \ returns input number and its digits ( n -- n n1 n2 n3....)
	   dup 10 < if dup  else		    \ duplicates single digit numbers
	   dig.num				    \ provides number of digits
	   swap dup rot dup 1 - ten.to swap         \ stack juggling, ten raised to number of digits - 1...
	   1 do                                     \ ... is the needed divisor, counter on top and ...
	   dup rot swap zero.divmod swap rot 10 /   \ ...division loop
	   loop drop then ;

 : to.pow                           \ nth power of positive numbers ( n m -- n^m )
	 swap dup rot
	 dup 0 <= if
	 2drop drop 1
	 else
	 0 do
	 swap dup rot *
	 loop
	 swap zero.div
	 then ;

 : num.pow                        \ raises each digit to the power of (number of digits)
	 depth 1 - 0 do
	 next.last depth 1 - to.pow
	 loop ;

 : add.num
	 depth 2 > if
	 begin
	 +
	 depth 2 = until then ;

 : narc.check
	split.div
        num.pow
        add.num ;

 : narc.num 0 { a b }              \  ( m -- n1 n2 n3 ... nm )
	 page                      \ displays m narcissistic decimal numbers...
	 999999999 0 do            \ ...beginning with 0
	 a b = if leave then
	 i narc.check = if
	 i . cr b 1 + to b
	 then
	 loop
	 ;

 25 narc.num


' normal version: 14-03-2017
' compile with: fbc -s console
' can go up to 18 digits (ulongint is 64bit), above 18 overflow will occur

Dim As Integer n, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, a, b
Dim As Integer d()
Dim As ULongInt d2pow(0 To 9) = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim As ULongInt x
Dim As String str_x

For n = 1 To 7
  For n9 = n To 0 Step -1
    For n8 = n-n9 To 0 Step -1
      For n7 = n-n9-n8 To 0 Step -1
        For n6 = n-n9-n8-n7 To 0 Step -1
          For n5 = n-n9-n8-n7-n6 To 0 Step -1
            For n4 = n-n9-n8-n7-n6-n5 To 0 Step -1
              For n3 = n-n9-n8-n7-n6-n5-n4 To 0 Step -1
                For n2 = n-n9-n8-n7-n6-n5-n4-n3 To 0 Step -1
                  For n1 = n-n9-n8-n7-n6-n5-n4-n3-n2 To 0 Step -1
                    n0 = n-n9-n8-n7-n6-n5-n4-n3-n2-n1

                    x = n1 + n2*d2pow(2) + n3*d2pow(3) + n4*d2pow(4) + n5*d2pow(5)_
                           + n6*d2pow(6) + n7*d2pow(7) + n8*d2pow(8) + n9*d2pow(9)

                    str_x = Str(x)
                    If Len(str_x) = n Then

                      ReDim d(10)
                      For a = 0 To n-1
                        d(Str_x[a]- Asc("0")) += 1
                      Next a

                      If n0 = d(0) AndAlso n1 = d(1) AndAlso n2 = d(2) AndAlso n3 = d(3)_
                                   AndAlso n4 = d(4) AndAlso n5 = d(5) AndAlso n6 = d(6)_
                                   AndAlso n7 = d(7) AndAlso n8 = d(8) AndAlso n9 = d(9) Then
                        Print x
                      End If
                    End If

                  Next n1
                Next n2
              Next n3
            Next n4
          Next n5
        Next n6
      Next n7
    Next n8
  Next n9

  For a As Integer = 2 To 9
    d2pow(a) = d2pow(a) * a
  Next a

Next n

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


def narcissistic( start ) =
  power = 1
  powers = array( 0..9 )

  def narc( n ) =
    num = n.toString()
    m = num.length()

    if power != m
      power = m
      powers( 0..9 ) = [i^m | i <- 0..9]

    if n == sum( powers(int(d)) | d <- num )
      n # narc( n + 1 )
    else
      narc( n + 1 )

  narc( start )

println( narcissistic(0).take(25) )


package main

import "fmt"

func narc(n int) []int {
	power := [...]int{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
	limit := 10
	result := make([]int, 0, n)
	for x := 0; len(result) < n; x++ {
		if x >= limit {
			for i := range power {
				power[i] *= i // i^m
			}
			limit *= 10
		}
		sum := 0
		for xx := x; xx > 0; xx /= 10 {
			sum += power[xx%10]
		}
		if sum == x {
			result = append(result, x)
		}
	}
	return result
}

func main() {
	fmt.Println(narc(25))
}


1 DEFINT A-W : DEFDBL X-Z : DIM D(9) : DIM X2(9) : KEY OFF : CLS
2 FOR A = 0 TO 9 : X2(A) = A : NEXT A
3 FOR N = 1 TO 7
4 FOR N9 = N TO 0 STEP -1
5 FOR N8 = N-N9 TO 0 STEP -1
6 FOR N7 = N-N9-N8 TO 0 STEP -1
7 FOR N6 = N-N9-N8-N7 TO 0 STEP -1
8 FOR N5 = N-N9-N8-N7-N6 TO 0 STEP -1
9 FOR N4 = N-N9-N8-N7-N6-N5 TO 0 STEP -1
10 FOR N3 = N-N9-N8-N7-N6-N5-N4 TO 0 STEP -1
11 FOR N2 = N-N9-N8-N7-N6-N5-N4-N3 TO 0 STEP -1
12 FOR N1 = N-N9-N8-N7-N6-N5-N4-N3-N2 TO 0 STEP -1
13 N0 = N-N9-N8-N7-N6-N5-N4-N3-N2-N1
14 X = N1 + N2*X2(2) + N3*X2(3) + N4*X2(4) + N5*X2(5) + N6*X2(6) + N7*X2(7) + N8*X2(8) + N9*X2(9)
15 S$ = MID$(STR$(X),2)
16 IF LEN(S$) < N THEN GOTO 25
17 IF LEN(S$) <> N THEN GOTO 24
18 FOR A = 0 TO 9 : D(A) = 0 : NEXT A
19 FOR A = 0 TO N-1
20 B = ASC(MID$(S$,A+1,1))-48
21 D(B) = D(B) + 1
22 NEXT A
23 IF N0 = D(0) AND N1 = D(1) AND N2 = D(2) AND N3 = D(3) AND N4 = D(4) AND N5 = D(5) AND N6 = D(6) AND N7 = D(7) AND N8 = D(8) AND N9 = D(9) THEN PRINT X,
24 NEXT N1 : NEXT N2 : NEXT N3 : NEXT N4 : NEXT N5 : NEXT N6 : NEXT N7 : NEXT N8 : NEXT N9
25 FOR A = 2 TO 9
26 X2(A) = X2(A) * A
27 NEXT A
28 NEXT N
29 PRINT
30 PRINT "done"
31 END


import Data.Char (digitToInt)

isNarcissistic :: Int -> Bool
isNarcissistic n = (sum ((^ digitCount) <$> digits) ==) n
  where
    digits = digitToInt <$> show n
    digitCount = length digits

main :: IO ()
main = mapM_ print $ take 25 (filter isNarcissistic [0 ..])


procedure main(A)
    limit := integer(A[1]) | 25
    every write(isNarcissitic(seq(0))\limit)
end

procedure isNarcissitic(n)
    sn := string(n)
    m := *sn
    every (sum := 0) +:= (!sn)^m
    return sum = n
end


getDigits=: "."0@":                  NB. get digits from number
isNarc=: (= +/@(] ^ #)@getDigits)"0  NB. test numbers for Narcissism


public class Narc{
	public static boolean isNarc(long x){
		if(x < 0) return false;

		String xStr = Long.toString(x);
		int m = xStr.length();
		long sum = 0;

		for(char c : xStr.toCharArray()){
			sum += Math.pow(Character.digit(c, 10), m);
		}
		return sum == x;
	}

	public static void main(String[] args){
		for(long x = 0, count = 0; count < 25; x++){
			if(isNarc(x)){
				System.out.print(x + " ");
				count++;
			}
		}
	}
}


function isNarc(x) {
    var str = x.toString(),
        i,
        sum = 0,
        l = str.length;
    if (x < 0) {
        return false;
    } else {
        for (i = 0; i < l; i++) {
            sum += Math.pow(str.charAt(i), l);
        }
    }
    return sum == x;
}
function main(){
    var n = [];
    for (var x = 0, count = 0; count < 25; x++){
        if (isNarc(x)){
            n.push(x);
            count++;
        }
    }
    return n.join(' ');
}


def is_narcissistic:
  def digits: tostring | explode[] | [.] | implode | tonumber;
  def pow(n): . as $x | reduce range(0;n) as $i (1; . * $x);

  (tostring | length) as $len
  | . == reduce digits as $d (0;  . + ($d | pow($len)) )
  end;


using Printf  # for Julia version 1.0+

function isnarcissist(n, b=10)
    -1 < n || return false
    d = digits(n, base=b)
    m = length(d)
    n == mapreduce((x)->x^m, +, d)
end

function findnarcissist(verbose=false)
    goal = 25
    ncnt = 0
    verbose && println("Finding the first ", goal, " Narcissistic numbers:")
    for i in 0:typemax(1)
        isnarcissist(i) || continue
        ncnt += 1
        verbose && println(@sprintf "    %2d %7d" ncnt i)
        ncnt < goal || break
    end
end

findnarcissist()
@time findnarcissist(true)


// version 1.1.0

fun isNarcissistic(n: Int): Boolean {
    if (n < 0) throw IllegalArgumentException("Argument must be non-negative")
    var nn = n
    val digits = mutableListOf<Int>()
    val powers = IntArray(10) { 1 }
    while (nn > 0) {
       digits.add(nn % 10)
       for (i in 1..9) powers[i] *= i // no need to calculate powers[0]
       nn /= 10
    }
    val sum = digits.filter { it > 0 }.map { powers[it] }.sum()
    return n == sum
}

fun main(args: Array<String>) {
    println("The first 25 narcissistic (or Armstrong) numbers are:")
    var i = 0
    var count = 0
    do {
        if (isNarcissistic(i)) {
            print("$i ")
            count++
        }
        i++
    }
    while (count < 25)
}


#!/bin/ksh

# Narcissistic decimal number

#	# Variables:
#

#	# Functions:
#

#	# Function _isnarcissist(n) - return 1 if n is a narcissistic decimal number
#
function _isnarcissist {
	typeset _n ; integer _n=$1

	(( ${_n} == $(_sumpowdigits ${_n}) )) && return 1
	return 0
}

#	# Function _sumpowdigits(n) - return sum of the digits raised to #digit power
#
function _sumpowdigits {
	typeset _n ; integer _n=$1
	typeset _i ; typeset -si _i
	typeset _sum ; integer _sum=0

	for ((_i=0; _i<${#_n}; _i++)); do
		(( _sum+=(${_n:_i:1}**${#_n}) ))
	done
	echo ${_sum}
}

 ######
# main #
 ######

integer i cnt=0
for ((i=0; cnt<25; i++)); do
	_isnarcissist ${i} ; (( $? )) && printf "%3d. %d\n" $(( ++cnt ))  ${i}
done


function isNarc (n)
    local m, sum, digit = string.len(n), 0
    for pos = 1, m do
        digit = tonumber(string.sub(n, pos, pos))
        sum = sum + digit^m
    end
    return sum == n
end

local n, count = 0, 0
repeat
    if isNarc(n) then
        io.write(n .. " ")
        count = count + 1
    end
    n = n + 1
until count == 25


Narc:=proc(i)
	local num,len,j,sums:
	sums:=0:
	num := parse~(StringTools:-Explode((convert(i,string)))):
	len:=numelems(num):
	for j from 1 to len do
		sums:=sums+(num[j]^(len)):
	end do;
	if sums = i then
		return i;
	else
		return NULL;
	end if;
end proc:

i:=0:
NDN:=[]:
while numelems(NDN)<25 do
	NDN:=[op(NDN),(Narc(i))]:
	i:=i+1:
end do:
NDN;


narc[1] = 0;
narc[n_] := narc[n] = NestWhile[# + 1 &, narc[n - 1] + 1, Plus @@ (IntegerDigits[#]^IntegerLength[#]) != # &];
narc /@ Range[25]


function testNarcissism
    x = 0;
    c = 0;
    while c < 25
        if isNarcissistic(x)
            fprintf('%d ', x)
            c = c+1;
        end
        x = x+1;
    end
    fprintf('\n')
end

function tf = isNarcissistic(n)
    dig = sprintf('%d', n) - '0';
    tf = n == sum(dig.^length(dig));
end


def is_narcissist(num)
	digits = {}
	for digit in str(num)
		digits.append(int(digit))
	end

	sum = 0
	for digit in digits
		sum += digit ^ len(num)
	end

	return sum = num
end

def narcissist(n)
	results = {}

	i = 0
	while len(results) < n
		if is_narcissist(i)
			results.append(i)
		end
		i += 1
	end

	return results
end

// get 25 narcissist numbers
for num in narcissist(25)
	print num + " "
end
println


import sequtils, strutils

func digits(n: Natural): seq[int] =
  result.add n mod 10
  var n = n div 10
  while n != 0:
    result.add n mod 10
    n = n div 10

proc findNarcissistic(count: Natural): seq[int] =
  var
    n = 0
    m = 10
    powers = toseq(0..9)
  while true:
    while n < m:
      var s = 0
      for d in n.digits:
        inc s, powers[d]
      if s == n:
        result.add n
        if result.len == count: return
      inc n
    for i in 0..9: powers[i] *= i
    m *= 10

echo findNarcissistic(25).join(" ")


: isNarcissistic(n)
| i m |
   n 0 while( n ) [ n 10 /mod ->n swap 1 + ] ->m
   0 m loop: i [ swap m pow + ] == ;

: genNarcissistic(n)
| l |
   ListBuffer new dup ->l
   0 while(l size n <>) [ dup isNarcissistic ifTrue: [ dup l add ] 1 + ] drop ;


isNarcissistic(n)=my(v=digits(n)); sum(i=1, #v, v[i]^#v)==n
v=List();for(n=1,1e9,if(isNarcissistic(n),listput(v,n);if(#v>24, return(Vec(v)))))


program NdN;
//Narcissistic decimal number
const
  Base = 10;
  MaxDigits = 16;
type
  tDigit = 0..Base-1;
  tcntDgt= 0..MaxDigits-1;
var
  powDgt   : array[tDigit]  of NativeUint;
  PotdgtPos: array[tcntDgt] of NativeUint;
  UpperSum : array[tcntDgt] of NativeUint;

  tmpSum,
  tmpN,
  actPot  : NativeUint;

procedure InitPowDig;
var
  i,j : NativeUint;
Begin
  j := 1;
  For i := 0 to High(tDigit) do
  Begin
    powDgt[i] := i;
    PotdgtPos[i] := j;
    j := j*Base;
  end;
  actPot := 0;
end;

procedure NextPowDig;
var
  i,j : NativeUint;
Begin
  // Next power of digit =  i ^ actPot,always 0 = 0 , 1 = 1
  For i := 2 to High(tDigit) do
    powDgt[i] := powDgt[i]*i;
  // number of digits times 9 ^(max number of digits)
  j := powDgt[High(tDigit)];
  For i := 0 to High(UpperSum) do
    UpperSum[i] := (i+1)*j;
  inc(actPot);
end;
procedure OutPutNdN(n:NativeUint);
Begin
  write(n,' ');
end;

procedure NextDgtSum(dgtPos,i,sumPowDgt,n:NativeUint);
begin
  //unable to reach sum
  IF (sumPowDgt+UpperSum[dgtPos]) < n then
    EXIT;
  repeat
    tmpN   := n+PotdgtPos[dgtPos]*i;
    tmpSum := sumPowDgt+powDgt[i];
    //unable to get smaller
    if tmpSum > tmpN then
      EXIT;
    IF tmpSum = tmpN then
      OutPutNdN(tmpSum);
    IF dgtPos>0 then
      NextDgtSum(dgtPos-1,0,tmpSum,tmpN);
    inc(i);
  until i >= Base;
end;

var
  i : NativeUint;
Begin
  InitPowDig;
  For i := 1 to 9 do
  Begin
    write(' length ',actPot+1:2,': ');
    //start with 1 in front, else you got i-times 0 in front
    NextDgtSum(actPot,1,0,0);
    writeln;
    NextPowDig;
  end;
end.


sub is_narcissistic {
  my $n = shift;
  my($k,$sum) = (length($n),0);
  $sum += $_**$k for split(//,$n);
  $n == $sum;
}
my $i = 0;
for (1..25) {
  $i++ while !is_narcissistic($i);
  say $i++;
}


with javascript_semantics
function narcissistic(integer n)
    string d = sprintf("%d",n)
    integer l = length(d)
    atom sumn = 0
    for i=1 to l do
        sumn += power(d[i]-'0',l)
    end for
    return sumn=n
end function

sequence s = {}
integer n = 0
while length(s)<25 do
    if narcissistic(n) then s &= n end if
    n += 1
end while
pp(s)


(let (C 25 N 0 L 1)
   (loop
      (when
         (=
            N
            (sum ** (mapcar format (chop N)) (need L L)) )
         (println N)
         (dec 'C) )
      (inc 'N)
      (setq L (length N))
      (T (=0 C) 'done) ) )

(bye)


 narn: Proc Options(main);
 Dcl (j,k,l,nn,n,sum) Dec Fixed(15)init(0);
 Dcl s Char(15) Var;
 Dcl p(15) Pic'9' Based(addr(s));
 Dcl (ms,msa,ela) Dec Fixed(15);
 Dcl tim Char(12);
 n=30;
 ms=milliseconds();
 Do j=0 By 1 Until(nn=n);
   s=dec2str(j);
   l=length(s);
   sum=left(s,1)**l;
   Do k=2 To l;
     sum=sum+substr(s,k,1)**l;
     If sum>j Then Leave;
     End;
   If sum=j Then Do
     nn=nn+1;
     msa=milliseconds();
     ela=msa-ms;
     /*Put Skip Data(ms,msa,ela);*/
     ms=msa;                            /*yyyymmddhhmissmis*/
     tim=translate('ij:kl:mn.opq',datetime(),'abcdefghijklmnopq');
     Put Edit(nn,' narcissistic:',j,ela,tim)
             (Skip,f(9),a,f(12),f(15),x(2),a(12));
     End;
   End;
 dec2str: Proc(x) Returns(char(16) var);
 Dcl x Dec Fixed(15);
 Dcl ds Pic'(14)z9';
 ds=x;
 Return(trim(ds));
 End;
 milliseconds: Proc Returns(Dec Fixed(15));
 Dcl c17 Char(17);
 dcl 1 * Def C17,
      2 * char(8),
      2 hh Pic'99',
      2 mm Pic'99',
      2 ss Pic'99',
      2 ms Pic'999';
 Dcl result Dec Fixed(15);
 c17=datetime();
 result=(((hh*60+mm)*60)+ss)*1000+ms;
 /*
 Put Edit(translate('ij:kl:mn.opq',datetime(),'abcdefghijklmnopq'),
          result)
         (Skip,a(12),F(15));
 */
 Return(result);
 End
 End;


function Test-Narcissistic ([int]$Number)
{
    if ($Number -lt 0) {return $false}

    $total  = 0
    $digits = $Number.ToString().ToCharArray()

    foreach ($digit in $digits)
    {
        $total += [Math]::Pow([Char]::GetNumericValue($digit), $digits.Count)
    }

    $total -eq $Number
}

[int[]]$narcissisticNumbers = @()
[int]$i = 0

while ($narcissisticNumbers.Count -lt 25)
{
    if (Test-Narcissistic -Number $i)
    {
        $narcissisticNumbers += $i
    }

    $i++
}

$narcissisticNumbers | Format-Wide {"{0,7}" -f $_} -Column 5 -Force


from __future__ import print_function
from itertools import count, islice

def narcissists():
    for digits in count(0):
        digitpowers = [i**digits for i in range(10)]
        for n in range(int(10**(digits-1)), 10**digits):
            div, digitpsum = n, 0
            while div:
                div, mod = divmod(div, 10)
                digitpsum += digitpowers[mod]
            if n == digitpsum:
                yield n

for i, n in enumerate(islice(narcissists(), 25), 1):
    print(n, end=' ')
    if i % 5 == 0: print()
print()


  [ [] swap
    [ 10 /mod
      rot join swap
      dup 0 = until ]
      drop ]                 is digits     ( n --> [   )

  [ dup digits
    0 over size rot
    witheach
      [ over ** rot + swap ]
    drop = ]                 is narcissistic ( n --> b )

  [] 0
  [ dup narcissistic if
      [ tuck join swap ]
    1+ over size 25 = until ]
  drop echo


for (u in 1:10000000) {
	j <- nchar(u)
	set2 <- c()
	for (i in 1:j) {
		set2[i] <- as.numeric(substr(u, i, i))
		}
	control <- c()
	for (k in 1:j) {
		control[k] <- set2[k]^(j)
		}
	if (sum(control) == u) print(u)
}


;; OEIS: A005188 defines these as positive numbers, so I will follow that definition in the function
;; definitions.
;;
;; 0: assuming it is represented as the single digit 0 (and not an empty string, which is not the
;;    usual convention for 0 in decimal), is not: sum(0^0), which is 1.  0^0 is a strange one,
;;    wolfram alpha calls returns 0^0 as indeterminate -- so I will defer to the brains behind OEIS
;;    on the definition here, rather than copy what I'm seeing in some of the results here
#lang racket

;; Included for the serious efficientcy gains we get from fxvectors vs. general vectors.
;;
;; We also use fx+/fx- etc. As it stands, they do a check for fixnumness, for safety.
;; We can link them in as "unsafe" operations (see the documentation on racket/fixnum);
;; but we get a result from this program quickly enough for my tastes.
(require racket/fixnum)

; uses a precalculated (fx)vector of powers -- caller provided, please.
(define (sub-narcissitic? N powered-digits)
  (let loop ((n N) (target N))
    (cond
      [(fx> 0 target) #f]
      [(fx= 0 target) (fx= 0 n)]
      [(fx= 0 n) #f]
      [else (loop (fxquotient n 10)
                  (fx- target (fxvector-ref powered-digits (fxremainder n 10))))])))

; Can be used as standalone, since it doesn't require caller to care about things like order of
; magnitude etc. However, it *is* slow, since it regenerates the powered-digits vector every time.
(define (narcissitic? n) ; n is +ve
  (define oom+1 (fx+ 1 (order-of-magnitude n)))
  (define powered-digits (for/fxvector ((i 10)) (expt i oom+1)))
  (sub-narcissitic? n powered-digits))

;; next m primes > z
(define (next-narcissitics z m) ; naming convention following math/number-theory's next-primes
  (let-values
      ([(i l)
        (for*/fold ((i (fx+ 1 z)) (l empty))
          ((oom (in-naturals))
           (dgts^oom (in-value (for/fxvector ((i 10)) (expt i (add1 oom)))))
           (n (in-range (expt 10 oom) (expt 10 (add1 oom))))
           #:when (sub-narcissitic? n dgts^oom)
           ; everyone else uses ^C to break...
           ; that's a bit of a manual process, don't you think?
           #:final (= (fx+ 1 (length l)) m))
          (values (+ i 1) (append l (list n))))])
    l)) ; we only want the list

(module+ main
  (next-narcissitics 0 25)
  ; here's another list... depending on whether you believe sloane or wolfram :-)
  (cons 0 (next-narcissitics 0 25)))

(module+ test
  (require rackunit)
  ; example given at head of task
  (check-true (narcissitic? 153))
  ; rip off the first 12 (and 0, since Armstrong numbers seem to be postivie) from
  ; http://oeis.org/A005188 for testing
  (check-equal?
   (for/list ((i (in-range 12))
              (n (sequence-filter narcissitic? (in-naturals 1)))) n)
   '(1 2 3 4 5 6 7 8 9 153 370 371))
  (check-equal? (next-narcissitics 0 12) '(1 2 3 4 5 6 7 8 9 153 370 371)))


sub is-narcissistic(Int $n) { $n == [+] $n.comb »**» $n.chars }

for 0 .. * {
    if .&is-narcissistic {
	.say;
	last if ++state$ >= 25;
    }
}


/*REXX program  generates and displays  a number of  narcissistic (Armstrong)  numbers. */
numeric digits 39                                /*be able to handle largest Armstrong #*/
parse arg N .                                    /*obtain optional argument from the CL.*/
if N=='' | N==","  then N=25                     /*Not specified?  Then use the default.*/
N=min(N, 89)                                     /*there are only  89  narcissistic #s. */
#=0                                              /*number of narcissistic numbers so far*/
     do j=0  until #==N;     L=length(j)         /*get length of the  J  decimal number.*/
     $=left(j, 1) **L                            /*1st digit in  J  raised to the L pow.*/

               do k=2  for L-1  until $>j        /*perform for each decimal digit in  J.*/
               $=$ + substr(j, k, 1) ** L        /*add digit raised to power to the sum.*/
               end   /*k*/                       /* [↑]  calculate the rest of the sum. */

     if $\==j  then iterate                      /*does the sum equal to J?  No, skip it*/
     #=# + 1                                     /*bump count of narcissistic numbers.  */
     say right(#, 9)     ' narcissistic:'     j  /*display index and narcissistic number*/
     end   /*j*/                                 /*stick a fork in it,  we're all done. */


n = 0
count = 0
size = 15
while count != size
      m = isNarc(n)
      if m=1 see "" + n + " is narcisstic" + nl
         count = count + 1 ok
      n = n + 1
end

func isNarc n
     m = len(string(n))
     sum = 0
     digit = 0
     for pos = 1 to m
         digit = number(substr(string(n), pos, 1))
         sum = sum + pow(digit,m)
     next
     nr = (sum = n)
     return nr


class Integer
  def narcissistic?
    return false if negative?
    digs = self.digits
    m    = digs.size
    digs.map{|d| d**m}.sum == self
  end
end

puts 0.step.lazy.select(&:narcissistic?).first(25)


fn is_narcissistic(x: u32) -> bool {
    let digits: Vec<u32> = x
        .to_string()
        .chars()
        .map(|c| c.to_digit(10).unwrap())
        .collect();

    digits
        .iter()
        .map(|d| d.pow(digits.len() as u32))
        .sum::<u32>()
        == x
}

fn main() {
    let mut counter = 0;
    let mut i = 0;
    while counter < 25 {
        if is_narcissistic(i) {
            println!("{}", i);
            counter += 1;
        }
        i += 1;
    }
}


object NDN extends App {

  val narc: Int => Int = n => (n.toString map (_.asDigit) map (math.pow(_, n.toString.size)) sum) toInt
  val isNarc: Int => Boolean = i => i == narc(i)

  println((Iterator from 0 filter isNarc take 25 toList) mkString(" "))

}


func is_narcissistic(n) {
    n.digits »**» n.len -> sum == n
}

var count = 0
for i in ^Inf {
    if (is_narcissistic(i)) {
        say "#{++count}\t#{i}"
        break if (count == 25)
    }
}


extension BinaryInteger {
  @inlinable
  public var isNarcissistic: Bool {
    let digits = String(self).map({ Int(String($0))! })
    let m = digits.count

    guard m != 1 else {
      return true
    }

    return digits.map({ $0.power(m) }).reduce(0, +) == self
  }

  @inlinable
  public func power(_ n: Self) -> Self {
    return stride(from: 0, to: n, by: 1).lazy.map({_ in self }).reduce(1, *)
  }

}

let narcs = Array((0...).lazy.filter({ $0.isNarcissistic }).prefix(25))

print("First 25 narcissistic numbers are \(narcs)")


proc isNarcissistic {n} {
    set m [string length $n]
    for {set t 0; set N $n} {$N} {set N [expr {$N / 10}]} {
	incr t [expr {($N%10) ** $m}]
    }
    return [expr {$n == $t}]
}

proc firstNarcissists {target} {
    for {set n 0; set count 0} {$count < $target} {incr n} {
	if {[isNarcissistic $n]} {
	    incr count
	    lappend narcissists $n
	}
    }
    return $narcissists
}

puts [join [firstNarcissists 25] ","]


function narcissistic {
    integer n=$1 len=${#n} sum=0 i
    for ((i=0; i<len; i++)); do
        (( sum += pow(${n:i:1}, len) ))
    done
    (( sum == n ))
}

nums=()
for ((n=0; ${#nums[@]} < 25; n++)); do
    narcissistic $n && nums+=($n)
done
echo "${nums[*]}"
echo "elapsed: $SECONDS"


Private Function narcissistic(n As Long) As Boolean
    Dim d As String: d = CStr(n)
    Dim l As Integer: l = Len(d)
    Dim sumn As Long: sumn = 0
    For i = 1 To l
        sumn = sumn + (Mid(d, i, 1) - "0") ^ l
    Next i
    narcissistic = sumn = n
End Function

Public Sub main()
    Dim s(24) As String
    Dim n As Long: n = 0
    Dim found As Integer: found = 0
    Do While found < 25
        If narcissistic(n) Then
            s(found) = CStr(n)
            found = found + 1
        End If
        n = n + 1
    Loop
    Debug.Print Join(s, ", ")
End Sub


Function Narcissist(n)
	i = 0
	j = 0
	Do Until j = n
		sum = 0
		For k = 1 To Len(i)
			sum = sum + CInt(Mid(i,k,1)) ^ Len(i)
		Next
		If i = sum Then
			Narcissist = Narcissist & i & ", "
			j = j + 1
		End If
		i = i + 1
	Loop
End Function

WScript.StdOut.Write Narcissist(25)


var narc = Fn.new { |n|
    var power = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
    var limit = 10
    var result = []
    var x = 0
    while (result.count < n) {
        if (x >= limit) {
            for (i in 0..9) power[i] = power[i] * i
            limit = limit * 10
        }
        var sum = 0
        var xx = x
        while (xx > 0) {
            sum = sum + power[xx%10]
            xx = (xx/10).floor
        }
        if (sum == x) result.add(x)
        x = x + 1
    }
    return result
}

System.print(narc.call(25))


F sqlen(x = 0, y = 0, z = 0)
   R x*x + y*y + z*z

print(sqlen(z' 3)) // equivalent to print(sqlen(0, 0, 3))


func IPow(A, B);        \A^B
int  A, B, T, I;
[T:= 1;
for I:= 1 to B do T:= T*A;
return T;
];

int Count, M, N, Sum, T, Dig;
[Text(0, "0 ");
Count:= 1;
for M:= 1 to 9 do
    for N:= IPow(10, M-1) to IPow(10, M)-1 do
        [Sum:= 0;
        T:= N;
        while T do
            [T:= T/10;
            Dig:= rem(0);
            Sum:= Sum + IPow(Dig, M);
            ];
        if Sum = N then
            [IntOut(0, N);  ChOut(0, ^ );
            Count:= Count+1;
            if Count >= 25 then exit;
            ];
        ];
]


fcn isNarcissistic(n){
   ns,m := n.split(), ns.len() - 1;
   ns.reduce('wrap(s,d){ z:=d; do(m){z*=d} s+z },0) == n
}


 1 DIM K(10): DIM M(10)
 2 FOR Y=0 TO 9: LET M(Y+1)=Y: NEXT Y
 3 FOR N=1 TO 7
 4 FOR J=N TO 0 STEP -1
 5 FOR I=N-J TO 0 STEP -1
 6 FOR H=N-J-I TO 0 STEP -1
 7 FOR G=N-J-I-H TO 0 STEP -1
 8 FOR F=N-J-I-H-G TO 0 STEP -1
 9 FOR E=N-J-I-H-G-F TO 0 STEP -1
10 FOR D=N-J-I-H-G-F-E TO 0 STEP -1
11 FOR C=N-J-I-H-G-F-E-D TO 0 STEP -1
12 FOR B=N-J-I-H-G-F-E-D-C TO 0 STEP -1
13 LET A=N-J-I-H-G-F-E-D-C-B
14 LET X=B+C*M(3)+D*M(4)+E*M(5)+F*M(6)+G*M(7)+H*M(8)+I*M(9)+J*M(10)
15 LET S$=STR$ (X)
16 IF LEN (S$)<N THEN GO TO 34
17 IF LEN (S$)<>N THEN GO TO 33
18 FOR Y=1 TO 10: LET K(Y)=0: NEXT Y
19 FOR Y=1 TO N
20 LET Z= CODE (S$(Y))-47
21 LET K(Z)=K(Z)+1
22 NEXT Y
23 IF A<>K(1) THEN GO TO 33
24 IF B<>K(2) THEN GO TO 33
25 IF C<>K(3) THEN GO TO 33
26 IF D<>K(4) THEN GO TO 33
27 IF E<>K(5) THEN GO TO 33
28 IF F<>K(6) THEN GO TO 33
29 IF G<>K(7) THEN GO TO 33
30 IF H<>K(8) THEN GO TO 33
31 IF I<>K(9) THEN GO TO 33
32 IF J=K(10) THEN PRINT X,
33 NEXT B: NEXT C: NEXT D: NEXT E: NEXT F: NEXT G: NEXT H: NEXT I: NEXT J
34 FOR Y=2 TO 9
35 LET M(Y+1)=M(Y+1)*Y
36 NEXT Y
37 NEXT N
38 PRINT
39 PRINT "DONE"


procedure Foo (Arg_1 : Integer; Arg_2 : Float := 0.0);


BEGIN
  MODE OPTNAME = STRUCT(STRING name),
       OPTSPECIES = STRUCT(STRING species),
       OPTBREED = STRUCT(STRING breed),
       OWNER=STRUCT(STRING first name, middle name, last name);

  # Version 2 of Algol 68G would not allow empty options to be specified as () so     #
  # VOID would need to be included in the MODEs for options and Empty option lists    #
  # would need to be written as (EMPTY)                                               #
  MODE OPTIONS = FLEX[1:0]UNION(OPTNAME,OPTSPECIES,OPTBREED,OWNER); # add ,VOID for Algol 68G version 2 #

  # due to the Yoneda ambiguity simple arguments must have an unique operator defined #
  # E.g. a string cannot be coerced to a structure with a single string field         #
  OP NAME = (STRING name)OPTNAME: (OPTNAME opt; name OF opt := name; opt),
     SPECIES = (STRING species)OPTSPECIES: (OPTSPECIES opt; species OF opt := species; opt),
     BREED = (STRING breed)OPTBREED: (OPTBREED opt; breed OF opt := breed; opt);

  PROC print pet = (OPTIONS option)VOID: (
    STRING name:="Rex", species:="Dinosaur", breed:="Tyrannosaurus"; # Defaults #
    OWNER owner := ("George","W.","Bush");
    FOR i TO UPB option DO
      CASE option[i] IN
        (OPTNAME option): name := name OF option,
        (OPTSPECIES option): species := species OF option,
        (OPTBREED option): breed := breed OF option,
        (OWNER option): owner := option
      ESAC
    OD;
    print(("Details: "
          ,IF CHAR c = breed[LWB breed]; char in string( c, NIL, "AaEeIiOoUu" ) THEN "an " ELSE "a " FI
          ,breed, " ", species, " named ",name," owned by ",owner, newline))
  );

  print pet((NAME "Mike", SPECIES "Dog", BREED "Irish Setter", OWNER("Harry", "S.", "Truman")));
  print pet(())     # use print pet((EMPTY)) for Algol 68G version 2 #
END


on getName(x)
	set {firstName, lastName} to {"?", "?"}
	try
		set firstName to x's firstName
	end try
	try
		set lastName to x's lastName
	end try

	return firstName & ", " & lastName
end getName


 100  IF LAST$ = "" THEN  PRINT "?";
 110  IF LAST$ <  > "" THEN  PRINT LAST$;
 120  IF FIRST$ <  > "" THEN  PRINT ", "FIRST$;
 200 FIRST$ = ""
 210 LAST$ = ""
 220  RETURN


func: function [x][
    print ["argument x:" x]
    print ["attribute foo:" attr 'foo]
    print ["attribute bar:" attr 'bar]
    print ""
]

func 1
func .foo:"foo" 2
func .bar:"bar" 3
func .foo:123 .bar:124 4
func .bar:124 .foo:123 5


MyFunc( "Val=0, w=1024, Text=The Quick Brown Fox, newVar=I'm New" )

MyFunc( _overrides="" ) {
 Static x=5, y=5, w=100, h=100, Count
 Name:="AutoHotkey", Type:="Scripting", Text:="qwerty", Val:=True

 Loop, Parse, _overrides,`,=, %A_Space%  ; Override routine for Local/Static variables
   A_Index & 1  ? (_:=A_LoopField) : (%_%:=A_LoopField)

Listvars
 WinWaitClose, %A_ScriptFullPath%
}


( ( testproc
  =   i x y z
    .   out$"Calling testproc"
      & (=~):(=?i:?x:?y:?z)     { initialise variables to 'failure' }
      &   !arg
        : (? (i,?i) ?|?)        { if "i" found, assign value to i. Otherwise just match with no side effect. }
        : (? (x,?x) ?|?)        { if "x" found, assign value to x. Otherwise just match with no side effect. }
        : (? (y,?y) ?|?)        { likewise }
        : (? (z,?z) ?|?)        { likewise }
      & (~!i|put$("   i:=" !i)) { if variable doesn't fail, show its value }
      & (~!x|put$("   x:=" !x))
      & (~!y|put$("   y:=" !y))
      & (~!z|put$("   z:=" !z))
      & put$\n                  { add new line }
  )
& testproc$((x,1) (y,2) (z,3))
& testproc$((x,3) (y,1) (z,2))
& testproc$((z,4) (x,2) (y,3))  { order is not important }
& testproc$((i,1) (y,2) (z,3))
);


#include <stdio.h>

// 1. Named parameters

typedef struct { int x, y, z; } FTest_args;

void FTest (FTest_args args) {
	printf("x: %d, y: %d, z: %d\n", args.x, args.y, args.z);
}

#define FT(...) FTest((FTest_args){ __VA_ARGS__ })

// 2. Default parameters

#define DFT(...) FTest((FTest_args){ .x = 142, .y = 143, .z = 144, __VA_ARGS__ })

// 3. Convenience wrapper to avoid accessing args as "args.name"

void FTest2 (int x, int y, int z) {
	printf("x: %d, y: %d, z: %d\n", x, y, z);
}

static inline void FTest2_default_wrapper (FTest_args args) {
	return FTest2(args.x, args.y, args.z);
}

#define DF2(...) FTest2_default_wrapper((FTest_args){ .x = 142, .y = 143, .z = 144, __VA_ARGS__ })

int main(int argc, char **argv)
{
	// Named parameters
	FTest((FTest_args){ .y = 10 });
	FTest((FTest_args){ .y = 10, .z = 42 });
	FT( .z = 47, .y = 10, .x = 42 );

	// Default parameters
	DFT();
	DFT( .z = 99 );

	// Default parameters with wrapper
	DF2();
	DF2( .z = 99 );

	return 0;
}


using System;

namespace NamedParams
{
    class Program
    {
        static void AddWidget(string parent, float x = 0, float y = 0, string text = "Default")
        {
            Console.WriteLine("parent = {0}, x = {1}, y = {2}, text = {3}", parent, x, y, text);
        }

        static void Main(string[] args)
        {
            AddWidget("root", 320, 240, "First");
            AddWidget("root", text: "Origin");
            AddWidget("root", 500);
            AddWidget("root", text: "Footer", y: 400);
        }
    }
}


class foo_params{
	friend void foo(foo_params p);
public:
    foo_params(int r):
        required_param_(r),
	optional_x_(0),
	optional_y_(1),
	optional_z_(3.1415)
	{}
     foo_params& x(int i){
	optional_x_=i;
	return *this;
     }
     foo_params& y(int i){
	optional_y_=i;
	return *this;
     }
     foo_params& z(float f){
	optional_z_=f;
	return *this;
     }
private:
        int 	required_param_;
	int 	optional_x_;
	int 	optional_y_;
	float 	optional_z_;
};


(defn foo [& opts]
  (let [opts (merge {:bar 1 :baz 2} (apply hash-map opts))
        {:keys [bar baz]} opts]
    [bar baz]))


(defun print-name (&key first (last "?"))
  (princ last)
  (when first
    (princ ", ")
    (princ first))
  (values))


program Named_parameters;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TParams = record
    fx, fy, fz: Integer;
    function x(value: Integer): TParams;
    function y(value: Integer): TParams;
    function z(value: Integer): TParams;
    class function _: TParams; static;
  end;

function Sum(Param: TParams): Integer;
begin
  Result := Param.fx + Param.fy + Param.fz;
end;

{ TParams }

function TParams.x(value: Integer): TParams;
begin
  Result := Self;
  Result.fx := value;
end;

function TParams.y(value: Integer): TParams;
begin
  Result := Self;
  Result.fy := value;
end;

function TParams.z(value: Integer): TParams;
begin
  Result := Self;
  Result.fz := value;
end;

class function TParams._: TParams;
begin
  Result.fx := 0;  // default x
  Result.fy := 0;  // default y
  Result.fz := 0;  // default z
end;

begin
  writeln(sum(TParams._.x(2).y(3).z(4))); // 9

  writeln(sum(TParams._.z(4).x(3).y(5))); // 12

  {$IFNDEF UNIX} readln; {$ENDIF}
end.


def printName([=> first := null, => last := null]) {
    if (last == null) {
        print("?")
    } else {
        print(last)
    }
    if (first != null) {
        print(", ")
        print(first)
    }
}


def fun(bar: bar, baz: baz), do: IO.puts "#{bar}, #{baz}."

fun(bar: "bar", baz: "baz")


Fun = fun( Proplists ) ->
    Argument1 = proplists:get_value( argument1, Proplists, 1 ),
    Kalle = proplists:get_value( kalle, Proplists, "hobbe" ),
    io:fwrite( "~p ~s~n", [Argument1, Kalle] )
end.


256 buffer: first-name
256 buffer: last-name
: is ( a "name" -- )  parse-name rot place ;

: greet ( -- )
  cr ." Hello, " first-name count type space  last-name count type ." !" ;

first-name is Bob  last-name is Hall  greet

require mini-oof2.fs
require string.fs
object class
  field: given-name
  field: surname
end-class Person

: hiya ( -- )
  cr ." Hiya, " given-name $. space surname $. ." !" ;

Person new >o s" Bob" given-name $!  s" Hall" surname $!  hiya o>


subroutine a_sub(arg1, arg2, arg3)
  integer, intent(in) :: arg1, arg2
  integer, intent(out), optional :: arg3
  ! ...
end subroutine a_sub


Dim Shared foo As Long, bar As Integer, baz As Byte, qux As String
'la función
Sub LoqueSea(foo As Long, bar As Integer, baz As Byte, qux As String)
    '...
End Sub

'llamando a la función
Sub Algo()
    LoqueSea(bar = 1, baz = 2, foo = -1, qux = "Probando")
End Sub


package main

import (
   "fmt"
)

type params struct {x, y, z int}

func myFunc(p params) int {
    return p.x + p.y + p.z
}

func main() {
    r := myFunc(params{x: 1, y: 2, z: 3}) // all fields, same order
    fmt.Println("r =", r)
    s := myFunc(params{z: 3, y: 2, x: 1}) // all fields, different order
    fmt.Println("s =", s)
    t := myFunc(params{y: 2})             // only one field, others set to zero
    fmt.Println("t =", t)
}


data X = X
data Y = Y
data Point = Point Int Int deriving Show

createPointAt :: X -> Int -> Y -> Int -> Point
createPointAt X x Y y = Point x y

main = print $ createPointAt X 5 Y 3


procedure main()
   testproc("x:=",1,"y:=",2,"z:=",3)
   testproc("x:=",3,"y:=",1,"z:=",2)
   testproc("z:=",4,"x:=",2,"y:=",3)
   testproc("i:=",1,"y:=",2,"z:=",3)
end

procedure testproc(A[])   #: demo to test named parameters
   write("Calling testproc")

   while a := get(A) do               # implement named parameters here
      (( a ? (v := =!["x","y","z"], =":=")  |   #  valid parameter name?
         stop("No parameter ",a)) &             #  . . no
            ((variable(a[1:-2]) := get(A))  |   #  assign
               runerr(205,a)))                  #  . . problem

   write("   x:=",x)
   write("   y:=",y)
   write("   z:=",z)
end


NB.  Strand notation
myFunc['c:\file.txt'  906  'blue' fs]

NB.  Commas, like other langs
myFunc['c:\file.txt', 906, 'blue' fs]

NB.  Unspecified args are defaulted ("optional")
myFunc['c:\file.txt' fs]

NB.  Can use named arguments, like eg VB
myFunc[color='blue'  fs]

NB.  Often values needn't be quoted
myFunc[color= blue   fs]

NB.  Combination of comma syntax and name=value
myFunc[max=906, color=blue fs]

NB.  Spelling of names is flexible
myFunc[MAX=906, COLOR=blue fs]

NB.  Order of names is flexible
myFunc[COLOR=blue, MAX=906  fs]

NB.  Even the delimiters are flexible...
myFunc<MAX=906, COLOR=blue fs>


function example(options) {
  // assign some defaults where the user's has not provided a value
  opts = {}
  opts.foo = options.foo || 0;
  opts.bar = options.bar || 1;
  opts.grill = options.grill || 'pork chops'

  alert("foo is " + opts.foo + ", bar is " + opts.bar + ", and grill is " + opts.grill);
}

example({grill: "lamb kebab", bar: 3.14});
// => "foo is 0, bar is 3.14, and grill is lamb kebab"


def formatName(obj):
  ({ "name": "?"} + obj) as $obj  # the default default value is null
  | ($obj|.name) as $name
  | ($obj|.first) as $first
  | if ($first == null) then $name
    else $name + ", " + $first
    end;


// version 1.0.6

fun someFunction(first: String, second: Int = 2, third: Double) {
    println("First = ${first.padEnd(10)}, Second = $second, Third = $third")
}

fun main(args: Array<String>) {
    // using positional parameters
    someFunction("positional", 1, 2.0)

    // using named parameters
    someFunction(first = "named", second = 1, third = 2.0)

    // omitting 2nd parameter which is optional because it has a default value
    someFunction(first = "omitted", third = 2.0)

    // using first and third parameters in reverse
    someFunction(third = 2.0, first = "reversed")
}


define mymethod(
	-first::integer, // with no default value the param is required
	-second::integer,
	-delimiter::string = ':' // when given a default value the param becomes optional
) => #first + #delimiter + #second

mymethod(
	-first = 54,
	-second = 45
)
'<br />'
mymethod(
	-second = 45, // named params can be given in any order
	-first = 54,
	-delimiter = '#'
)


-- accepts either 3 integers or a single property list
on foo (arg1, arg2, arg3)
  if ilk(arg1)=#propList then
    args = arg1
    arg1 = args[#arg1]
    arg2 = args[#arg2]
    arg3 = args[#arg3]
  end if
  put "arg1="&arg1
  put "arg2="&arg2
  put "arg3="&arg3
end

foo(1,2) -- 3rd argument omitted
-- "arg1=1"
-- "arg2=2"
-- "arg3="

foo([#arg3:3]) -- only 3rd argument specified
-- "arg1="
-- "arg2="
-- "arg3=3"


function CreatePet(options)
  local name=options.name
  local species=options.species
  local breed=options.breed
  print('Created a '..breed..' '..species..' named '..name)
end
CreatePet{name='Rex',species='Dog',breed='Irish Setter'}
--position does not matter here.


module namedparam (x as decimal=10, y as integer=50) {
      Print type$(x), x
      Print type$(y), y
}
namedparam 10, 20
namedparam  ?, ?
Push 1, 2 : namedparam
Stack New {
      \\ it is empty
      namedparam
      namedparam  %y=500
      namedparam  %x=20
}
namedparam %x=1, %y=1


f := proc(a, {b:= 1, c:= 1})
    print (a*(c+b));
end proc:
#a is a mandatory positional parameter, b and c are optional named parameters
f(1);#you must have a value for a for the procedure to work
                                                                                2
f(1, c = 1, b = 2);
                                                                                3
f(2, b = 5, c = 3);#b and c can be put in any order
                                                                                16


   function foo(varargin)
      for k= 1:2:length(varargin);
         switch (varargin{k})
         case {'param1'}
            param1 = varargin{k+1};
         case {'param2'}
            param2 = varargin{k+1};
	 end;
      end;
      printf('param1: %s\n',param1);
      printf('param2: %s\n',param2);
   end;

   foo('param1','a1','param2','b2');
   foo('param2','b2','param1','a1');


PROCEDURE Foo(Arg1: INTEGER; Arg2: REAL := 0.0);


Foo(number : int, word = "Default", option = true) : void // note type inference with default values

Foo(word = "Bird", number = 3)        // an argument with a default value can be omitted from function call
Foo(3, option = false, word = "Bird") // unnamed arguments must be in same order as function definition and precede named arguments


proc subtract(x, y): auto = x - y

echo subtract(5, 3)         # used as positional parameters
echo subtract(y = 3, x = 5) # used as named parameters


@interface Demo : NSObject {
    // Omitted ...
}

- (double) hypotenuseOfX: (double)x andY: (double)y;
- (double) hypotenuseOfX: (double)x andY: (double)y andZ: (double)z;

@end


# let foo ~arg1 ~arg2 = arg1 + arg2;;
val foo : arg1:int -> arg2:int -> int = <fun>

# let foo ~arg1:x ~arg2:y = x + y;; (* you can also use different variable names internally if you want *)
val foo : arg1:int -> arg2:int -> int = <fun>

# foo ~arg2:17 ~arg1:42;;
- : int = 59


declare
class Foo
   meth init skip end
   meth bar(PP %% positional parameter
	    named1:N1
	    named2:N2
	    namedWithDefault:NWD <= 42)
      {System.showInfo "PP: "#PP#", N1: "#N1#", N2: "#N2#", NWD: "#NWD}
   end
end

O = {New Foo init}
{O bar(1 named1:2 named2:3 namedWithDefault:4)} %% ok
{O bar(1 named2:2 named1:3)} %% ok
{O bar(1 named1:2)} %% not ok, "missing message feature in object application"


sub funkshun {
my %h = @_;
  # Print every argument and its value.
    print qq(Argument "$_" has value "$h{$_}".\n)
        foreach sort keys %h;
  # If a 'verbosity' argument was passed in, print its value
  # whatever that value may be.
    print "Verbosity specified as $h{verbosity}.\n" if exists $h{verbosity};
  # Say that safe mode is on if 'safe' is set to a true value.
  # Otherwise, say that it's off.
    print "Safe mode ", ($h{safe} ? 'on' : 'off'), ".\n";
}


global function timedelta(atom weeks=0, days=0, hours=0, minutes=0, seconds=0, milliseconds=0, microseconds=0)


function named($args) {
  $args += ["gbv" => 2,
            "motor" => "away",
            "teenage" => "fbi"];
  echo $args["gbv"] . " men running " . $args['motor'] . " from the " . $args['teenage'];
}

named(["teenage" => "cia", "gbv" => 10]);


(de foo @
   (bind (rest)  # Bind symbols in CARs to values in CDRs
      (println 'Bar 'is Bar)
      (println 'Mumble 'is Mumble) ) )

(foo '(Bar . 123) '(Mumble . "def"))


function Test {
    Write-Host Argument 1 is $args[0]
}


:- initialization(main).

main :-
	sum(b=2,output=Output,a=1),
	writeln(Output).

sum(A1,B1,C1) :-
	named_args([A1,B1,C1],[a=A,b=B,output=Output]),
	Output is A + B.

named_args([],_).
named_args([A|B],C) :-
	member(A,C),
	named_args(B,C).


def subtract(x, y):
    return x - y

subtract(5, 3)         # used as positional parameters; evaluates to 2
subtract(y = 3, x = 5) # used as named parameters;      evaluates to 2


divide <- function(numerator, denominator) {
  numerator / denominator
}

divide(3, 2)                       # 1.5
divide(numerator=3, denominator=2) # 1.5
divide(n=3, d=2)                   # 1.5
divide(den=3, num=2)               # 0.66
divide(den=3, 2)                   # 0.66
divide(3, num=2)                   # 0.66


#lang racket

(define (pizza sauce
               ;; mandatory keyword argument
               #:topping topping
               ;; optional keyword argument with default
               #:type [type "deep dish"])
  (printf "~a pizza with ~a sauce topped with ~a~n"
          type sauce topping))

(pizza "tomato" #:topping "onion")
(pizza #:topping "onion" "garlic" #:type "pan")


/*REXX pgm shows named parameters when called as a subroutine/function*/
/*┌────────────────────────────────────────────────────────────────────┐
  │ The syntax of:   xxx = func1(parmName2=arg2, parmName1=arg1)       │
  │                                                                    │
  │ in the REXX language is interpreted specifically as:               │
  │                                                                    │
  │                  xxx = func1(    yyy       ,       zzz     )       │
  │                                                                    │
  │ where  yyy  is the logical result of comparing (the REXX variables)│
  │                                                                    │
  │                    parmName2   with   arg2                   and   │
  │                                                                    │
  │ where  zzz  is the logical result of comparing (the REXX variables)│
  │                                                                    │
  │                    parmName1   with   arg1                         │
  │                                                                    │
  │ (either as two strings,  or arithmetically if both "parmName2" and │
  │ "arg2"  are both valid REXX numbers.   In the REXX language, there │
  │ is no way to declare (define) what a variable is [or its type], as │
  │ each literal that can be a variable is assumed to be one.  If it's │
  │ not defined, then its uppercase name is used for the value.        │
  │                                                                    │
  │ Consider the one-line REXX program:    say Where are you?          │
  │ causes REXX to consider that four-word expression as a  "SAY"      │
  │ statement, followed by three REXX variables,  each of which aren't │
  │ defined (that is, have a value), so REXX uses a value which is the │
  │ uppercased value of the REXX variable name, namely three values in │
  │ this case,  so the following is displayed:   WHERE ARE YOU?        │
  │                                                                    │
  │ [There is a mechanism in REXX to catch this behavior and raise the │
  │ NOVALUE  condition.]                                               │
  │                                                                    │
  │ To allow a solution to be used for this task's requirement,  and   │
  │ and not get tangled up with the legal REXX syntactical expressions │
  │ shown,  this REXX  programming example  uses a  variation  of the  │
  │ task's illustration  to allow a  method in REXX  of using  named   │
  │ parameters:      xxx = func1('parmName2=' arg2, "parmName1=" arg1) │
  │                                                                    │
  │ Also,  REXX allows the omitting of arguments by just specifying a  │
  │ comma  (or nothing at all,  in the case of a single argument):     │
  │                                                                    │
  │                  xxx = func1(,zzz)                                 │
  │                                                                    │
  │ would indicate that the 1st argument has been omitted.             │
  │                                                                    │
  │                  xxx = func1(yyy)                                  │
  │                                                                    │
  │ would indicate that the 2nd argument  (and all other subsequent    │
  │ arguments)  has/have been omitted.                                 │
  └────────────────────────────────────────────────────────────────────┘*/

parse arg count,itemX                  /*assume 2 values have been used,*/
                                       /*or whatever ... just to show...*/
  do j=1  for arg();      _=arg(1)     /*now, lets examine each argument*/
  if arg(j,'Omitted')     then iterate /*skip examining if argJ omitted.*/
                                       /*(above)   This is superfluous, */
                                       /* but it demonstrates a method. */
  if \arg(j,"Exists")     then iterate /*exactly the same as previous.  */
                                       /*Only 1st char (2nd arg) is used*/
  first=strip(word(_,1))               /*extract the 1st word in arg(j).*/
  if right(first,1)\=='=' then iterate /*skip if 1st word isn't:  xxx=  */
  parse var _ varname '= ' value       /*parse the named variable &value*/
  if varname==''          then iterate /*not the correct format, so skip*/
                                       /*(above) fix this for real pgm. */
  call value varname,value             /*use BIF to set REXX variable.  */
  end   /*j*/

/* ∙∙∙ perform some REXX magic here with specified parameters and stuff:*/
/*     do this,  do that,  perform dis & dat, compute, gears whiz, cogs */
/*     turn,  wheels spin,  belts move, things get assigned, stuff gets */
/*     computed,  wheels spin,  belts move,  things get assigned, motors*/
/*     humm, engines roar, coal gets burned, water turns to steam, real */
/*     work (some of it useful)  gets done,  and something is produced. */

return  'the final meaning of life, or 42  --- whichever is appropriate.'
                                       /*stick a fork in it, we're done.*/


def example(foo: 0, bar: 1, grill: "pork chops")
  puts "foo is #{foo}, bar is #{bar}, and grill is #{grill}"
end

# Note that :foo is omitted and :grill precedes :bar
example(grill: "lamb kebab", bar: 3.14)


(define (keyarg-parser argdefs args kont)
  (apply kont
	 (map (lambda (argdef)
		(let loop ((args args))
		  (cond ((null? args)
			 (cadr argdef))
			((eq? (car argdef) (car args))
			 (cadr args))
			(else
			 (loop (cdr args))))))
	      argdefs)))

(define (print-name . args)
  (keyarg-parser '((first #f)(last "?"))
		 args
		 (lambda (first last)
		   (display last)
		   (cond (first
			  (display ", ")
			  (display first)))
		   (newline))))


introduce "Mary"
introduce "Pablo", "Hola"
introduce greeting:"Bonjour", name:"Brigitte" by name

to introduce name, greeting:"Hello"
	put greeting && name
end introduce


func example(foo: 0, bar: 1, grill: "pork chops") {
    say "foo is #{foo}, bar is #{bar}, and grill is #{grill}";
}

# Note that :foo is omitted and :grill precedes :bar
example(grill: "lamb kebab", bar: 3.14);


Object subclass: AnotherClass [
   "..."
   initWithArray: anArray [ "single argument" ]
   initWithArray: anArray andString: aString [
        "two args; these two methods in usage resemble
         a named argument, with optional andString argument"
   ]
   "..."
]


fun dosomething (a, b, c) = print ("a = " ^ a ^ "\nb = " ^ Real.toString b ^ "\nc = " ^ Int.toString c ^ "\n")

fun example {a, b, c} = dosomething (a, b, c)


test = function (one, two, three = '', four = '', five = '')
    {
    Print('one: ' $ one $ ', two: ' $ two $ ', three: ' $ three $
        ', four: ' $ four $ ', five: ' $ five)
    }
test('1', '2', five: '5', three: '3')


func greet(person: String, hometown: String) -> String {
    return "Hello \(person)!  Glad you could visit from \(hometown)."
}
print(greet(person: "Bill", hometown: "Cupertino"))


proc example args {
    # Set the defaults
    array set opts {-foo 0 -bar 1 -grill "hamburger"}
    # Merge in the values from the caller
    array set opts $args
    # Use the arguments
    return "foo is $opts(-foo), bar is $opts(-bar), and grill is $opts(-grill)"
}
# Note that -foo is omitted and -grill precedes -bar
example -grill "lamb kebab" -bar 3.14
# => ‘foo is 0, bar is 3.14, and grill is lamb kebab’


Public Function timedelta(Optional weeks As Integer = 0, Optional days As Integer = 0, _
    Optional hours As Integer = 0, Optional minutes As Integer = 0, Optional seconds As Integer = 0, _
    Optional milliseconds As Integer = 0, Optional microseconds As Integer = 0) As Variant
End Function
Public Sub main()
    '-- can be invoked as:
    fourdays = timedelta(days:=4)
    '--       fourdays = timedelta(0,4) '-- equivalent
    '-- **NB** a plain '=' is a very different thing
    oneday = timedelta(days = 1) '-- equivalent to timedelta([weeks:=]IIf((days=1,-1:0))
                                        '-- with NO error if no local variable days exists.
                                        'VBA will assume local variable days=0
    Dim hours As Integer
    shift = timedelta(hours:=hours) '-- perfectly valid (param hours:=local hours)
    '-- timedelta(0,hours:=15,3) '-- illegal (it is not clear whether you meant days:=3 or minutes:=3)
                                 'VBA expects a named parameter for 3
End Sub


'the function
Sub whatever(foo As Long, bar As Integer, baz As Byte, qux As String)
    '...
End Sub
'calling the function -- note the Pascal-style assignment operator
Sub crap()
    whatever bar:=1, baz:=2, foo:=-1, qux:="Why is ev'rybody always pickin' on me?"
End Sub


var printName = Fn.new { |name|
    if (!(name is Map && name["first"] != null && name["last"] !=  null)) {
        Fiber.abort("Argument must be a map with keys \"first\" and \"last\"")
    }
    System.print("%(name["first"]) %(name["last"])")
}

printName.call({"first": "Abraham", "last": "Lincoln"}) // normal order
printName.call({"last": "Trump", "first": "Donald"})  // reverse order
printName.call({"forename": "Boris", "lastname": "Johnson"}) // wrong parameter names


<xsl:template name="table-header">
    <xsl:param name="title"/>
    ...
</xsl:template>


BEGIN
    # show the first 199 values of the moebius function                 #
    INT sq root = 1 000;
    INT mu max  = sq root * sq root;
    [ 1 : mu max ]INT mu;
    FOR i FROM LWB mu TO UPB mu DO mu[ i ] := 1 OD;
    FOR i FROM 2 TO sq root DO
        IF mu[ i ] = 1 THEN
            # for each factor found, swap + and -                       #
            FOR j FROM i     BY i     TO UPB mu DO mu[ j ] *:= -i OD;
            FOR j FROM i * i BY i * i TO UPB mu DO mu[ j ]  :=  0 OD
        FI
    OD;
    FOR i FROM 2 TO UPB mu DO
        IF   mu[ i ] =  i THEN mu[ i ] :=  1
        ELIF mu[ i ] = -i THEN mu[ i ] := -1
        ELIF mu[ i ] <  0 THEN mu[ i ] :=  1
        ELIF mu[ i ] >  0 THEN mu[ i ] := -1
      # ELSE mu[ i ] =  0 so no change #
        FI
    OD;
    print( ( "First 199 terms of the möbius function are as follows:", newline, "    " ) );
    FOR i TO 199 DO
        print( ( whole( mu[ i ], -4 ) ) );
        IF ( i + 1 ) MOD 20 = 0 THEN print( ( newline ) ) FI
    OD
END


mobius: function [n][
    if n=0 -> return ""
    if n=1 -> return 1
    f: factors.prime n

    if f <> unique f -> return 0
    if? odd? size f -> return neg 1
    else -> return 1
]

loop split.every:20 map 0..199 => mobius 'a ->
    print map a => [pad to :string & 3]


# syntax: GAWK -f MOBIUS_FUNCTION.AWK
# converted from Java
BEGIN {
    printf("first 199 terms of the mobius sequence:\n   ")
    for (n=1; n<200; n++) {
      printf("%3d",mobius(n))
      if ((n+1) % 20 == 0) {
        printf("\n")
      }
    }
    exit(0)
}
function mobius(n,  i,j,mu_max) {
    if (n in MU) {
      return(MU[n])
    }
    mu_max = 1000000
    for (i=0; i<mu_max; i++) { # populate array
      MU[i] = 1
    }
    for (i=2; i<=int(sqrt(mu_max)); i++ ) {
      if (MU[i] == 1) {
        for (j=i; j<=mu_max; j+=i) { # for each factor found, swap + and -
          MU[j] *= -i
        }
        for (j=i*i; j<=mu_max; j+=i*i) { # square factor = 0
          MU[j] = 0
        }
      }
    }
    for (i=2; i<=mu_max; i++) {
      if (MU[i] == i) {
        MU[i] = 1
      }
      else if (MU[i] == -i) {
        MU[i] = -1
      }
      else if (MU[i] < 0) {
        MU[i] = 1
      }
      else if (MU[i] > 0) {
        MU[i] = -1
      }
    }
    return(MU[n])
}


function mobius(n)
	if n = 1 then return 1
	for d = 2 to int(sqr(n))
		if n mod d = 0 then
			if n mod (d*d) = 0 then return 0
			return -mobius(n/d)
		end if
	next d
	return -1
end function

outstr$ = " .   "
for i = 1 to 200
	if mobius(i) >= 0 then outstr$ += " "
	outstr$ += string(mobius(i)) + "   "
	if i mod 10 = 9 then
		print outstr$
		outstr$ = ""
	end if
next i
end


#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

int main() {
    const int MU_MAX = 1000000;
    int i, j;
    int *mu;
    int sqroot;

    sqroot = (int)sqrt(MU_MAX);

    mu = malloc((MU_MAX + 1) * sizeof(int));

    for (i = 0; i < MU_MAX;i++) {
        mu[i] = 1;
    }

    for (i = 2; i <= sqroot; i++) {
        if (mu[i] == 1) {
            // for each factor found, swap + and -
            for (j = i; j <= MU_MAX; j += i) {
                mu[j] *= -i;
            }
            // square factor = 0
            for (j = i * i; j <= MU_MAX; j += i * i) {
                mu[j] = 0;
            }
        }
    }

    for (i = 2; i <= MU_MAX; i++) {
        if (mu[i] == i) {
            mu[i] = 1;
        } else if (mu[i] == -i) {
            mu[i] = -1;
        } else if (mu[i] < 0) {
            mu[i] = 1;
        } else if (mu[i] > 0) {
            mu[i] = -1;
        }
    }

    printf("First 199 terms of the möbius function are as follows:\n    ");
    for (i = 1; i < 200; i++) {
        printf("%2d  ", mu[i]);
        if ((i + 1) % 20 == 0) {
            printf("\n");
        }
    }

    free(mu);
    return 0;
}