// Count digits in number
let digits x =
    let rec digits' p x =
        if 10.**p > x then p else digits' (p + 1.) x
    digits' 1. x

// Is n a Kaprekar number?
let isKaprekar n =
    // Reference: http://oeis.org/A006886
    // Positive numbers n such that n=q+r
    // And n^2=q*10^m+r,
    //  for some m >= 1,
    //  q>=0 and 0<=r<10^m,
    //  with n != 10^a, a>=1.
    let nSquared = n * n
    let a = float((digits n) - 1.)

    // Create a list of tuples from the nSquared digit splits
    [1. .. float (digits nSquared)]
    |> List.map (fun e ->
        // Splits the nSquared digits into 2 parts
        let x = 10.**e
        let q = float(int(Math.Floor (nSquared / x)))
        let r = nSquared - (q * x)
        (q, r))
    // Filter results based on rules
    |> List.exists (fun (q, r) ->
        q + r = n &&
        if a >= 1. then n % 10.**a <> 0. else true)

// List Kaprekar numbers from 1 to 10,000
[1 .. 10000]
|> List.filter (float >> isKaprekar)


USING: io kernel lists lists.lazy locals math math.functions
math.ranges prettyprint sequences ;

:: kaprekar? ( n -- ? )
    n sq :> sqr
    1 lfrom
    [ 10 swap ^ ] lmap-lazy
    [ n > ] lfilter
    [ sqr swap mod n < ] lwhile
    list>array
    [ 1 - sqr n - swap mod zero? ] any?
    n 1 = or ;

1,000,000 [1,b] [ kaprekar? ] filter dup . length
"Count of Kaprekar numbers <= 1,000,000: " write .


: square ( n - n^2)   dup * ;

\ Return nonzero if n is a Kaprekar number for tens, where tens is a
\ nonzero power of base.
: is-kaprekar? ( tens n n^2 - t)   rot /mod  over >r  + =  r> and ;

\ If n is a Kaprekar number, return is the power of base for which it
\ is Kaprekar.  If n is not a Kaprekar number, return zero.
: kaprekar ( +n - +n1)
    dup square >r
    base @ swap
    begin ( tens n) ( R: n^2)
        over [email protected] < while
            2dup [email protected] is-kaprekar? if
                drop  r> drop  exit  then
            swap  base @ *  swap
    repeat
    r> drop  1 = and ;


program Karpekar_Numbers
  implicit none

  integer, parameter :: i64 = selected_int_kind(18)
  integer :: count

  call karpekar(10000_i64, .true.)
  write(*,*)
  call karpekar(1000000_i64, .false.)

contains

subroutine karpekar(n, printnums)

  integer(i64), intent(in) :: n
  logical, intent(in) :: printnums
  integer(i64) :: c, i, j, n1, n2
  character(19) :: str, s1, s2

  c = 0
  do i = 1, n
    write(str, "(i0)") i*i
    do j = 0, len_trim(str)-1
      s1 = str(1:j)
      s2 = str(j+1:len_trim(str))
      read(s1, "(i19)") n1
      read(s2, "(i19)") n2
      if(n2 == 0) cycle
      if(n1 + n2 == i) then
        c = c + 1
        if (printnums .eqv. .true.) write(*, "(i0)") i
        exit
      end if
    end do
  end do
  if (printnums .eqv. .false.) write(*, "(i0)") c
end subroutine
end program


' version 04-12-2016
' compile with: fbc -s console

' define true and false for older versions
#Ifndef TRUE
#Define FALSE 0
#Define TRUE Not FALSE
#EndIf

#Define max 1000000   ' maximum for number to be tested

Function kaprekar(n As ULong) As ULong

    If n = 1 Then Return TRUE

    Dim As ULong x, p1, p2
    Dim As ULongInt sq = CLngInt(n) * n
    Dim As String sq_str = Str(sq)
    Dim As ULong l = Len(sq_str)

    ' decrease the lenght l for every "0"
    ' at the end of the string
    For x = l -1 To 1 Step -1
        If sq_str[x] = Asc("0") Then
            l = l -1
        Else
            Exit For
        End If
    Next

    For x = 1 To l -1
        p2 = Val(Mid(sq_str, x +1))
        If p2 > n Then
            Continue For
        End If
        p1 = Val(Left(sq_str, x))
        If p1 > n Then Return FALSE  ' p1 > n leave
        If (p1 + p2) = n Then Return TRUE
    Next

End Function

' ------=< MAIN >=------

Dim As ULong n, count

Print "Kaprekar numbers below 10000"

For n = 1 To max -1
    If kaprekar(n) = TRUE Then
        count = count + 1
        If n < 10000 Then
            Print count, n
        End If
    End If
Next

Print
Print count;" numbers below "; Str(max);" are Kaprekar numbers"

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


IsKaprekar := function(n)
	local a, b, p, q;
	if n = 1 then
		return true;
	fi;
	q := n*n;
	p := 10;
	while p < q do
		a := RemInt(q, p);
		b := QuoInt(q, p);
		if a > 0 and a + b = n then
			return true;
		fi;
		p := p*10;
	od;
	return false;
end;

Filtered([1 .. 10000], IsKaprekar);
# [ 1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272,
#   7777, 9999 ]

Size(last);
# 17

Filtered([1 .. 1000000], IsKaprekar);
# [ 1, 9, 45, 55, 99, 297, 703, 999, 2223, 2728, 4879, 4950, 5050, 5292, 7272,
#   7777, 9999, 17344, 22222, 38962, 77778, 82656, 95121, 99999, 142857,
#   148149, 181819, 187110, 208495, 318682, 329967, 351352, 356643, 390313,
#   461539, 466830, 499500, 500500, 533170, 538461, 609687, 627615, 643357,
#   648648, 670033, 681318, 791505, 812890, 818181, 851851, 857143, 961038,
#   994708, 999999 ]

Size(last);
# 54

IsKaprekarAndHow := function(n, base)
	local a, b, p, q;
	if n = 1 then
		return true;
	fi;
	q := n*n;
	p := base;
	while p < q do
		a := RemInt(q, p);
		b := QuoInt(q, p);
		if a > 0 and a + b = n then
			return [a, b];
		fi;
		p := p*base;
	od;
	return false;
end;

IntegerToBaseRep := function(n, base)
	local s, digit;
	if base > 36 then
		return fail;
	elif n = 0 then
		return "0";
	else
		s := "";
		digit := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
		while n <> 0 do
			Add(s, digit[RemInt(n, base) + 1]);
			n := QuoInt(n, base);
		od;
		return Reversed(s);
	fi;
end;

PrintIfKaprekar := function(n, base)
	local v;
	v := IsKaprekarAndHow(n, base);
	if IsList(v) then
		Print(n, "(10) or in base ", base, ", ",
			IntegerToBaseRep(n, base), "^2 = ",
			IntegerToBaseRep(n^2, base), " and ",
			IntegerToBaseRep(v[2], base), " + ",
			IntegerToBaseRep(v[1], base), " = ",
			IntegerToBaseRep(n, base), "\n");
	fi;
	return fail;
end;

# In base 17...
Perform([1 .. 1000000], n -> PrintIfKaprekar(n, 17));
# 16(10) or in base 17, G^2 = F1 and F + 1 = G
# 64(10) or in base 17, 3D^2 = E2G and E + 2G = 3D
# 225(10) or in base 17, D4^2 = A52G and A5 + 2G = D4
# 288(10) or in base 17, GG^2 = GF01 and GF + 1 = GG
# 1536(10) or in base 17, 556^2 = 1B43B2 and 1B4 + 3B2 = 556
# 3377(10) or in base 17, BBB^2 = 8093B2 and 809 + 3B2 = BBB
# 4912(10) or in base 17, GGG^2 = GGF001 and GGF + 1 = GGG
# 7425(10) or in base 17, 18BD^2 = 24E166G and 24E + 166G = 18BD
# 9280(10) or in base 17, 1F1F^2 = 39B1B94 and 39B + 1B94 = 1F1F
# 16705(10) or in base 17, 36DB^2 = B992C42 and B99 + 2C42 = 36DB
# 20736(10) or in base 17, 43CD^2 = 10DE32FG and 10DE + 32FG = 43CD
# 30016(10) or in base 17, 61EB^2 = 23593F92 and 2359 + 3F92 = 61EB
# 36801(10) or in base 17, 785D^2 = 351E433G and 351E + 433G = 785D
# 37440(10) or in base 17, 7A96^2 = 37144382 and 3714 + 4382 = 7A96
# 46081(10) or in base 17, 967B^2 = 52G94382 and 52G9 + 4382 = 967B
# 46720(10) or in base 17, 98B4^2 = 5575433G and 5575 + 433G = 98B4
# 53505(10) or in base 17, AF26^2 = 6GA43F92 and 6GA4 + 3F92 = AF26
# 62785(10) or in base 17, CD44^2 = 9A5532FG and 9A55 + 32FG = CD44
# 66816(10) or in base 17, DA36^2 = AEG42C42 and AEG4 + 2C42 = DA36
# 74241(10) or in base 17, F1F2^2 = D75F1B94 and D75F + 1B94 = F1F2
# 76096(10) or in base 17, F854^2 = E1F5166G and E1F5 + 166G = F854
# 83520(10) or in base 17, GGGG^2 = GGGF0001 and GGGF + 1 = GGGG
# 266224(10) or in base 17, 33334^2 = A2C52A07G and A2C5 + 2A07G = 33334


package main

import (
    "fmt"
    "strconv"
)

func kaprekar(n uint64, base uint64) (bool, int) {
    order := 0
    if n == 1 {
        return true, -1
    }

    nn, power := n*n, uint64(1)
    for power <= nn {
        power *= base
        order++
    }

    power /= base
    order--
    for ; power > 1; power /= base {
        q, r := nn/power, nn%power
        if q >= n {
            return false, -1
        }

        if q+r == n {
            return true, order
        }

        order--
    }

    return false, -1
}

func main() {
    max := uint64(10000)
    fmt.Printf("Kaprekar numbers < %d:\n", max)
    for m := uint64(0); m < max; m++ {
        if is, _ := kaprekar(m, 10); is {
            fmt.Println("  ", m)
        }
    }

    // extra credit
    max = 1e6
    var count int
    for m := uint64(0); m < max; m++ {
        if is, _ := kaprekar(m, 10); is {
            count++
        }
    }
    fmt.Printf("\nThere are %d Kaprekar numbers < %d.\n", count, max)

    // extra extra credit
    const base = 17
    maxB := "1000000"
    fmt.Printf("\nKaprekar numbers between 1 and %s(base %d):\n", maxB, base)
    max, _ = strconv.ParseUint(maxB, base, 64)
    fmt.Printf("\n Base 10  Base %d        Square       Split\n", base)
    for m := uint64(2); m < max; m++ {
        is, pos := kaprekar(m, base)
        if !is {
            continue
        }
        sq := strconv.FormatUint(m*m, base)
        str := strconv.FormatUint(m, base)
        split := len(sq)-pos
        fmt.Printf("%8d  %7s  %12s  %6s + %s\n", m,
            str, sq, sq[:split], sq[split:]) // optional extra extra credit
    }
}


class Kaprekar {
    private static String[] splitAt(String str, int idx) {
        String[] ans = new String[2]
        ans[0] = str.substring(0, idx)
        if (ans[0] == "") ans[0] = "0" //parsing "" throws an exception
        ans[1] = str.substring(idx)
        return ans
    }

    static void main(String[] args) {
        int count = 0
        int base = (args.length > 0) ? Integer.parseInt(args[0]) : 10
        for (long i = 1; i <= 1000000; i++) {
            String sqrStr = Long.toString(i * i, base)
            for (int j = 0; j < sqrStr.length() / 2 + 1; j++) {
                String[] parts = splitAt(sqrStr, j)
                if (parts[1] == "") continue
                long firstNum = Long.parseLong(parts[0], base)
                long secNum = Long.parseLong(parts[1], base)
                //if the right part is all zeroes, then it will be forever, so break
                if (secNum == 0) break
                if (firstNum + secNum == i) {
                    System.out.println(i + "\t" + Long.toString(i, base) + "\t" + sqrStr + "\t" + parts[0] + " + " + parts[1])
                    count++
                    break
                }
            }
        }
        System.out.println(count + " Kaprekar numbers < 1000000 (base 10) in base " + base)
    }
}


import Text.Printf (printf)
import Data.Maybe (mapMaybe)
import Numeric (showIntAtBase)

kaprekars :: Integer -> Integer -> [(Integer, Integer, Integer)]
kaprekars base top = (1, 0, 1) : mapMaybe kap (filter res [2 .. top])
  where
    res x = x * (x - 1) `mod` (base - 1) == 0
    kap n =
      getSplit $
      takeWhile (<= nn) $ dropWhile (< n) $ iterate (* toInteger base) 1
      where
        nn = n * n
        getSplit [] = Nothing
        getSplit (p:ps)
          | p == n = Nothing
          | q + r == n = Just (n, q, r)
          | r > n = Nothing
          | otherwise = getSplit ps
          where
            (q, r) = nn `divMod` p

heading :: Int -> String
heading = printf (h ++ d)
  where
    h = " #    Value (base 10)         Sum (base %d)             Square\n"
    d = " -    ---------------         -------------             ------"

printKap :: Integer -> (Int, (Integer, Integer, Integer)) -> String
printKap b (i, (n, l, r)) =
  printf "%2d %13s %26s %16s" i (show n) ss (base b (n * n))
  where
    ss = base b n ++ " = " ++ base b l ++ " + " ++ base b r
    base b n = showIntAtBase b (("0123456789" ++ ['a' .. 'z']) !!) n ""

main :: IO ()
main = do
  putStrLn $ heading 10
  mapM_ (putStrLn . printKap 10) $ zip [1 ..] (kaprekars 10 1000000)
  putStrLn ""
  putStrLn $ heading 17
  mapM_ (putStrLn . printKap 17) $ zip [1 ..] (kaprekars 17 1000000)


procedure is_kaprekar(n)  #: return n if n is a kaprekar number
if ( n = 1 ) |
   ( n^2 ? ( n = move(1 to *&subject-1) + (0 ~= tab(0)) | fail )) then
   return n
end

procedure main()
every write(is_kaprekar(1 to 10000))                        # primary goal
every (count := 0, is_kaprekar(1 to 999999), count +:= 1)   # stretch goal
write ("Number of Kaprekar numbers less than 1000000 is ", count)
end


public class Kaprekar {
    private static String[] splitAt(String str, int idx){
        String[] ans = new String[2];
        ans[0] = str.substring(0, idx);
        if(ans[0].equals("")) ans[0] = "0"; //parsing "" throws an exception
        ans[1] = str.substring(idx);
        return ans;
    }

    public static void main(String[] args){
        int count = 0;
        int base = (args.length > 0) ? Integer.parseInt(args[0]) : 10;
        for(long i = 1; i <= 1000000; i++){
            String sqrStr = Long.toString(i * i, base);
            for(int j = 0; j < sqrStr.length() / 2 + 1; j++){
                String[] parts = splitAt(sqrStr, j);
                long firstNum = Long.parseLong(parts[0], base);
                long secNum = Long.parseLong(parts[1], base);
                //if the right part is all zeroes, then it will be forever, so break
                if(secNum == 0) break;
                if(firstNum + secNum == i){
                    System.out.println(i + "\t" + Long.toString(i, base) +
                            "\t" + sqrStr + "\t" + parts[0] + " + " + parts[1]);
                    count++;
                    break;
                }
            }
        }
        System.out.println(count + " Kaprekar numbers < 1000000 (base 10) in base "+base);
    }
}


function isKaprekar( n, bs ) {
	if ( n < 1 ) return false
	if ( n == 1 ) return true
	bs = bs || 10
	var s = (n * n).toString(bs)
	for (var i=1, e=s.length; i<e; i+=1) {
		var a = parseInt(s.substr(0, i), bs)
		var b = parseInt(s.substr(i), bs)
		if (b && a + b == n) return true
	}
	return false
}


# Is the input integer a Kaprekar integer?
def is_kaprekar:
    # The helper function acts like a loop:
    # input is [n, number, str]
    # where n is the position to be considered next,
    # number is the integer under consideration,
    # and str is the string representing number*number
    def _try:
      .[0] as $n | .[1] as $number | .[2] as $str
      | if $n >= ($str|length) then null
        else   ($str[0:$n] | tonumber) as $left
             | ($str[$n:]  | tonumber) as $right
             | if $left > $number then null
               elif $right == 0 then null
               elif ($left + $right) == $number then $n
               else [($n + 1), $number, $str] | _try
               end
        end;
    . as $in
    | if . == 1 then true
      elif . < 1 then false
      else null != ([1, $in, ($in*$in|tostring)] | _try)
      end ;

# Useful for counting how many times the condition is satisfied:
def count(generator; condition):
  reduce generator as $i (0; if ($i|condition ) then .+1 else . end);

def task:
  [ range(1;10000) | select( is_kaprekar ) ],
  count( range(1;1000000); is_kaprekar )
;


function iskaprekar(n::Integer)
    n == 1 && return true
    test(a, b) = n == a + b && b ≠ 0
    str = string(n^2)
    any(test(parse(Int, str[1:i]), parse(Int, str[i+1:end])) for i = 1:length(str)-1)
end

@show filter(iskaprekar, 1:10000)
@show count(iskaprekar, 1:10000)


import java.lang.Long.parseLong
import java.lang.Long.toString

fun String.splitAt(idx: Int): Array<String> {
    val ans = arrayOf(substring(0, idx), substring(idx))
    if (ans.first() == "") ans[0] = "0" // parsing "" throws an exception
    return ans
}

fun Long.getKaprekarParts(sqrStr:  String, base: Int): Array<String>? {
    for (j in 0..sqrStr.length / 2) {
        val parts = sqrStr.splitAt(j)
        val (first, second) = parts.map { parseLong(it, base) }

        // if the right part is all zeroes, then it will be forever, so break
        if (second == 0L) return null
        if (first + second == this) return parts
    }
    return null
}

fun main(args: Array<String>) {
    val base = if (args.isNotEmpty()) args[0].toInt() else 10
    var count = 0
    val max = 1000000L
    for (i in 1..max) {
        val s = toString(i * i, base)
        val p = i.getKaprekarParts(s, base)
        if (p != null) {
            println("%6d\t%6s\t%12s\t%7s + %7s".format(i, toString(i, base), s, p[0], p[1]))
            count++
        }
    }
    println("$count Kaprekar numbers < $max (base 10) in base $base")
}


 For i = 1 To 10000  '1000000 - Changing to one million takes a long time to complete!!!!
    Kaprekar = isKaprekar(i)
    If Kaprekar Then numKaprekar = (numKaprekar + 1) : Print Kaprekar
Next i

Print numKaprekar
End

Function isKaprekar(num)
    If num < 1 Then isKaprekar = 0 : Exit Function
    If num = 1 Then isKaprekar = num : Exit Function
    squarenum$ = str$(num ^ 2)
    For i = 1 To Len(squarenum$)
        If Val(Mid$(squarenum$, i)) = 0 Then isKaprekar = 0 : Exit Function
        If (Val(Left$(squarenum$, (i - 1))) + Val(Mid$(squarenum$, i)) = num) Then isKaprekar = num : Exit Function
    Next i
End Function


-- Return length of an integer without string conversion
function numLength (n)
    local length = 0
    repeat
        n = math.floor(n / 10)
        length = length + 1
    until n == 0
    return length
end

-- Return a boolean indicating whether n is a Kaprekar number
function isKaprekar (n)
    if n == 1 then return true end
    local nSquared, a, b = n * n
    for splitPoint = 1, numLength(nSquared) - 1 do
        a = math.floor(nSquared / 10^splitPoint)
        b = nSquared % 10^splitPoint
        if a > 0 and b > 0 and a + b == n then return true end
    end
    return false
end

-- Main task
for n = 1, 10^4 do
    if isKaprekar(n) then io.write(n .. " ") end
end

-- Extra credit
local count = 0
for n = 1, 10^6 do
    if isKaprekar(n) then count = count + 1 end
end
print("\nThere are " .. count .. " Kaprekar numbers under one million.")


isKaprekar := proc(n::posint)
local holder, square, num_of_digits, k, left, right;
holder := true;
if n = 1 then
 holder := true;
else
 holder := false;
 square := n^2;
 num_of_digits := length(n^2);
 for k to num_of_digits do left := floor(square/10^k);
     right := irem(square, 10^k);
     if left + right = n and right <> 0 then
        holder := true;
     break;
     end if;
 end do;
end if;
return holder;
end proc;

showKaprekar := n -> select(isKaprekar, select(x -> irem(x, 9) = 1 or irem(x, 9) = 0, [seq(1 .. n - 1)]));

countKaprekar := n -> nops(showKaprekar(n));

showKaprekar(10000);
countKaprekar(1000000);


KaprekaQ[1] = True;
KaprekaQ[n_Integer] :=  Block[{data = IntegerDigits[n^2], last = False, i = 1},
  While[i < Length[data] && FromDigits[data[[i + 1 ;;]]] =!= 0 &&  Not[last],
   last = FromDigits[data[[;; i]]] + FromDigits[data[[i + 1 ;;]]] == n;
   i++]; last];
Select[Range[10000], KaprekaQ]
Length[Select[Range[1000000], KaprekaQ]]


local
  val base = 10;
  fun kaprekar
        (num, numSquared, numDiv, numRem, power) where (base ^ power >= numSquared) = ()

    |   (num, numSquared, numDiv, numRem, power) where ((numDiv = 0) or (numRem = 0))=
          kaprekar (num, numSquared, numSquared div (base ^ power ), numSquared rem (base ^ power), power + 1)

    |   (num, numSquared, numDiv, numRem, power) =
          if ((numDiv + numRem) = num) then
            num
          else
            kaprekar (num, numSquared, numSquared div (base ^ power ), numSquared rem (base ^ power), power + 1)

    |   num =
          if (num = 1) then
            num
          else
            kaprekar (num, num * num, (num * num) div base, (num * num) rem base, 1)

in
  fun kaprekar_list
       ([], collector) = rev collector
    |  (num :: nums, collector ) =
         let
           val k = kaprekar num
         in
           if (k = ()) then
             kaprekar_list (nums, collector)
           else
             kaprekar_list (nums, num :: collector)
         end
    |  (num :: nums) = kaprekar_list (num :: nums, [])
end
;


MODULE Kaprekar;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT Write,WriteString,WriteLn,ReadChar;

PROCEDURE kaprekar(n,base : LONGCARD) : BOOLEAN;
VAR
    nn,r,tens : LONGCARD;
BEGIN
    nn := n*n;
    tens := 1;
    IF ((nn - n) MOD (base - 1)) # 0 THEN RETURN FALSE END;

    WHILE tens < n DO tens := tens * base END;
    IF n = tens THEN
        IF 1 = n THEN RETURN TRUE END;
        RETURN FALSE
    END;

    LOOP
        r := nn MOD tens;
        IF r >= n THEN BREAK END;
        IF nn DIV tens + r = n THEN RETURN tens#0 END;
        tens := tens * base;
    END;

    RETURN FALSE
END kaprekar;

PROCEDURE print_num(n,base : LONGCARD);
VAR q,d : LONGCARD;
BEGIN
    d := base;

    WHILE d<n DO d := d * base END;
    LOOP
        d := d DIV base;
        IF n BAND d = 0 THEN RETURN END;
        q := n DIV d;
        IF q<10 THEN
            Write(CHR(INT(q) + INT(ORD('0'))))
        ELSE
            Write(CHR(INT(q) + INT(ORD('a')) - 10))
        END;
        n := n - q * d
    END
END print_num;

VAR
    buf : ARRAY[0..63] OF CHAR;
    i,tens,cnt,base : LONGCARD;
BEGIN
    cnt := 0;
    base := 10;
    FOR i:=1 TO 1000000 DO
        IF kaprekar(i,base) THEN
            INC(cnt);
            FormatString("%3u: %u\n", buf, cnt, i);
            WriteString(buf)
        END
    END;

    ReadChar
END Kaprekar.


import strutils, sequtils

proc k(n: int): bool =
  let n2 = $(n.int64 * n)
  for i in 0 .. n2.high:
    let a = if i > 0: parseBiggestInt n2[0 ..< i] else: 0
    let b = parseBiggestInt n2[i .. n2.high]
    if b > 0 and a + b == n:
      return true

echo toSeq(1..10_000).filter(k)
echo len toSeq(1..1_000_000).filter(k)


sub isKap {
  my $k = shift;
  return if $k*($k-1) % 9;  # Fast return "casting out nines"
  my($k2, $p) = ($k*$k, 10);
  do {
    my $i = int($k2/$p);
    my $j = $k2 % $p;
    return 1 if $j && $i+$j == $k;
    $p *= 10;
  } while $p <= $k2;
  0;
}

print "[", join(" ", grep { isKap($_) } 1..9999), "]\n\n";
my @kaprekar;
isKap($_) && push @kaprekar,$_ for 1..1_000_000;
print "Kaprekar Numbers below 1000000: ", scalar(@kaprekar), "\n";


with javascript_semantics
atom r, l
function Kaprekar(integer n, base=10)
    if n=1 then return true end if
    atom sq=n*n, basen = base
    r=0
    while r<n do
        r = mod(sq,basen)
        l = floor(sq/basen)
        if r and l and l+r=n then return true end if
        basen *= base
    end while
    return false
end function

sequence s = {}
for i=1 to 10_000 do
    if Kaprekar(i) then
        s &= i
    end if
end for
printf(1,"There are %d Kaprekar numbers between 1 and 10,000:\n%v\n",{length(s),s})
integer c = 0
for i=1 to 1_000_000 do
    c += Kaprekar(i)
end for
printf(1,"There are %d Kaprekar numbers between 1 and 1,000,000\n",c)

function base17(sequence s)
    s = deep_copy(s)
    for i=1 to length(s) do
        atom si = s[i]
        string num = ""
        while si do
            integer digit = mod(si,17)
            si = floor(si/17)
            num = digit+iff(digit<=9?'0':87)&num
        end while
        s[i] = num
    end for
    return s
end function

s = {} r = 1 l = 1
for i=1 to 1_000_000 do
    if Kaprekar(i,17) then
        s = append(s,{i,i*i,l,r})
    end if
end for
printf(1,"There are %d Kaprekar base 17 numbers between 1 and 1,000,000 (decimal):\n",length(s))
s[5..-5] = {}
for i=1 to length(s) do
    printf(1,"%s squared %s, split %s+%s\n",base17(s[i]))
    if i=4 then printf(1," ...\n") end if
end for


def FNkaprekar
    var n
    dup 2 power var s
    s log int 1 + 10 swap power var t
    true while
        t 10 / var t
        t n <= IF false else
            s n - s t / int t 1 - * == IF false 1 var n else TRUE endif
        endif
    endwhile
    n 1 ==
enddef

0
10000 FOR
     dup FNkaprekar IF print " " print 1 + else drop endif
endfor
nl print " Kaprekar numbers" print


set_time_limit(300);

print_r(array_filter(range(1, 10000), 'isKaprekar'));
echo count(array_filter(range(1, 1000000), 'isKaprekar'));

function isKaprekar($n) {
    $a = $n * $n;
    $b = bcmod("$a", "10");
    for ($d = 1, $t = 0; $a > 0; $d *= 10) {
        $b += $t * $d;
        if ($b > $n) break;
        $a = floor($a / 10);
        if ($b && $a + $b == $n)
            return true;
        $t = bcmod("$a", "10");
    }
    return false;
}


go =>
  println(base=10),
  println(kaprekar_number(10,10000)),
  nl,
  println("Testing 1000000:"),

  K10 = kaprekar_number(10,1000000),
  % println(K10),
  nl,
  println(base=16),
  K16 = [I.to_hex_string() : I in kaprekar_number(16,1000000)],
  % println(K16),
  nl,

  println(base=17),
  K17 = [to_radix_string(I,17).to_lowercase : I in  kaprekar_number(17,1000000)],
  % println(K17),
  nl,

  println(base=36),
  K36 = [to_radix_string(I,36) : I in  kaprekar_number(36,1000000)],
  % println(K36),

  nl.

kaprekar_number(Base,Limit) = Ks =>
  N = ceiling(log(Base,Limit)),
  PaddyCnt = 0,
  Ks = [],
  foreach(Nz in 1..N)
    foreach(K in Base**(Nz-1)..(Base**Nz)-1, K <= Limit)
       if (K*(K-1)) mod (Base-1) == 0 then
          Found = false,
	  foreach(N2 in Nz..Nz*2-1,Found = false)
 	     B = Base**N2,
	     Nr = K*(B-K) div (B-1),
	     Q = K-Nr,
	     if K*K==Q*B+Nr, 0<Nr then
                PaddyCnt := PaddyCnt+1,
                Ks := Ks ++ [K],
		Found := true
	     end
          end
       end
    end
  end,
  println(len=Ks.length).


(de kaprekar (N)
   (let L (cons 0 (chop (* N N)))
      (for ((I . R) (cdr L) R (cdr R))
         (NIL (gt0 (format R)))
         (T (= N (+ @ (format (head I L)))) N) ) ) )


kaprekar: procedure options (main);  /* 22 January 2012 */
   declare i fixed decimal (9), j fixed binary;
   declare s character (20) character varying;
   declare m fixed decimal (9);
   declare (z, zeros) character (20) varying;

   zeros = '00000000000000000000';

   put skip list (1);
   do i = 2 to 100000;
      s = i*i;
      s = trim(s);
      z = substr(zeros, 1, length(s));
      do j = 1 to length(s)-1;
         if substr(s, j+1) = substr(z, j+1) then leave;
         m = substr(s, 1, j) + substr(s, j+1);
         if i = m then put skip list (i);
      end;
   end;

end kaprekar;


function Test-Kaprekar ([int]$Number)
{
    if ($Number -eq 1)
    {
        return $true
    }

    [int64]$a = $Number * $Number
    [int64]$b = 10

    while ($b -lt $a)
    {
        [int64]$remainder = $a % $b
        [int64]$quotient  = ($a - $remainder) / $b

        if ($remainder -gt 0 -and $remainder + $quotient -eq $Number)
        {
            return $true
        }

        $b *= 10
    }

    return $false
}


kaprekar_(Z, X) :-
	split_number(Z, 10, X).

split_number(Z, N, X) :-
	N < Z,
	A is Z // N,
	B is Z mod N,
	(   (X is A+B,  B\= 0)-> true; N1 is N*10, split_number(Z, N1, X)).

kaprekar(N, V) :-
	V <- {X & X <- 1 .. N & ((Z is X * X, kaprekar_(Z, X)); X = 1) }.


Procedure Kaprekar(n.i)
  nn.q  = n*n
  tens.q= 1
  While tens<nn: tens*10: Wend
  Repeat
    tens/10
    If tens<=n: Break: EndIf
    If nn-n = (nn/tens) * (tens-1)
      ProcedureReturn #True
    EndIf
  ForEver
  If n=1
    ProcedureReturn #True
  EndIf
EndProcedure

If OpenConsole()
  For i=1 To 1000000
    If Kaprekar(i)
      cnt+1
      PrintN(RSet(Str(cnt),3)+":"+RSet(Str(i),8))
    EndIf
  Next
  ;
  Print("Press ENTER to exit")
  Input()
EndIf


  [ dup 1 = if done
    dup temp put
    dup *
    false swap 1
    [ base share *
      2dup /mod
      over 0 = iff
        2drop done
      dup 0 = iff
        2drop again
      + temp share = iff
        [ rot not unrot ]
        done
      again ]
    2drop
    temp release ]        is kaprekar ( n --> b )

  say "Kaprekar numbers less than one thousand: "
  []
  1000 times
    [ i^ kaprekar if
      [ i^ join ] ]
  echo cr cr

  say "Number of Kaprekar numbers less than one million: "
  0
  1000000 times
    [ i^ kaprekar if 1+ ]
  echo cr cr

  say "Base 17 Kaprekar numbers less than one million." cr cr
  17 base put
    []
  1000000 times
    [ i^ kaprekar if
      [ i^ join ] ]
  say "In base 17: "
  dup echo cr
  base release
  say "In decimal: "
  echo


#lang racket
(define (kaprekar? n)
  (or (= n 1)
      (let ([q (sqr n)])
        (let loop ((p 10))
          (and (<= p q)
               (or (let-values  ([(b a) (quotient/remainder q p)])
                     (and (> a 0) (= n (+ a b))))
                   (loop (* p 10))))))))

(filter kaprekar? (range 1 10000))


sub kaprekar( Int $n ) {
    my $sq = $n ** 2;
    for 0 ^..^ $sq.chars -> $i {
        my $x = +$sq.substr(0, $i);
        my $y = +$sq.substr($i) || return;
        return True if $x + $y == $n;
    }
    False;
}

print 1;
print " $_" if .&kaprekar for ^10000;
print "\n";


           ╔═══════════════════════════════════════════════════════════════════╗
           ║ Kaprekar numbers were thought of by the mathematician from India, ║
           ║ Shri Dattathreya Ramachardra Kaprekar  (1905 ───► 1986).          ║
           ╚═══════════════════════════════════════════════════════════════════╝


with Ada.Numerics.Generic_Complex_Types;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Palettes;
with SDL.Events.Events;

procedure Julia_Set is

   Width      : constant := 1_200;
   Height     : constant := 900;

   type Real is new Float;
   package Complex_Real is
      new Ada.Numerics.Generic_Complex_Types (Real);
   use Complex_Real;

   Iter   : constant         := 100;
   C      : constant Complex := (Re => -0.70000, Im => 0.27015);
   Move   : constant Complex := (Re => 0.000,    Im => 0.000);
   Zoom   : constant         := 0.800;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   function Map (Width, Height : in Integer;
                 X, Y          : in Integer) return Complex
   is
      C : Complex;
      L : constant Real := Real (Integer'Max (Width, Height));
   begin
      C := (2.0 * Real (X - Width  / 2) / (L * Zoom),
            2.0 * Real (Y - Height / 2) / (L * Zoom));
      return C + Move;
   end Map;

   procedure Draw_Julia_Set is
      use type SDL.C.int;
      use SDL.Video.Palettes;
      Z : Complex;
   begin
      for Y in 0 .. Height loop
         for X in 0 .. Width loop
            Z := Map (Width, Height, X, Y);
            for N in 1 .. Iter loop
               Z := Z ** 2 + C;
               if abs (Z) > 2.0 then
                  Renderer.Set_Draw_Colour ((Red   => 2 * Colour_Component (N),
                                             Green => 255 - 2 * Colour_Component (N),
                                             Blue  => 150, Alpha => 255));
                  Renderer.Draw (Point => (X => SDL.C.int (X),
                                           Y => SDL.C.int (Y)));
                  exit;
               end if;
            end loop;
         end loop;
      end loop;
   end Draw_Julia_Set;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Julia set",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create  (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   Draw_Julia_Set;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Julia_Set;


nr = 0
for i = 1 to 200
    if kaprekar(i)
       nr += 1
       if i < 201 see "" + nr + " : " + i + nl ok ok
next
see "total kaprekar numbers under 200 = " + nr + nl

func kaprekar n
     s = pow(n,2)
     x = floor(log(s)) + 1
     t = pow(10,x)
     while true
           t /= 10
           if t<=n exit ok
           if s-n = floor(s/t)*(t-1) n = true ok
     end
     return (n = 1)


def kaprekar(n, base = 10)
  return [1, 1, 1, ""] if n == 1
  return if n*(n-1) % (base-1) != 0     # casting out nine
  sqr = (n ** 2).to_s(base)
  (1...sqr.length).each do |i|
    a = sqr[0 ... i]
    b = sqr[i .. -1]
    break if b.delete("0").empty?
    sum = a.to_i(base) + b.to_i(base)
    return n.to_s(base), sqr, a, b if sum == n
  end
  nil
end

count = 0
1.upto(10_000 - 1) do |i|
  if result = kaprekar(i)
    puts "%4d  %8d  %s + %s" % result
    count += 1
  end
end

10_000.upto(1_000_000 - 1) {|i| count += 1 if kaprekar(i)}
puts "#{count} kaprekar numbers under 1,000,000"

puts "\nbase17 kaprekar numbers under (base10)1,000,000"
base = 17
1.upto(1_000_000) do |decimal|
  if result = kaprekar(decimal, base)
    puts "%7s  %5s  %9s  %s + %s" % [decimal, *result]
  end
end


BEGIN
    REAL c real, c imaginary;
    STRING real and imaginary := IF argc < 3 THEN "-0.8"  ELSE argv( 3 ) FI
                               + " "
                               + IF argc < 4 THEN "0.156" ELSE argv( 4 ) FI
                               + " "
                               ;
    FILE numbers;
    associate( numbers, real and imaginary );
    get( numbers, ( c real, c imaginary ) );
    print( ( fixed( c real, -8, 4 ), fixed( c imaginary, -8, 4 ), newline ) );
    FOR v FROM -100 BY 10 TO 100 DO
        FOR h FROM -280 BY 10 TO 280 DO
            REAL x := h / 200;
            REAL y := v / 100;
            CHAR plot char := "#";
            FOR i TO 50
            WHILE
                REAL z real      = ( x * x ) - ( y * y ) + c real;
                REAL z imaginary = ( x * y * 2 ) + c imaginary;
                IF z real * z real <= 10000
                THEN TRUE
                ELSE
                    plot char := " ";
                    FALSE
                FI
            DO
                x := z real;
                y := z imaginary
            OD;
            print( ( plot char ) )
        OD;
        print( ( newline ) )
    OD
END


#!/usr/bin/hopper

#include <hopper.h>

main:

    hxres = 500           // horizontal resolution
    hyres = 500           // vertical resolution

    itermax = 100         // maximum iters to do

    brk_out = 64          // |z|^2 greater than this is a breakout
    magnify = 1           // 10 is standard magnification, but if > 2, resolution should be greater than 500

    cr = -0.8             // real part of c in z^2=z^2+c
    ci = 0.156            // imaginary part of c in z^2=z^2+c

    julia=0,{hxres,hyres}nanarray(julia)

    {","}toksep
#hl{        // tag "high-level", Basic language embebed in Hopper

    hy=1
    while(hy<=hyres)
       hx=1
       while(hx<=hxres)

          y = 4*((((hyres+1-hy-0.5)/hyres)-0.5)/magnify)
          x = 4*((((hx-0.5)/hxres)-0.5)/magnify)
          zm = 0

          iter=1

          while(iter<=(itermax-1))
             xx = sqrdiff(x,y)+cr   //(x*x)-(y*y)+cr
             y = (2.0*x*y)+ci
             x = xx
             zsq = sqradd(x,y)      //(x*x)+(y*y)

             if (zsq>zm)
                zm=zsq
             endif
             if (zsq>brk_out)
                break
             endif
             iter += 1
          wend

          if (iter>=itermax)
             julia[hy,hx]=1

          else
             julia[hy,hx]=0

          endif

          hx+=1
       wend
       hy+=1
    wend
   }
   toc(t1,t2)
   {julia,"julia.dat"}save
exit(0)


for i   = 1 to 5000
  x$    = str$(i * i)
  if i  = 1 then x$ = "10"
  for j = 1 to len(x$) - 1
   if (val(left$(x$,j)) + val(mid$(x$,j+1)) = i and val(mid$(x$,j+1)) <> 0) or i = 1  then print "Kaprekar :";left$(x$,j);" + ";mid$(x$,j+1);" = ";i
  next j
next i


object Kaprekar extends App {

  def isKaprekar(n: Int, base: Int = 10):Option[Triple[String,String,String]] = {
    val check: Long => Option[Triple[String,String,String]] = n => {
      val split: Pair[String, Int] => Pair[String, String] = p => (p._1.slice(0,p._2),p._1.slice(p._2,p._1.size).padTo[Char,String](1,'0'))
      val pwr = n*n
      val sN = java.lang.Long.toString(n, base)
      val sPwr = java.lang.Long.toString(pwr, base)
      for (i <- 1 to sPwr.size) {
        val (a, b) = split(sPwr,i)
        val la = java.lang.Long.parseLong(a, base)
        val lb = java.lang.Long.parseLong(b, base)
        if (lb==0) return None
        if (la+lb==n) return Some(Triple(sPwr,a,b))
      }
      None
    }
    n match {
      case 1 => Some(Triple("1","0","1"))
      case n if (n>1) => check(n)
      case _ => None
    }
  }

  def kaprekars(n: Int,base: Int=10) = (1 to n).map(isKaprekar(_,base)).zip(1 to n).filter(_._1!=None).map(p=>Triple(base,p._2,p._1 match {case Some(t) => t; case _ => Nil}))

  val k1 = kaprekars(10000)
  k1 foreach {p=>println(p._2)}
  println(k1.size + " Kaprekar numbers < 10000 (b:10) for base 10"+"\n"*2)

  val k2 = kaprekars(1000000)
  k2 foreach {p => println(p._2+"\t"+java.lang.Long.toString(p._2,p._1)+"\t"+p._3.productElement(0)+"\t"+p._3.productElement(1)+" + "+p._3.productElement(2))}
  println(k2.size + " Kaprekar numbers < 1000000 (b:10) for base 10"+"\n"*2)

  val k3 = kaprekars(1000000,17)
  k3 foreach {p => println(p._2+"\t"+java.lang.Long.toString(p._2,p._1)+"\t"+p._3.productElement(0)+"\t"+p._3.productElement(1)+" + "+p._3.productElement(2))}
  println(k3.size + " Kaprekar numbers < 1000000 (b:10) for base 17"+"\n"*2)

}


# syntax: GAWK -f JULIA_SET.AWK [real imaginary]
BEGIN {
    c_real      = (ARGV[1] != "") ? ARGV[1] : -0.8
    c_imaginary = (ARGV[2] != "") ? ARGV[2] : 0.156
    printf("%s %s\n",c_real,c_imaginary)
    for (v=-100; v<=100; v+=10) {
      for (h=-280; h<=280; h+=10) {
        x = h / 200
        y = v / 100
        plot_char = "#"
        for (i=1; i<=50; i++) {
          z_real = x * x - y * y + c_real
          z_imaginary = x * y * 2 + c_imaginary
          if (z_real ^ 2 > 10000) {
            plot_char = " "
            break
          }
          x = z_real
          y = z_imaginary
        }
        printf("%1s",plot_char)
      }
      printf("\n")
    }
    exit(0)
}


escala = 1 / 81
zeroX = 160
zeroY = 100
maxiter = 32

CR = -.798
CI = .1618

SCREEN 13
FOR x = 0 TO 2 * zeroX - 1
    FOR y = 0 TO 2 * zeroY - 1
        zreal = (x - zeroX) * escala
        zimag = (zeroY - y) * escala
        FOR iter = 1 TO maxiter
            BR = CR + zreal * zreal - zimag * zimag
            zimag = CI + 2 * zreal * zimag
            zreal = BR
            IF zreal * zreal + zimag * zimag > 4 THEN
                PSET (x, y), 1 + (iter MOD 16)
                EXIT FOR
            END IF
        NEXT iter
    NEXT y
NEXT x
END


; auxiliary functions : range, filter
(define (range a b)
(let loop ((v '()) (i b))
(if (< i a)
    v
    (loop (cons i v)
          (- i 1)))))

(define (filter p u)
(if (equal? u '())
    '()
    (let ((x (car u)) (v (filter p (cdr u))))
         (if (p x)
             (cons x v)
             v))))

(define (kaprekar? n)
(or (= n 1)
    (let ((q (* n n)))
    (let loop ((p 10))
         (cond ((> p q) #f)
               ((let ((a (remainder q p)) (b (quotient q p)))
                     (and (> a 0) (= n (+ a b)))) #t)
               (else (loop (* p 10))))))))

(filter kaprekar? (range 1 10000))
; (1 9 45 55 99 297 703 999 2223 2728 4879 4950 5050 5292 7272 7777 9999)


$ include "seed7_05.s7i";
  include "bigint.s7i";

const func bigInteger: kaprekar (in bigInteger: n, in bigInteger: base) is func
  result
    var bigInteger: kaprekar is 0_;
  local
    var bigInteger: nn is 0_;
    var bigInteger: r is 0_;
    var bigInteger: powerOfBase is 1_;
  begin
    nn := n ** 2;
    while powerOfBase < n do
      powerOfBase *:= base;
    end while;
    if n = powerOfBase then
      kaprekar := bigInteger conv ord(n = 1_);
    else
      r := nn rem powerOfBase;
      while r < n do
        if nn div powerOfBase + r = n then
          kaprekar := powerOfBase;
          r := n;
        else
	  powerOfBase *:= base;
          r := nn rem powerOfBase;
        end if;
      end while;
    end if;
  end func;

const proc: main is func
  local
    var bigInteger: aNumber is 0_;
    var integer: count is 0;
    var bigInteger: powerOfBase is 1_;
    const integer: base is 17;
  begin
    writeln("base 10:");
    for aNumber range 1_ to 1000000_ do
      if kaprekar(aNumber, 10_) <> 0_ then
        incr(count);
        writeln(count lpad 3 <& ": " <& aNumber);
      end if;
    end for;
    writeln;
    writeln("base " <& base <& ":");
    writeln("  1: 1");
    count := 1;
    for aNumber range 2_ to 1000000_ do
      powerOfBase := kaprekar(aNumber, bigInteger conv base);
      if powerOfBase <> 0_ then
        incr(count);
        write(count lpad 3 <& ": " <& aNumber);
        write(" \t" <& aNumber radix base);
        write("\t"  <& aNumber ** 2 radix base);
        write("\t"  <& aNumber ** 2 mdiv powerOfBase radix base);
        write(" + " <& aNumber ** 2 mod powerOfBase radix base);
        writeln;
      end if;
    end for;
  end func;


<executable name> <width of graphics window> <height of graphics window> <real part of complex number> <imag part of complex number> <limiting radius> <Number of iterations to be tested>


using System.Drawing;
// Note: You have to add the System.Drawing assembly
//  (right-click "references," Add Reference, Assemblies, Framework,
//    System.Drawing, OK)
using System.Linq;

namespace RosettaJuliaSet
{
    class Program
    {
        static void Main(string[] args)
        {
            const int w = 800;
            const int h = 600;
            const int zoom = 1;
            const int maxiter = 255;
            const int moveX = 0;
            const int moveY = 0;
            const double cX = -0.7;
            const double cY = 0.27015;
            double zx, zy, tmp;
            int i;

            var colors = (from c in Enumerable.Range(0, 256)
                          select Color.FromArgb((c >> 5) * 36, (c >> 3 & 7) * 36, (c & 3) * 85)).ToArray();

            var bitmap = new Bitmap(w, h);
            for (int x = 0; x < w; x++)
            {
                for (int y = 0; y < h; y++)
                {
                    zx = 1.5 * (x - w / 2) / (0.5 * zoom * w) + moveX;
                    zy = 1.0 * (y - h / 2) / (0.5 * zoom * h) + moveY;
                    i = maxiter;
                    while (zx * zx + zy * zy < 4 && i > 1)
                    {
                        tmp = zx * zx - zy * zy + cX;
                        zy = 2.0 * zx * zy + cY;
                        zx = tmp;
                        i -= 1;
                    }
                    bitmap.SetPixel(x, y, colors[i]);
                }
            }
            bitmap.Save("julia-set.png");
        }
    }
}


var kapr = Set()

for n in (1..15) {
    var k = (10**n - 1)
    k.udivisors.each {|d|
        var dp = k/d
        kapr << (dp == 1 ? d : d*invmod(d, dp))
    }
}

say kapr.grep { .<= 1e4 }.sort

for n in (6 .. 14) {
    var k = (10**n - 1)
    printf("Kaprekar numbers <= 10^%2d:  %5d\n", n, kapr.count_by { .<= k })
}


package require Tcl 8.5;   # Arbitrary precision arithmetic, for stretch goal only
proc kaprekar n {
    if {$n == 1} {return 1}
    set s [expr {$n * $n}]
    for {set i 1} {$i < [string length $s]} {incr i} {
	scan $s "%${i}d%d" a b
	if {$b && $n == $a + $b} {
	    return 1
	    #return [list 1 $a $b]
	}
    }
    return 0
}

# Base goal
for {set i 1} {$i < 10000} {incr i} {
    if {[kaprekar $i]} {lappend klist $i}
}
puts [join $klist ", "]

# Stretch goal
for {set i 1} {$i < 1000000} {incr i} {
    incr kcount [kaprekar $i]
}
puts "$kcount Kaprekar numbers less than 1000000"


#include <windows.h>
#include <string>
#include <complex>

const int BMP_SIZE = 600, ITERATIONS = 512;
const long double FCT = 2.85, hFCT = FCT / 2.0;

class myBitmap {
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap() {
        DeleteObject( pen ); DeleteObject( brush );
        DeleteDC( hdc ); DeleteObject( bmp );
    }
    bool create( int w, int h ) {
        BITMAPINFO bi;
        ZeroMemory( &bi, sizeof( bi ) );
        bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
        bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
        bi.bmiHeader.biCompression = BI_RGB;
        bi.bmiHeader.biPlanes      = 1;
        bi.bmiHeader.biWidth       =  w;
        bi.bmiHeader.biHeight      = -h;
        HDC dc = GetDC( GetConsoleWindow() );
        bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
        if( !bmp ) return false;
        hdc = CreateCompatibleDC( dc );
        SelectObject( hdc, bmp );
        ReleaseDC( GetConsoleWindow(), dc );
        width = w; height = h;
        return true;
    }
    void clear( BYTE clr = 0 ) {
        memset( pBits, clr, width * height * sizeof( DWORD ) );
    }
    void setBrushColor( DWORD bClr ) {
        if( brush ) DeleteObject( brush );
        brush = CreateSolidBrush( bClr );
        SelectObject( hdc, brush );
    }
    void setPenColor( DWORD c ) {
        clr = c; createPen();
    }
    void setPenWidth( int w ) {
        wid = w; createPen();
    }
    void saveBitmap( std::string path ) {
        BITMAPFILEHEADER fileheader;
        BITMAPINFO       infoheader;
        BITMAP           bitmap;
        DWORD            wb;
        GetObject( bmp, sizeof( bitmap ), &bitmap );
        DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];
        ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
        ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
        ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );
        infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
        infoheader.bmiHeader.biCompression = BI_RGB;
        infoheader.bmiHeader.biPlanes = 1;
        infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
        infoheader.bmiHeader.biHeight = bitmap.bmHeight;
        infoheader.bmiHeader.biWidth = bitmap.bmWidth;
        infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );
        fileheader.bfType    = 0x4D42;
        fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
        fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;
        GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );
        HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
            FILE_ATTRIBUTE_NORMAL, NULL );
        WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
        WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
        WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
        CloseHandle( file );
        delete [] dwpBits;
    }
    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }
    DWORD* bits() const { return ( DWORD* )pBits; }
private:
    void createPen() {
        if( pen ) DeleteObject( pen );
        pen = CreatePen( PS_SOLID, wid, clr );
        SelectObject( hdc, pen );
    }
    HBITMAP bmp; HDC    hdc;
    HPEN    pen; HBRUSH brush;
    void    *pBits; int    width, height, wid;
    DWORD    clr;
};
class julia {
public:
    void draw( std::complex<long double> k ) {
        bmp.create( BMP_SIZE, BMP_SIZE );
        DWORD* bits = bmp.bits();
        int res, pos;
        std::complex<long double> c, factor( FCT / BMP_SIZE, FCT / BMP_SIZE ) ;

        for( int y = 0; y < BMP_SIZE; y++ ) {
            pos = y * BMP_SIZE;

            c.imag( ( factor.imag() * y ) + -hFCT );

            for( int x = 0; x < BMP_SIZE; x++ ) {
                c.real( factor.real() * x + -hFCT );
                res = inSet( c, k );
                if( res ) {
                    int n_res = res % 255;
                    if( res < ( ITERATIONS >> 1 ) ) res = RGB( n_res << 2, n_res << 3, n_res << 4 );
                    else res = RGB( n_res << 4, n_res << 2, n_res << 5 );
                }
                bits[pos++] = res;
            }
        }
        bmp.saveBitmap( "./js.bmp" );
    }
private:
    int inSet( std::complex<long double> z, std::complex<long double> c ) {
        long double dist;//, three = 3.0;
        for( int ec = 0; ec < ITERATIONS; ec++ ) {
            z = z * z; z = z + c;
            dist = ( z.imag() * z.imag() ) + ( z.real() * z.real() );
            if( dist > 3 ) return( ec );
        }
        return 0;
    }
    myBitmap bmp;
};
int main( int argc, char* argv[] ) {
    std::complex<long double> c;
    long double factor = FCT / BMP_SIZE;
    c.imag( ( factor * 184 ) + -1.4 );
    c.real( ( factor * 307 ) + -2.0 );
    julia j; j.draw( c ); return 0;
}


#import std
#import nat

kd("p","r") = ~&ihB+ (~&rr&& ^|E/~& sum)~|^/~& "r"~~*hNCtXS+ cuts\1+ "p"+ [email protected]

#cast %nLnX

t = ^|(~&,length) (iota; :/1+ ~&rFlS+ * ^/~& kd\%np ~&h+ %nP)~~/10000 1000000


Module Module1

    ReadOnly max As ULong = 1000000

    Function Kaprekar(n As ULong) As Boolean
        If n = 1 Then Return True

        Dim sq = n * n
        Dim sq_str = Str(sq)
        Dim l = Len(sq_str)

        For x = l - 1 To 1 Step -1
            If sq_str(x) = "0" Then
                l = l - 1
            Else
                Exit For
            End If
        Next

        For x = 1 To l - 1
            Dim p2 = Val(Mid(sq_str, x + 1))
            If p2 > n Then
                Continue For
            End If
            Dim p1 = Val(Left(sq_str, x))
            If p1 > n Then Return False
            If (p1 + p2) = n Then Return True
        Next

        Return False
    End Function

    Sub Main()
        Dim count = 0

        Console.WriteLine("Kaprekar numbers below 10000")

        For n = 1 To max - 1
            If Kaprekar(n) Then
                count = count + 1
                If n < 10000 Then
                    Console.WriteLine("{0,2} {1,4}", count, n)
                End If
            End If
        Next

        Console.WriteLine()
        Console.WriteLine("{0} numbers below {1} are kaprekar numbers", count, max)
    End Sub

End Module


IDENTIFICATION DIVISION.
PROGRAM-ID. JULIA-SET-PROGRAM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01  WS-COMPLEX-CONSTANT.
    05 C-REAL             PIC S9V999.
    05 C-IMAGINARY        PIC S9V999.
01  WS-ARGAND-PLANE.
    05 X                  PIC S9(9)V999.
    05 Y                  PIC S9(9)V999.
01  WS-COMPLEX-VARIABLE.
    05 Z-REAL             PIC S9(9)V999.
    05 Z-IMAGINARY        PIC S9(9)V999.
01  WS-TEMPORARY-RESULTS.
    05 X-SQUARED          PIC S9(9)V999.
    05 Y-SQUARED          PIC S9(9)V999.
    05 X-TIMES-Y          PIC S9(9)V999.
    05 Z-REAL-SQUARED     PIC S9(9)V999.
01  WS-LOOP-COUNTERS.
    05 HORIZONTAL         PIC 999.
    05 VERTICAL           PIC 999.
    05 ITERATIONS         PIC 99.
77  WS-PLOT-CHARACTER     PIC X.
PROCEDURE DIVISION.
INPUT-COMPLEX-CONSTANT-PARAGRAPH.
    ACCEPT C-REAL      FROM CONSOLE.
    ACCEPT C-IMAGINARY FROM CONSOLE.
CONTROL-PARAGRAPH.
    PERFORM OUTER-LOOP-PARAGRAPH  VARYING VERTICAL   FROM 1 BY 10
    UNTIL VERTICAL IS GREATER THAN 320.
    STOP RUN.
OUTER-LOOP-PARAGRAPH.
    PERFORM COMPUTATION-PARAGRAPH VARYING HORIZONTAL FROM 1 BY 10
    UNTIL HORIZONTAL IS GREATER THAN 560.
    DISPLAY '' UPON CONSOLE.
COMPUTATION-PARAGRAPH.
    SUBTRACT 280   FROM HORIZONTAL GIVING X.
    SUBTRACT 160   FROM VERTICAL   GIVING Y.
    DIVIDE   X     BY   200        GIVING X.
    DIVIDE   Y     BY   100        GIVING Y.
    MOVE     '#'   TO   WS-PLOT-CHARACTER.
    PERFORM COMPLEX-MULTIPLICATION-PARAGRAPH
    VARYING ITERATIONS FROM   1  BY      1
    UNTIL   ITERATIONS        IS GREATER THAN 50
    OR      WS-PLOT-CHARACTER IS EQUAL   TO   SPACE.
    DISPLAY WS-PLOT-CHARACTER UPON CONSOLE WITH NO ADVANCING.
COMPLEX-MULTIPLICATION-PARAGRAPH.
    MULTIPLY X         BY   X         GIVING X-SQUARED.
    MULTIPLY Y         BY   Y         GIVING Y-SQUARED.
    SUBTRACT Y-SQUARED FROM X-SQUARED GIVING Z-REAL.
    ADD      C-REAL    TO   Z-REAL.
    MULTIPLY X         BY   Y         GIVING X-TIMES-Y.
    MULTIPLY X-TIMES-Y BY   2         GIVING Z-IMAGINARY.
    ADD C-IMAGINARY    TO   Z-IMAGINARY.
    MULTIPLY Z-REAL    BY   Z-REAL    GIVING Z-REAL-SQUARED.
    IF  Z-REAL-SQUARED IS   GREATER   THAN   10000 THEN
    MOVE SPACE         TO   WS-PLOT-CHARACTER.
    MOVE Z-REAL        TO   X.
    MOVE Z-IMAGINARY   TO   Y.


import strconv

fn kaprekar(n u64, base u64) (bool, int) {
    mut order := 0
    if n == 1 {
        return true, -1
    }

    nn, mut power := n*n, u64(1)
    for power <= nn {
        power *= base
        order++
    }

    power /= base
    order--
    for ; power > 1; power /= base {
        q, r := nn/power, nn%power
        if q >= n {
            return false, -1
        }

        if q+r == n {
            return true, order
        }

        order--
    }

    return false, -1
}

fn main() {
    mut max := u64(10000)
    println("Kaprekar numbers < $max:")
    for m := u64(0); m < max; m++ {
        isk, _ := kaprekar(m, 10)
        if isk {
            println("  $m")
        }
    }

    // extra credit
    max = u64(1e6)
    mut count := 0
    for m := u64(0); m < max; m++ {
        isk, _ := kaprekar(m, 10)
        if isk {
            count++
        }
    }
    println("\nThere are $count Kaprekar numbers < ${max}.")

    // extra extra credit
    base := 17
    max_b := "1000000"
    println("\nKaprekar numbers between 1 and ${max_b}(base ${base}):")
    max, _ = strconv.common_parse_uint2(max_b, base, 64)
    println("\n Base 10  Base ${base}        Square       Split")
    for m := u64(2); m < max; m++ {
        isk, pos := kaprekar(m, u64(base))
        if !isk {
            continue
        }
        sq := strconv.format_uint(m*m, base)
        str := strconv.format_uint(m, base)
        split := sq.len-pos
        println("${m:8}  ${str:7}  ${sq:12}  ${sq[..split]:6} + ${sq[split..]}") // optional extra extra credit
    }
}


@let {
  isKap &n [
    @var s +'' *n n
    @for i til +1/#s 2 [
      @vars {
        fn @+!!s.slice 0 i
        sn @+!s.slice i
      }
      @if =0 sn @break
      @if =n +fn sn @return [fn sn]
    ]
    false
  ]

  ~[
    !console.log "Kaprekar numbers below 10000: {!-isKap @to 1TK}"
    !console.log "Number of Kaprekar numbers below 1000000: {#!-isKap @to 1M}"
  ]
}


F juggler(n)
   V a = Int64(n)
   V r_count = 0
   V r_max = a
   V r_maxidx = 0
   L a != 1
      V f = Float(a)
      a = Int64(I a [&] 1 == 0 {sqrt(f)} E f * sqrt(f))
      r_count++
      I a > r_max
         r_max = a
         r_maxidx = r_count
   R (r_count, r_max, r_maxidx)

print(‘n   l[n]            h[n]  i[n]’)
print(‘------------------------------’)
L(n) 20..39
   V (l, h, i) = juggler(n)
   print(f:‘{n}   {l:2}  {h:14}     {i}’)


require "complex"

def julia(c_real, c_imag)
  puts Complex.new(c_real, c_imag)
  -1.0.step(to: 1.0, by: 0.04) do |v|
    puts -1.4.step(to: 1.4, by: 0.02).map{|h| judge(c_real, c_imag, h, v)}.join
  end
end

def judge(c_real, c_imag, x, y)
  50.times do
    z_real = (x * x - y * y) + c_real
    z_imag = x * y * 2 + c_imag
    return " "  if z_real**2 > 10000
    x, y = z_real, z_imag
  end
  "#"
end

julia(-0.8, 0.156)


program Julia_set;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Winapi.Windows,
  Vcl.Graphics;

var
  Colors: array[0..255] of TColor;
  w, h, zoom, maxiter, moveX, moveY: Integer;
  cX, cY, zx, zy, tmp: Double;
  i: Integer;
  bitmap: TBitmap;
  x, y: Integer;

begin
  w := 800;
  h := 600;
  zoom := 1;
  maxiter := 255;
  moveX := 0;
  moveY := 0;
  cX := -0.7;
  cY := 0.27015;
  bitmap := TBitmap.Create();
  bitmap.SetSize(w, h);
  bitmap.Canvas.Brush.Color := clwhite;
  bitmap.Canvas.FillRect(bitmap.Canvas.ClipRect);

  for i := 0 to 255 do
    Colors[i] := RGB((i shr 5) * 36, ((i shr 3) and 7) * 36, (i and 3) * 85);

  for x := 0 to w - 1 do
  begin
    for y := 0 to h - 1 do
    begin
      zx := 1.5 * (x - w / 2) / (0.5 * zoom * w) + moveX;
      zy := 1.0 * (y - h / 2) / (0.5 * zoom * h) + moveY;
      i := maxiter;
      while (zx * zx + zy * zy < 4) and (i > 1) do
      begin
        tmp := zx * zx - zy * zy + cX;
        zy := 2.0 * zx * zy + cY;
        zx := tmp;
        i := i - 1;
      end;
      bitmap.Canvas.Pixels[x, y] := colors[i];
    end;
  end;

  bitmap.SaveToFile('julia-set.bmp');
  bitmap.Free;
end.


import "/fmt" for Fmt, Conv

var kaprekar = Fn.new { |n, base|
    var order = 0
    if (n == 1) return [true, -1]
    var nn = n * n
    var power = 1
    while (power <= nn) {
        power = power * base
        order = order + 1
    }
    power = (power/base).floor
    order = order - 1
    while (power > 1) {
        var q = (nn/power).floor
        var r = nn % power
        if (q >= n) return [false, -1]
        if (q + r == n) return [true, order]
        order = order - 1
        power = (power/base).floor
    }
    return [false, -1]
}

var max = 1e4
System.print("Kaprekar numbers < %(max):")
for (m in 0...max) {
    var res = kaprekar.call(m, 10)
    if (res[0]) Fmt.print("$6d", m)
}

max = 1e6
var count = 0
for (m in 0...max) {
    var res = kaprekar.call(m, 10)
    if (res[0]) count = count + 1
}
System.print("\nThere are %(count) Kaprekar numbers < %(max).")

var base = 17
var maxB = 1e6.toString
System.print("\nKaprekar numbers between 1 and %(maxB)(base %(base)):")
max = Conv.atoi(maxB, base)
Fmt.print("\n Base 10  Base $d        Square       Split", base)
for (m in 2...max) {
    var res = kaprekar.call(m, base)
    if (res[0]) {
        var sq = Conv.itoa(m*m, base)
        var str = Conv.itoa(m, base)
        var split = sq.count - res[1]
        Fmt.print("$8d  $7s  $12s  $6s + $s", m, str, sq, sq[0...split], sq[split..-1])
    }
}


with Ada.Text_IO;
with Ada.Numerics.Generic_Elementary_Functions;

procedure Juggler is

   subtype Number  is Long_Long_Integer;
   type Index_Type is new Natural;

   subtype Initial_Values is Number range 20 .. 39;

   generic
      Initial : Number;
   package Generic_Juggler is
      procedure Next (Value : out Number; Index : out Index_Type);
   end Generic_Juggler;

   package body Generic_Juggler is

      type Real is new Long_Long_Float;

      package Real_Math is
        new Ada.Numerics.Generic_Elementary_Functions (Real);

      K   : Index_Type := 0;
      A_K : Real       := Real (Initial);

      procedure Next (Value : out Number; Index : out Index_Type) is
         use Real_Math;
      begin
         Value := Number (A_K);
         Index := K;
         A_K := (if Number (A_K) mod 2 = 0
                 then Real'Floor (A_K ** 0.5)
                 else Real'Floor (A_K ** 1.5));
         K := K + 1;
      end Next;

   end Generic_Juggler;

   procedure Statistics (N   : Number;     L_N : out Index_Type;
                         H_N : out Number; I_N : out Index_Type)
   is
      package Juggler_Generator is new Generic_Juggler (Initial => N);
      use Juggler_Generator;
      Value : Number;
   begin
      H_N := 0;
      I_N := 0;
      loop
         Next (Value, L_N);
         if Value > H_N then
            H_N := Value;
            I_N := L_N;
         end if;
         exit when Value = 1;
      end loop;
   end Statistics;

   procedure Put_Table is
      package Number_IO is new Ada.Text_IO.Integer_IO (Number);
      package Index_IO  is new Ada.Text_IO.Integer_IO (Index_Type);
      use Ada.Text_IO, Number_IO, Index_IO;
      L_N : Index_Type;
      H_N : Number;
      I_N : Index_Type;
   begin
      Put_Line ("  N   L(N)            H(N)   I(N)");
      Put_Line ("---------------------------------");
      for N in Initial_Values loop
         Statistics (N, L_N, H_N, I_N);
         Put (N, Width => 3);     Put (L_N, Width => 7);
         Put (H_N, Width => 16);  Put (I_N, Width => 7);  New_Line;
      end loop;
   end Put_Table;

begin
   Put_Table;
end Juggler;


on juggler(n)
    script o
        property sequence : {n}
    end script

    set i to 1
    set {max, pos} to {n, i}
    repeat until (n = 1)
        set n to n ^ (n mod 2 + 0.5) div 1
        set end of o's sequence to n
        set i to i + 1
        if (n > max) then set {max, pos} to {n, i}
    end repeat

    return {n:n, sequence:o's sequence, |length|:i, max:max, maxPos:pos}
end juggler

on intToText(n)
    if (n < 2 ^ 29) then return n as integer as text
    set lst to {n mod 10 as integer}
    set n to n div 10
    repeat until (n = 0)
        set beginning of lst to n mod 10 as integer
        set n to n div 10
    end repeat

    return join(lst, "")
end intToText

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

on task()
    set output to {}
    repeat with n from 20 to 39
        set {|length|:len, max:max, maxPos:pos} to juggler(n)
        set end of output to join({n, ": l[n] = ", len - 1, ", h[n] = ", intToText(max), ", i[n] = ", pos - 1}, "")
    end repeat

    return join(output, linefeed)
end task

task()


cx = -0.7
cy = 0.27015
for y range 300
  for x range 300
    zx = (x - 150) / 100
    zy = (y - 150) / 150
    color3 0 0 0
    for iter range 128
      if zx * zx + zy * zy > 4
        color3 iter / 16 0 0
        break 1
      .
      h = zx * zx - zy * zy + cx
      zy = 2 * zx * zy + cy
      zx = h
    .
    move x / 3 y / 3
    rect 0.4 0.4
  .
.


defmodule Julia do
  def set(c_real, c_imag) do
    IO.puts "#{c_real}, #{c_imag}"
    vlist = Enum.take_every(-100..100, 4)
    hlist = Enum.take_every(-280..280, 4)
    Enum.each(vlist, fn v ->
      Enum.map(hlist, fn h ->
        loop(c_real, c_imag, h/200, v/100, "#", 0)
      end) |> IO.puts
    end)
  end

  defp loop(_, _, _, _, char, i) when i>=50, do: char
  defp loop(_, _, _, _, " ", _), do: " "
  defp loop(c_real, c_imag, x, y, char, i) do
    z_real = (x * x - y * y) + c_real
    z_imag = x * y * 2 + c_imag
    char = if z_real * z_real > 10000, do: " ", else: char
    loop(c_real, c_imag, z_real, z_imag, char, i+1)
  end
end

c_real = if r=Enum.at(System.argv, 0), do: Float.parse(r) |> elem(0), else: -0.8
c_imag = if c=Enum.at(System.argv, 1), do: Float.parse(c) |> elem(0), else: 0.156
Julia.set(c_real, c_imag)


; === Graphical Julia set display in Emacs =====================

(setq julia-size (cons 300 200))
(setq xmin -1.5)
(setq xmax 1.5)
(setq ymin -1)
(setq ymax 1)
(setq julia0 (cons -0.512511498387847167 0.521295573094847167))
(setq max-iter 100)

(defun julia-iter-point (x y)
  "Run the actual iteration for each point."
  (let ((xp x)
        (yp y)
        (it 0)
        (xt 0))
    (while (and (< (+ (* xp xp) (* yp yp)) 4) (< it max-iter))
      (setq xt (+ (* xp xp) (* -1 yp yp) (car julia0)))
      (setq yp (+ (* 2 xp yp) (cdr julia0)))
      (setq xp xt)
      (setq it (1+ it)))
    it))

(defun julia-iter (p)
  "Return string for point based on whether inside/outside the set."
  (let ((it (julia-iter-point (car p) (cdr p))))
    (if (= it max-iter) "*" (if (cl-oddp it) "+" "-"))))

(defun julia-pos (x y)
  "Convert screen coordinates to input coordinates."
  (let ((xp (+ xmin (* (- xmax xmin) (/ (float x) (car julia-size)))))
        (yp (+ ymin (* (- ymax ymin) (/ (float y) (cdr julia-size))))))
       (cons xp yp)))

(defun string-to-image (str)
  "Convert image data string to XPM image with three colors."
  (create-image (concat (format "/* XPM */
static char * julia[] = {
\"%i %i 3 1\",
\"+      c #ff0000\",
\"-      c #0000ff\",
\"*      c #000000\"," (car julia-size) (cdr julia-size))
    str "};") 'xpm t))

(defun julia-pic ()
  "Plot the Julia set in color."
  (setq all "")
  (dotimes (y (cdr julia-size))
    (setq line "")
    (dotimes (x (car julia-size))
      (setq line (concat line (julia-iter (julia-pos x y)))))
    (setq all (concat all "\"" line "\",\n")))
  (insert-image (string-to-image all)))

(julia-pic)


include c:\cxpl\codes;  \intrinsic 'code' declarations

func Kaprekar(N, B);    \Returns 'true' if N is a Kaprekar number in base B
int  N, B;
real N2, D; int Q, R;
[N2:= sq(float(N));                     \N squared
D:= float(B);                           \(divider)
loop    [Q:= fix(N2/D - Mod(N2,1.));    \get left part (quotient)
        R:= fix(Mod(N2,D));             \get right part (remainder)
        if Q=0 then return false;
        if Q+R=N & R#0 then return true;
        D:= D * float(B);
        ];
];

int N, C;
[Format(1,0);           \show one place before decimal point and none after it
RlOut(0, 1.);           \show Kaprekar numbers less than ten thousand
for N:= 2 to 10_000-1 do
        if Kaprekar(N, 10) then
                [Text(0, " ");  IntOut(0, N)];
CrLf(0);
C:= 1;                  \show count of Kaprekar numbers less than one million
for N:= 2 to 1_000_000-1 do
        if Kaprekar(N, 10) then C:= C+1;
IntOut(0, C);
CrLf(0);
RlOut(0, 1.);           \show Kaprekar numbers less than one million in base 17
for N:= 2 to 1_000_000-1 do
        if Kaprekar(N, 17) then
                [Text(0, " ");  IntOut(0, N)];
CrLf(0);
]


clear screen
n = 0
FOR i = 1 TO 999999
    IF FNkaprekar(i) THEN
	n = n + 1
	IF i < 100001 PRINT n, ": ", i
    ENDIF
NEXT i
PRINT "Total Kaprekar numbers under 1,000,000 = ", n
END

sub FNkaprekar(n)
    LOCAL s, t

    s = n^2
    t = 10^(INT(LOG(s)) + 1)
    do
	t=t/10
	IF t<=n break
	IF s-n = INT(s/t)*(t-1) return TRUE
    loop
    return (n=1)
end sub


fcn isKaprekarB(n,b=10){
   powr:=n*n;
   r:=l:=0; tens:=b;
   while(r<n){
      r = powr % tens;
      l = powr / tens;
      if (r and (l + r == n)) return(True);
      tens *= b;
   }
   return(False);
}


Juggle ← {
    Step ← ⌊⊢⋆(0.5 + 2|⊢)
    ¯1‿0‿0 + 3↑{
        n‿imax‿max‿term ← 𝕩
        𝕊⍟(term≠1) ⟨n+1, (max<term)⊑imax‿n, max⌈term, Step term⟩
    } 0‿0‿0‿𝕩
}

>⟨"NLIH"⟩ ∾ (⊢∾Juggle)¨ 20+↕20


#include <cassert>
#include <iomanip>
#include <iostream>
#include <string>

#include <gmpxx.h>

using big_int = mpz_class;

auto juggler(int n) {
    assert(n >= 1);
    int count = 0, max_count = 0;
    big_int a = n, max = n;
    while (a != 1) {
        if (a % 2 == 0)
            a = sqrt(a);
        else
            a = sqrt(big_int(a * a * a));
        ++count;
        if (a > max) {
            max = a;
            max_count = count;
        }
    }
    return std::make_tuple(count, max_count, max, max.get_str().size());
}

int main() {
    std::cout.imbue(std::locale(""));
    std::cout << "n    l[n]  i[n]   h[n]\n";
    std::cout << "--------------------------------\n";
    for (int n = 20; n < 40; ++n) {
        auto [count, max_count, max, digits] = juggler(n);
        std::cout << std::setw(2) << n << "    " << std::setw(2) << count
                  << "    " << std::setw(2) << max_count << "    " << max
                  << '\n';
    }
    std::cout << '\n';
    std::cout << "       n       l[n]   i[n]   d[n]\n";
    std::cout << "----------------------------------------\n";
    for (int n : {113, 173, 193, 2183, 11229, 15065, 15845, 30817, 48443,
                  275485, 1267909, 2264915, 5812827, 7110201, 56261531,
                  92502777, 172376627, 604398963}) {
        auto [count, max_count, max, digits] = juggler(n);
        std::cout << std::setw(11) << n << "    " << std::setw(3) << count
                  << "    " << std::setw(3) << max_count << "    " << digits
                  << '\n';
    }
}


let getJuliaValues width height centerX centerY zoom maxIter =
  let initzx x = 1.5 * float(x - width/2) / (0.5 * zoom * float(width))
  let initzy y = 1.0 * float(y - height/2) / (0.5 * zoom * float(height))
  let calc y x =
    let rec loop i zx zy =
      if i=maxIter then 0
      elif zx*zx + zy*zy >= 4.0 then i
      else loop (i + 1) (zx*zx - zy*zy + centerX) (2.0*zx*zy + centerY)
    loop 0 (initzx x) (initzy y)
  [0..height-1] |> List.map(fun y->[0..width-1] |> List.map (calc y))


#define pix 1./120
#define zero_x 320
#define zero_y 240
#define maxiter 250

type complex
    r as double
    i as double
end type

operator + (x as complex, y as complex) as complex
    dim as complex ret
    ret.r = x.r + y.r
    ret.i = x.i + y.i
    return ret
end operator

operator * (x as complex, y as complex) as complex
    dim as complex ret
    ret.r = x.r*y.r - x.i*y.i
    ret.i = x.r*y.i + x.i*y.r
    return ret
end operator

operator abs ( x as complex ) as double
    return sqr(x.r*x.r + x.i*x.i)
end operator

dim as complex c, z
dim as integer x, y, iter

input "Real part of c? ", c.r
input "Imaginary part of c? ", c.i

screen 12

for x=0 to 639
   for y=0 to 479
      z.r = (x-zero_x)*pix
      z.i = (y-zero_y)*pix
      for iter=0 to maxiter
          z = z*z + c
          if abs(z)>2 then
              pset(x,y),iter mod 16
              goto cont
          end if
       next iter
       pset(x,y),1
       cont:
    next y
next x

while inkey=""
wend
end


// Juggler sequence. Nigel Galloway: August 19th., 2021
let J n=Seq.unfold(fun(n,i,g,l)->if n=1I then None else let e=match n.IsEven with true->Isqrt n |_->Isqrt(n**3) in Some((i,g,l),if e>i then (e,e,l+1,l+1) else (e,i,g,l+1)))(n,n,0,0)|>Seq.last
printfn " n  l[n] i[n]  h[n]\n___________________"; [20I..39I]|>Seq.iter(fun n->let i,g,l=J n in printfn $"%d{int n}%5d{l+1}%5d{g}   %A{i}")
printfn "      n  l[n] i[n]  d[n]\n________________________"; [113I;173I;193I;2183I;11229I;15065I;15845I;30817I]|>Seq.iter(fun n->let i,g,l=J n in printfn $"%8d{int n}%5d{l+1}%5d{g}   %d{(bigint.Log10>>int>>(+)1) i}")


USING: combinators formatting generalizations io kernel math
math.extras math.functions.integer-logs math.order math.ranges
sequences strings tools.memory.private ;

: next ( m -- n )
    dup odd? [ dup dup * * ] when integer-sqrt ;

: new-max ( l i h a -- l i h a )
    [ drop dup ] 2dip nip dup ;

: (step) ( l i h a -- l i h a )
    [ 1 + ] 3dip 2dup < [ new-max ] when next ;

: step ( l i h a -- l i h a )
    dup 1 = [ (step) ] unless ;

: juggler ( n quot: ( h -- obj ) -- l i h )
    [ 0 0 ] [ dup [ step ] to-fixed-point drop ] [ call ] tri*
    [ 1 [-] ] dip ; inline

CONSTANT: fmt "%-8s %-8s %-8s %s\n"

: row. ( n quot -- )
    dupd juggler [ commas ] 4 napply fmt printf ; inline

: dashes. ( n -- )
    CHAR: - <string> print ;

: header. ( str -- )
    [ "n" "l[n]" "i[n]" ] dip fmt printf 45 dashes. ;

: juggler. ( seq quot str -- )
    header. [ row. ] curry each ; inline

20 39 [a,b] [ ] "h[n]" juggler. nl

{ 113 173 193 2183 11229 15065 15845 30817 }
[ integer-log10 1 + ] "d[n]" juggler.


package main

import (
    "fmt"
    "log"
    //"math/big"
    big "github.com/ncw/gmp"
    "rcu"
)

var zero = new(big.Int)
var one = big.NewInt(1)
var two = big.NewInt(2)

func juggler(n int64) (int, int, *big.Int, int) {
    if n < 1 {
        log.Fatal("Starting value must be a positive integer.")
    }
    count := 0
    maxCount := 0
    a := big.NewInt(n)
    max := big.NewInt(n)
    tmp := new(big.Int)
    for a.Cmp(one) != 0 {
        if tmp.Rem(a, two).Cmp(zero) == 0 {
            a.Sqrt(a)
        } else {
            tmp.Mul(a, a)
            tmp.Mul(tmp, a)
            a.Sqrt(tmp)
        }
        count++
        if a.Cmp(max) > 0 {
            max.Set(a)
            maxCount = count
        }
    }
    return count, maxCount, max, len(max.String())
}

func main() {
    fmt.Println("n    l[n]  i[n]  h[n]")
    fmt.Println("-----------------------------------")
    for n := int64(20); n < 40; n++ {
        count, maxCount, max, _ := juggler(n)
        cmax := rcu.Commatize(int(max.Int64()))
        fmt.Printf("%2d    %2d   %2d    %s\n", n, count, maxCount, cmax)
    }
    fmt.Println()
    nums := []int64{
        113, 173, 193, 2183, 11229, 15065, 15845, 30817, 48443, 275485, 1267909,
        2264915, 5812827, 7110201, 56261531, 92502777, 172376627, 604398963,
    }
    fmt.Println("       n      l[n]   i[n]   d[n]")
    fmt.Println("-------------------------------------")
    for _, n := range nums {
        count, maxCount, _, digits := juggler(n)
        cn := rcu.Commatize(int(n))
        fmt.Printf("%11s   %3d    %3d    %s\n", cn, count, maxCount, rcu.Commatize(digits))
    }
}


package main

import (
	"image"
	"image/color"
	"image/png"
	"log"
	"os"
	"sync"
)

func main() {
	const (
		width, height = 800.0, 600.0
		maxIter       = 255
		cX, cY        = -0.7, 0.27015
		fileName      = "julia.png"
	)
	img := image.NewNRGBA(image.Rect(0, 0, width, height))

	var wg sync.WaitGroup
	wg.Add(width)
	for x := 0; x < width; x++ {
		thisx := float64(x)
		go func() {
			var tmp, zx, zy float64
			var i uint8
			for y := 0.0; y < height; y++ {
				zx = 1.5 * (thisx - width/2) / (0.5 * width)
				zy = (y - height/2) / (0.5 * height)
				i = maxIter
				for zx*zx+zy*zy < 4.0 && i > 0 {
					tmp = zx*zx - zy*zy + cX
					zy = 2.0*zx*zy + cY
					zx = tmp
					i--
				}
				img.Set(int(thisx), int(y), color.RGBA{i, i, i << 3, 255})
			}
			wg.Done()
		}()
	}
	wg.Wait()
	imgFile, err := os.Create(fileName)
	if err != nil {
		log.Fatal(err)
	}
	defer imgFile.Close()
	if err := png.Encode(imgFile, img); err != nil {
		imgFile.Close()
		log.Fatal(err)
	}
}


import Text.Printf
import Data.List

juggler :: Integer -> [Integer]
juggler = takeWhile (> 1) . iterate (\x -> if odd x
                                           then isqrt (x*x*x)
                                           else isqrt x)

task :: Integer -> IO ()
task n = printf s n (length ns + 1) (i :: Int) (showMax m)
  where
    ns = juggler n
    (m, i) = maximum $ zip ns [0..]
    s = "n = %d length = %d maximal value at = %d (%s)\n"
    showMax n = let s = show n
                in if n > 10^100
                   then show (length s) ++ " digits"
                   else show n

main = do
  mapM_ task [20..39]
  putStrLn "\nTough guys\n"
  mapM_ task [ 113, 173, 193, 2183, 11229, 15065, 15845, 30817 ]


using Formatting

function juggler(k, countdig=true, maxiters=20000)
    m, maxj, maxjpos = BigInt(k), BigInt(k), BigInt(0)
    for i in 1:maxiters
        m = iseven(m) ? isqrt(m) : isqrt(m*m*m)
        if m >= maxj
            maxj, maxjpos  = m, i
        end
        if m == 1
            println(lpad(k, 9), lpad(i, 6), lpad(maxjpos, 6), lpad(format(countdig ?
                ndigits(maxj) : Int(maxj), commas=true), 20), countdig ? " digits" : "")
            return i
        end
    end
    error("Juggler series starting with $k did not converge in $maxiters iterations")
end

println("       n    l(n)  i(n)       h(n) or d(n)\n------------------------------------------")
foreach(k -> juggler(k, false), 20:39)
@time foreach(juggler,
    [113, 173, 193, 2183, 11229, 15065, 15845, 30817, 48443, 275485, 1267909,
     2264915, 5812827])
@time juggler(7110201)


next[n_Integer] := If[[email protected], Floor[Sqrt[n]], Floor[n^(3/2)]]

stats[n_Integer] :=

 Block[{data = [email protected][next, n, # > 1 &], mx},
  mx = [email protected][data, -1];
  {n, Length[data], data[[mx]], mx - 1}]

{TableForm[Table[[email protected], {n, 20, 39}],
 TableHeadings -> {None, {"n", "length", "max", "max pos"}}]


import System.Environment (getArgs)

plotChar :: Int -> Float -> Float -> Float -> Float -> Char
plotChar iter cReal cImag y x
  | zReal^2 > 10000 = ' '
  | iter == 1       = '#'
  | otherwise       = plotChar (pred iter) cReal cImag zImag zReal
 where
  zReal = x * x - y * y + cReal
  zImag = x * y * 2 + cImag

parseArgs :: [String] -> (Float, Float)
parseArgs []             = (-0.8, 0.156)
parseArgs [cReal, cImag] = (read cReal :: Float, read cImag :: Float)
parseArgs _              = error "Invalid arguments"

main :: IO ()
main = do
  args <- getArgs
  let (cReal, cImag) = parseArgs args
  print (cReal, cImag)
  mapM_ putStrLn $ [-100,-96..100] >>= \y ->
    [[-280,-276..280] >>= \x -> [plotChar 50 cReal cImag (y/100) (x/200)]]


import math, strformat

func juggler(n: Positive): tuple[count: int; max: uint64; maxIdx: int] =
  var a = n.uint64
  result = (0, a, 0)
  while a != 1:
    let f = float(a)
    a = if (a and 1) == 0: sqrt(f).uint64
        else: uint64(f * sqrt(f))
    inc result.count
    if a > result.max:
      result.max = a
      result.maxIdx = result.count

echo "n   l[n]            h[n]  i[n]"
echo "——————————————————————————————"
for n in 20..39:
  let (l, h, i) = juggler(n)
  echo &"{n}   {l:2}  {h:14}     {i}"


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Juggler_sequence
use warnings;
use Math::BigInt lib => 'GMP';

print "       n  l(n) i(n)  h(n) or d(n)\n";
print " -------  ---- ----  ------------\n";
for my $i ( 20 .. 39,
  113, 173, 193, 2183, 11229, 15065, 15845, 30817,
  48443, 275485, 1267909, 2264915, 5812827,
  7110201  # tried my luck, luck takes about 94 seconds
  )
  {
  my $max = my $n = Math::BigInt->new($i);
  my $at = my $count = 0;
  while( $n > 1 )
    {
    $n = sqrt( $n & 1 ? $n ** 3 : $n );
    $count++;
    $n > $max and ($max, $at) = ($n, $count);
    }

  if( length $max < 27 )
    {
    printf "%8d  %4d  %3d  %s\n", $i, $count, $at, $max;
    }
  else
    {
    printf "%8d  %4d  %3d  d(n) = %d digits\n", $i, $count, $at, length $max;
    }
  }


with javascript_semantics
include mpfr.e

function juggler(integer n, bool bDigits=false)
    atom t0 = time(), t1 = time()+1
    assert(n>=1)
    mpz a = mpz_init(n),
        h = mpz_init(n)
    integer l = 0,
            hi = 0
    while mpz_cmp_si(a,1)!=0 do
        if mpz_odd(a) then
            mpz_pow_ui(a,a,3)
        end if
        mpz_sqrt(a,a)
        l += 1
        if mpz_cmp(a,h)>0 then
            mpz_set(h,a)
            hi = l
        end if
        if platform()!=JS and time()>t1 then
            progress("working (l=%d)\r",{l})
            t1 = time()+1
        end if
    end while
    atom hd = iff(bDigits?mpz_sizeinbase(h,10):mpz_get_atom(h))
    t0 = time()-t0
    string t = iff(t0>=1?" ("&elapsed(t0)&")":"")
    return {n, l, hd, hi, t}
end function

procedure main()
    atom t0 = time()
    printf(1," n  l[n]                 h[n]  i[n]\n")
    printf(1,"-----------------------------------\n")
    for n=20 to 39 do
        printf(1,"%2d    %2d   %,18d    %2d %s\n", juggler(n))
    end for
    sequence nums = {113, 173, 193, 2183, 11229, 15065, 15845, 30817}
                    -- alas mpz_sqrt() throws a wobbly over the rest:
--                   48443, 275485, 1267909, 2264915, 5812827, 7110201}
    printf(1,"\n        n  l[n]    d[n]  i[n]\n")
    printf(1,"-----------------------------\n")
    --  ... and pwa/p2js(/mpfr.js) only copes with the first 3
    for i=1 to iff(platform()=JS?3:length(nums)) do
        printf(1,"%9d   %3d  %,6d    %2d %s\n", juggler(nums[i],true))
    end for
    ?elapsed(time()-t0)
end procedure
main()


import javax.swing.*;
import java.awt.*;
import java.awt.image.BufferedImage;

public class JuliaSet extends JPanel {
    private static final int MAX_ITERATIONS = 300;
    private static final double ZOOM = 1;
    private static final double CX = -0.7;
    private static final double CY = 0.27015;
    private static final double MOVE_X = 0;
    private static final double MOVE_Y = 0;

    public JuliaSet() {
        setPreferredSize(new Dimension(800, 600));
        setBackground(Color.white);
    }

    void drawJuliaSet(Graphics2D g) {
        int w = getWidth();
        int h = getHeight();
        BufferedImage image = new BufferedImage(w, h, BufferedImage.TYPE_INT_RGB);

        for (int x = 0; x < w; x++) {
            for (int y = 0; y < h; y++) {
                double zx = 1.5 * (x - w / 2) / (0.5 * ZOOM * w) + MOVE_X;
                double zy = (y - h / 2) / (0.5 * ZOOM * h) + MOVE_Y;
                float i = MAX_ITERATIONS;
                while (zx * zx + zy * zy < 4 && i > 0) {
                    double tmp = zx * zx - zy * zy + CX;
                    zy = 2.0 * zx * zy + CY;
                    zx = tmp;
                    i--;
                }
                int c = Color.HSBtoRGB((MAX_ITERATIONS / i) % 1, 1, i > 0 ? 1 : 0);
                image.setRGB(x, y, c);
            }
        }
        g.drawImage(image, 0, 0, null);
    }

    @Override
    public void paintComponent(Graphics gg) {
        super.paintComponent(gg);
        Graphics2D g = (Graphics2D) gg;
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                RenderingHints.VALUE_ANTIALIAS_ON);
        drawJuliaSet(g);
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("Julia Set");
            f.setResizable(false);
            f.add(new JuliaSet(), BorderLayout.CENTER);
            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}


from math import isqrt

def juggler(k, countdig=True, maxiters=1000):
    m, maxj, maxjpos = k, k, 0
    for i in range(1, maxiters):
        m = isqrt(m) if m % 2 == 0 else isqrt(m * m * m)
        if m >= maxj:
            maxj, maxjpos  = m, i
        if m == 1:
            print(f"{k: 9}{i: 6,}{maxjpos: 6}{len(str(maxj)) if countdig else maxj: 20,}{' digits' if countdig else ''}")
            return i

    print("ERROR: Juggler series starting with $k did not converge in $maxiters iterations")

print("       n    l(n)  i(n)       h(n) or d(n)\n-------------------------------------------")
for k in range(20, 40):
    juggler(k, False)

for k in [113, 173, 193, 2183, 11229, 15065, 15845, 30817, 48443, 275485, 1267909]:
    juggler(k)


  [ dip number$
    over size -
    space swap of
    swap join echo$ ]          is recho   ( n n -->   )

  [ 1 & ]                      is odd     (   n --> b )

  [ dup dup * * ]              is cubed   (   n --> n )

  [ dup 1
    [ 2dup > while
      + 1 >>
      2dup / again ]
    drop nip ]                 is sqrt    (   n --> n )

  [ nested
    [ dup -1 peek 1 != while
      dup -1 peek
      dup odd if cubed
      sqrt join again ] ]      is juggler (   n --> [ )

  [ dup 4 recho
    juggler
    dup size 1 -
    3 recho
    0 swap behead swap
    witheach
      [ 2dup < if
          [ rot drop
            i^ 1+ unrot
            swap ]
        drop ]
    15 recho 2 recho cr ]     is stats   (   n -->   )

  20 times [ i^ 20 + stats ]


use Lingua::EN::Numbers;
sub juggler (Int $n where * > 0) { $n, { $_ +& 1 ?? .³.&isqrt !! .&isqrt } … 1 }

sub isqrt ( \x ) { my ( $X, $q, $r, $t ) =  x, 1, 0 ;
    $q +<= 2 while $q ≤ $X ;
    while $q > 1 {
        $q +>= 2; $t = $X - $r - $q; $r +>= 1;
        if $t ≥ 0 { $X = $t; $r += $q }
    }
    $r
}

say " n  l[n]  i[n]   h[n]";
for 20..39 {
    my @j = .&juggler;
    my $max = @j.max;
    printf "%2s %4d  %4d    %s\n", .&comma, +@j-1, @j.first(* == $max, :k), comma $max;
}

say "\n      n     l[n]   i[n]    d[n]";
( 113, 173, 193, 2183, 11229, 15065, 15845, 30817 ).hyper(:1batch).map: {
    my $start = now;
    my @j = .&juggler;
    my $max = @j.max;
    printf "%10s %4d   %4d %10s   %6.2f seconds\n", .&comma, +@j-1, @j.first(* == $max, :k),
      $max.chars.&comma, (now - $start);
}


var maxIterations = 450, minX = -.5, maxX = .5,
    minY = -.5, maxY = .5, wid, hei, ctx,
    jsX = 0.285, jsY = 0.01;

function remap( x, t1, t2, s1, s2 ) {
    var f = ( x - t1 ) / ( t2 - t1 ),
        g = f * ( s2 - s1 ) + s1;
    return g;
}
function getColor( c ) {
    var r, g, b, p = c / 32,
        l = ~~( p * 6 ), o = p * 6 - l,
        q = 1 - o;

    switch( l % 6 ) {
        case 0: r = 1; g = o; b = 0; break;
        case 1: r = q; g = 1; b = 0; break;
        case 2: r = 0; g = 1; b = o; break;
        case 3: r = 0; g = q; b = 1; break;
        case 4: r = o; g = 0; b = 1; break;
        case 5: r = 1; g = 0; b = q; break;
    }
    var c = "#" + ( "00" + ( ~~( r * 255 ) ).toString( 16 ) ).slice( -2 ) +
                  ( "00" + ( ~~( g * 255 ) ).toString( 16 ) ).slice( -2 ) +
                  ( "00" + ( ~~( b * 255 ) ).toString( 16 ) ).slice( -2 );
    return (c);
}
function drawFractal() {
    var a, as, za, b, bs, zb, cnt, clr
    for( var j = 0; j < hei; j++ ) {
        for( var i = 0; i < wid; i++ ) {
            a = remap( i, 0, wid, minX, maxX )
            b = remap( j, 0, hei, minY, maxY )
            cnt = 0;
            while( ++cnt < maxIterations ) {
                za = a * a; zb = b * b;
                if( za + zb > 4 ) break;
                as = za - zb; bs = 2 * a * b;
                a = as + jsX; b = bs + jsY;
            }
            if( cnt < maxIterations ) {
                ctx.fillStyle = getColor( cnt );
            }
            ctx.fillRect( i, j, 1, 1 );
        }
    }
}
function init() {
    var canvas = document.createElement( "canvas" );
    wid = hei = 800;
    canvas.width = wid; canvas.height = hei;
    ctx = canvas.getContext( "2d" );
    ctx.fillStyle = "black"; ctx.fillRect( 0, 0, wid, hei );
    document.body.appendChild( canvas );
    drawFractal();
}


/*REXX program  calculates and displays  the  juggler sequence  for any positive integer*/
numeric digits 20                                /*define the number of decimal digits. */
parse arg LO HI list                             /*obtain optional arguments from the CL*/
if LO='' | LO=","  then do; LO= 20; HI= 39; end  /*Not specified?  Then use the default.*/
if HI='' | HI=","  then HI= LO                   /* "      "         "   "   "     "    */
w= length( commas(HI) )                          /*find the max width of any number  N. */
d= digits();     dd= d + d%3 + 1                 /*get # numeric digits; another version*/
if LO>0  then say c('n',w)    c("steps",7)    c('maxIndex',8)   c("biggest term"    ,dd)
if LO>0  then say c('' ,w,.)  c(""     ,7,.)  c(''        ,8,.) c(""                ,dd,.)

    do n=LO  to HI while n>0; steps= juggler(n)  /*invoke JUGGLER: find the juggler num.*/
    nc= commas(n)                                /*maybe add commas to  N.              */
    say right(nc, w)      c(steps, 8)     c(imx, 8)      right( commas(mx), dd-1)
    end   /*n*/
                                                 /*biggest term isn't shown for list #s.*/
xtra= words(list)                                /*determine how many numbers in list.  */
if xtra==0  then exit 0                          /*no special ginormous juggler numbers?*/
w= max(9, length( commas( word(list, xtra) ) ) ) /*find the max width of any list number*/
say;             say;             say
say c('n',w)     c("steps",7)     c('maxIndex',8)     c("max number of digits",dd)
say c('' ,w,.)   c(""     ,7,.)   c(''        ,8,.)   c(""                    ,dd,.)

         do p=1  for xtra;     n= word(list, p)  /*process each of the numbers in list. */
         steps= juggler(n);    nc= commas(n)     /*get a number & pass it on to JUGGLER.*/
         say right(nc, w)   c(steps, 8)   c(imx, 8)      right( commas(length(mx)), dd-1)
         end   /*p*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
c:      parse arg c1,c2,c3; if c3==''  then c3= ' '; else c3= '─'; return center(c1,c2,c3)
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
Isqrt:  procedure; parse arg x;  q= 1;  r= 0     /*obtain X;  R  will be the Isqrt(X).  */
           do until q>x;  q= q * 4               /*multiply   Q   by four until > X.    */
           end   /*until*/
               do while q>1;  q= q % 4           /*processing while Q>1;  quarter Q.    */
               t= x - r - q;  r= r % 2           /*set T ──► X-R-Q;       halve R.      */
               if t>=0  then do; x= t; r= r + q  /*T≥0?  Then set X ──► T;  add Q ──► R.*/
                             end
               end   /*while*/;    return r      /*return the integer square root of  X.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
juggler: parse arg #;  imx= 0;  mx= #            /*get N;  set index of MX and MX ──► 0.*/
         @.=0; @.1=1; @.3=1; @.5=1; @.7=1; @.9=1 /*set semaphores (≡1) for odd dec. digs*/
           do j=1  until z==1                    /*here is where we begin to juggle.    */
           parse var  #  ''  -1  _               /*obtain the last decimal digit of  #. */
           if @._  then do;       cube= #*#*#    /*Odd? Then compute integer sqrt(#**3).*/
                        if pos(., cube)>0  then do    /*need to increase decimal digits.*/
                                                parse var  cube    with    'E'  x
                                                if x>=digits()  then numeric digits x+2
                                                end
                        z= Isqrt(#*#*#)          /*compute the integer sqrt(#**3)       */
                        end
                   else z= Isqrt(#)              /*Even? Then compute integer sqrt(#).  */
           L= length(z)
           if L>=d  then numeric digits L+1      /*reduce the number of numeric digits. */
           if z>mx  then do;  mx= z; imx= j; end /*found a new max;  set MX;  set IMX.  */
           #= z
           end   /*j*/;                 return j


function iter(z,c)
  n = 0
  while (abs2(z)<4)  z = z^2+c ; n+=1 end
  return n
end

coord(i,j,w,h,a,b) = 2*a*(i-1)/(w-1) - a + im * (2*b*(j-1)/(h-1) - b)

palette(n) = string(min(3n,255)," ", min(n,255)," ", 0);

julia(c) = (w,h,a,b,i,j) -> palette(iter(coord(i,j,w,h,a,b), c))

writeppm(f; width=600,height=300,a=2,b=1,file="julia.ppm") =
  open(file, "w") do out
    write(out, string("P3\n", width, " ", height, "\n255\n"))
    writedlm(out, [f(width,height,a,b,i,j) for j = 1:height, i = 1:width], '\n')
  end


import java.awt.*
import java.awt.image.BufferedImage
import javax.swing.JFrame
import javax.swing.JPanel

class JuliaPanel : JPanel() {
    init {
        preferredSize = Dimension(800, 600)
        background = Color.white
    }

    private val maxIterations = 300
    private val zoom = 1
    private val moveX = 0.0
    private val moveY = 0.0
    private val cX = -0.7
    private val cY = 0.27015

    public override fun paintComponent(graphics: Graphics) {
        super.paintComponent(graphics)
        with(graphics as Graphics2D) {
            setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
            val image = BufferedImage(width, height, BufferedImage.TYPE_INT_RGB)
            (0 until width).forEach { x ->
                (0 until height).forEach { y ->
                    var zx = 1.5 * (x - width / 2) / (0.5 * zoom * width) + moveX
                    var zy = (y - height / 2) / (0.5 * zoom * height) + moveY
                    var i = maxIterations.toFloat()
                    while (zx * zx + zy * zy < 4 && i > 0) {
                        val tmp = zx * zx - zy * zy + cX
                        zy = 2.0 * zx * zy + cY
                        zx = tmp
                        i--
                    }
                    image.setRGB(x, y, Color.HSBtoRGB(maxIterations / i % 1, 1f, (if (i > 0) 1 else 0).toFloat()))
                }
            }
            drawImage(image, 0, 0, null)
        }
    }
}

fun main() {
    with(JFrame()) {
        defaultCloseOperation = JFrame.EXIT_ON_CLOSE
        title = "Julia Set"
        isResizable = false
        add(JuliaPanel(), BorderLayout.CENTER)
        pack()
        setLocationRelativeTo(null)
        isVisible = true
    }
}


import "/fmt" for Fmt
import "/big" for BigInt

var one  = BigInt.one

var juggler = Fn.new { |n|
    if (n < 1) Fiber.abort("Starting value must be a positive integer.")
    var a = BigInt.new(n)
    var count = 0
    var maxCount = 0
    var max = a.copy()
    while (a != one) {
        if (a.isEven) {
            a = a.isqrt
        } else {
            a = (a.square * a).isqrt
        }
        count = count + 1
        if (a > max) {
            max = a
            maxCount = count
        }
    }
    return [count, maxCount, max, max.toString.count]
}

System.print("n    l[n]  i[n]  h[n]")
System.print("-----------------------------------")
for (n in 20..39) {
    var res = juggler.call(n)
    Fmt.print("$2d    $2d   $2d    $,i", n, res[0], res[1], res[2])
}
System.print()
var nums = [113, 173, 193, 2183, 11229, 15065, 15845, 30817]
System.print("   n     l[n]   i[n]   d[n]")
System.print("----------------------------")
for (n in nums) {
    var res = juggler.call(n)
    Fmt.print("$,6d   $3d    $3d   $,6i", n, res[0], res[1], res[3])
}


JuliaSetPoints[-0.77 + 0.22 I, "ClosenessTolerance" -> 0.01]


import lenientops
import imageman

const
  W = 800
  H = 600
  Zoom = 1
  MaxIter = 255
  MoveX = 0
  MoveY = 0
  Cx = -0.7
  Cy = 0.27015

var colors: array[256, ColorRGBU]
for n in byte.low..byte.high:
  colors[n] = ColorRGBU [n shr 5 * 36, (n shr 3 and 7) * 36, (n and 3) * 85]

var image = initImage[ColorRGBU](W, H)

for x in 0..<W:
  for y in 0..<H:
    var zx = 1.5 * (x - W / 2) / (0.5 * Zoom * W) + MoveX
    var zy = 1.0 * (y - H / 2) / (0.5 * Zoom * H) + MoveY
    var i = MaxIter
    while zx * zx + zy * zy < 4 and i > 1:
      (zy, zx) = (2.0 * zx * zy + Cy, zx * zx - zy * zy + Cx)
      dec i
    image[x, y] = colors[i]

# Save into a PNG file.
image.savePNG("julia.png", compression = 9)


--
-- demo\rosetta\Julia_set.exw
-- ==========================
--
-- Interactive gui (zoom/pan incomplete).
--
--with javascript_semantics -- not quite yet:
without js    -- [DEV] IupValuator, IupImageRGB
include pGUI.e

constant title = "Julia set"
Ihandle dlg, cxv, cxl, cyv, cyl, ispin, pspin, clrzn, label, bb, redraw

atom cX = -0.7,
     cY = -0.353777
integer iter = 255,
        pwr = 2,
        zoom = 1,       -- (not yet used/to do)
        moveX = 0,      -- drag?? (to do)
        moveY = 0

constant clrzns = {{8,32,16},
                   {2,4,8},
                   {1,1,8}}

sequence colourisation = clrzns[1]

function julia(integer width, integer height)
    atom tpt25 = time()+0.25
    sequence img = repeat(repeat(0,width),height)
    for x=1 to width do
        for y=1 to height do
            atom zx := 1.5*((x-1)-width/2)/(0.5*zoom*width)+moveX,
                 zy := 1.0*((y-1)-height/2)/(0.5*zoom*height)+moveY;
            integer i := iter;
            while ((zx*zx+zy*zy)<4) and (i>1) do
                atom pn = power(zx*zx+zy*zy,pwr/2),
                     pa = pwr*atan2(zy, zx)
                zx = pn*cos(pa)+cX
                zy = pn*sin(pa)+cY
                i -= 1;
            end while
--          img[y,x] = {i*2,i*4,i*8}        -- (experiment thusly)
            img[y,x] = sq_mul(i,colourisation)
        end for
        if time()>tpt25 then
            IupSetStrAttribute(dlg, "TITLE", "%s (generating - %3.2f%%)",{title,x/width*100})
            IupFlush()
            tpt25 = time()+0.25
        end if
    end for
    img = flatten(img)
    Ihandle new_img = IupImageRGB(width, height, img)
    return new_img
end function

function redraw_cb(Ihandln /*redraw*/)
    Ihandln image = IupGetAttributeHandle(label, "IMAGE")
    IupSetAttributeHandle(label, "IMAGE", NULL)
    image = IupDestroy(image)
    IupSetAttribute(redraw,"ACTIVE","NO")
    IupRefreshChildren(bb)
    integer {w,h} = IupGetIntInt(bb, "RASTERSIZE")
    image = julia(w,h)
    IupSetAttribute(redraw,"ACTIVE","YES")
    IupUnmap(label)
    IupSetAttribute(label,"RASTERSIZE",NULL)
    IupSetAttributeHandle(label, "IMAGE", image)
    IupMap(label)
    IupRefresh(label)
    IupSetStrAttribute(dlg, "TITLE", title)
    return IUP_DEFAULT
end function
constant cb_redraw = Icallback("redraw_cb")

function valuechanged_cb(Ihandle ih)
    atom a = IupGetFloat(ih, "VALUE")
    switch ih do
        case cxv:   cX = a  IupSetStrAttribute(cxl,"TITLE","cY: %f",{cX})
        case cyv:   cY = a  IupSetStrAttribute(cyl,"TITLE","cY: %f",{cY})
        case ispin: iter = a
        case pspin: pwr = a
        case clrzn: colourisation = clrzns[a]
    end switch
    return IUP_DEFAULT
end function
constant cb_valuechanged = Icallback("valuechanged_cb")

procedure create_dlg()

    Ihandle lx1 = IupLabel("+")
            cxl = IupLabel(sprintf("cX: %f",cX))
    Ihandle lx2 = IupLabel("-"),
            hx1 = IupHbox({lx1, IupFill(), cxl, IupFill(), lx2})
            cxv = IupValuator(NULL,"MIN=-2.5, MAX=+1")
    Ihandle bxv = IupVbox({hx1, cxv})

    Ihandle ly1 = IupLabel("+")
            cyl = IupLabel(sprintf("cY: %f",cY))
    Ihandle ly2 = IupLabel("-"),
            hx2 = IupHbox({ly1, IupFill(), cyl, IupFill(), ly2})
            cyv = IupValuator(NULL,"MIN=-1, MAX=+1")
    Ihandle byv = IupVbox({hx2, cyv})

    IupSetCallback(cxv, "VALUECHANGED_CB", cb_valuechanged)
    IupSetCallback(cyv, "VALUECHANGED_CB", cb_valuechanged)
    IupSetFloat(cxv, "VALUE", cX)
    IupSetFloat(cyv, "VALUE", cY)

    Ihandle ilbl = IupLabel("iter'ns:","PADDING=0x3")
            ispin = IupText("VALUECHANGED_CB", cb_valuechanged,
                            "SPIN=Yes, SPINMIN=1, SPINMAX=500, RASTERSIZE=48x")
    IupSetInt(ispin,"VALUE",iter)
    Ihandle ibox = IupHbox({IupFill(),ilbl,ispin,IupFill()})

    Ihandle plbl = IupLabel("power:","PADDING=0x3")
            pspin = IupText("VALUECHANGED_CB", cb_valuechanged,
                            "SPIN=Yes, SPINMIN=2, SPINMAX=6, RASTERSIZE=48x")
    IupSetInt(pspin,"VALUE",pwr)
    Ihandle pbox = IupHbox({IupFill(),plbl,pspin,IupFill()})

    Ihandle clbl = IupLabel("colourization:","PADDING=0x3")
    clrzn = IupList("DROPDOWN=YES")
    for i=1 to length(clrzns) do
        IupSetStrAttributeId(clrzn,"",i,sprint(clrzns[i]))
    end for
    IupSetInt(clrzn,"VISIBLEITEMS",length(clrzns)+1)
    IupSetInt(clrzn,"VALUE",1)
    IupSetCallback(clrzn, "VALUECHANGED_CB", cb_valuechanged)
    Ihandle cbox = IupHbox({IupFill(),IupVbox({clbl,clrzn}),IupFill()})

    redraw = IupButton("redraw",cb_redraw)
    Ihandle rbox = IupHbox({IupFill(),redraw,IupFill()},"EXPAND=YES, MARGIN=10x20")

    Ihandle params = IupVbox({bxv,byv,ibox,pbox,cbox,rbox},
                              "GAP=5, EXPAND=NO, EXPANDCHILDREN=YES, MARGIN=3x3")

    label = IupLabel("please wait...","ALIGNMENT=ACENTER:ACENTER, RASTERSIZE=800x600")
    bb = IupBackgroundBox(IupHbox({IupVbox({label,IupFill()}),IupFill()}),"EXPAND=YES, SHRINK=YES")

    dlg = IupDialog(IupHbox({params,bb}))
    IupSetAttribute(dlg, "TITLE", title)
end procedure

procedure main()
    IupOpen()
    create_dlg()
    IupShow(dlg)
    {} = redraw_cb(NULL)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()