on isPrime(n)
    if (n < 4) then return (n > 1)
    if ((n mod 2 is 0) or (n mod 3 is 0)) then return false
    repeat with i from 5 to (n ^ 0.5) div 1 by 6
        if ((n mod i is 0) or (n mod (i + 2) is 0)) then return false
    end repeat

    return true
end isPrime

on isPernicious(n)
    -- 8 bits at a time is statistically slightly more efficient than 1 bit at a time.
    set popCount to (n mod 4 + 1) div 2 + (n mod 16 + 4) div 8
    set n to n div 16
    repeat until (n = 0)
        set popCount to popCount + (n mod 4 + 1) div 2 + (n mod 16 + 4) div 8
        set n to n div 16
    end repeat

    return isPrime(popCount)
end isPernicious

-- Task code:
on intToText(n)
    set output to ""
    repeat until (n < 100000000)
        set output to text 2 thru 9 of ((100000000 + (n mod 100000000 as integer)) as text) & output
        set n to n div 100000000
    end repeat
    set output to (n as integer as text) & output

    return output
end intToText

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

    return output
end join

on task()
    set l1 to {}
    set n to 0
    set counter to 0
    repeat until (counter = 25)
        if (isPernicious(n)) then
            set end of l1 to n
            set counter to counter + 1
        end if
        set n to n + 1
    end repeat

    set l2 to {}
    -- One solution to 8,888,877 and up being too large to be AppleScript repeat indices.
    repeat with i from 88888877 to 88888888
        set n to 8.0E+8 + i
        if (isPernicious(n)) then set end of l2 to intToText(n)
    end repeat

    return join(l1, "  ") & (linefeed & join(l2, "  "))
end task

task()


pernicious?: function [n][
    prime? size filter split as.binary n 'x -> x="0"
]

i: 1
found: 0
while [found<25][
    if pernicious? i [
        prints i
        prints " "
        found: found + 1
    ]
    i: i + 1
]
print ""
print select 888888877..888888888 => pernicious?


# syntax: GAWK -f PERNICIOUS_NUMBERS.AWK
BEGIN {
    pernicious(25)
    pernicious(888888877,888888888)
    exit(0)
}
function pernicious(x,y,  count,n) {
    if (y == "") { # print first X pernicious numbers
      while (count < x) {
        if (is_prime(pop_count(++n)) == 1) {
          printf("%d ",n)
          count++
        }
      }
    }
    else { # print pernicious numbers in X-Y range
      for (n=x; n<=y; n++) {
        if (is_prime(pop_count(n)) == 1) {
          printf("%d ",n)
        }
      }
    }
    print("")
}
function dec2bin(n,  str) {
    while (n) {
      if (n%2 == 0) {
        str = "0" str
      }
      else {
        str = "1" str
      }
      n = int(n/2)
    }
    if (str == "") {
      str = "0"
    }
    return(str)
}
function is_prime(x,  i) {
    if (x <= 1) {
      return(0)
    }
    for (i=2; i<=int(sqrt(x)); i++) {
      if (x % i == 0) {
        return(0)
      }
    }
    return(1)
}
function pop_count(n) {
    n = dec2bin(n)
    return gsub(/1/,"&",n)
}


#include <stdio.h>

typedef unsigned uint;
uint is_pern(uint n)
{
        uint c = 2693408940u; // int with all prime-th bits set
        while (n) c >>= 1, n &= (n - 1); // take out lowerest set bit one by one
        return c & 1;
}

int main(void)
{
        uint i, c;
        for (i = c = 0; c < 25; i++)
                if (is_pern(i))
                        printf("%u ", i), ++c;
        putchar('\n');

        for (i = 888888877u; i <= 888888888u; i++)
                if (is_pern(i))
                        printf("%u ", i);
        putchar('\n');

        return 0;
}


using System;
using System.Linq;

namespace PerniciousNumbers
{
    class Program
    {
        public static int PopulationCount(long n)
        {
            int cnt = 0;
            do
            {
                if ((n & 1) != 0)
                {
                    cnt++;
                }
            } while ((n >>= 1) > 0);

            return cnt;
        }

         public static bool isPrime(int x)
        {
            if (x <= 2 || (x & 1) == 0)
            {
                return x == 2;
            }

            var limit = Math.Sqrt(x);
            for (int i = 3; i <= limit; i += 2)
            {
                if (x % i == 0)
                {
                    return false;
                }
            }

            return true;
        }

        private static IEnumerable<int> Pernicious(int start, int count, int take)
        {
            return Enumerable.Range(start, count).Where(n => isPrime(PopulationCount(n))).Take(take);
        }

        static void Main(string[] args)
        {
            foreach (var n in Pernicious(0, int.MaxValue, 25))
            {
                Console.Write("{0} ", n);
            }

            Console.WriteLine();

            foreach (var n in Pernicious(888888877, 11, 11))
            {
                Console.Write("{0} ", n);
            }

            Console.ReadKey();
        }
    }
}


#include <iostream>
using namespace std;

int main() {
    int cnt = 0, cnt2, cnt3, tmp, binary[8];
    for (int i = 3; cnt < 25; i++) {
        tmp = i;
        cnt2 = 0;
        cnt3 = 0;
        for (int j = 7; j > 0; j--) {
            binary[j] = tmp % 2;
            tmp /= 2;
        }
        binary[0] = tmp;
        for (int j = 0; j < 8; j++) {
            if (binary[j] == 1) {
                cnt2++;
            }
        }
        for (int j = 2; j <= (cnt2 / 2); j++) {
            if (cnt2 % j == 0) {
                cnt3++;
                break;
            }
        }
        if (cnt3 == 0 && cnt2 != 1) {
            cout << i << endl;
            cnt++;
        }
    }

    cout << endl;
    int binary2[31];

    for (int i = 888888877; i <= 888888888; i++) {
        tmp = i;
        cnt2 = 0;
        cnt3 = 0;
        for (int j = 30; j > 0; j--) {
            binary2[j] = tmp % 2;
            tmp /= 2;
        }
        binary2[0] = tmp;
        for (int j = 0; j < 31; j++) {
            if (binary2[j] == 1) {
                cnt2++;
            }
        }
        for (int j = 2; j <= (cnt2 / 2); j++) {
            if (cnt2 % j == 0) {
                cnt3++;
                break;
            }
        }
        if (cnt3 == 0 && cnt2 != 1) {
            cout << i << endl;
        }
    }
}


(defn counting-numbers
 ([] (counting-numbers 1))
 ([n] (lazy-seq (cons n (counting-numbers (inc n))))))
(defn divisors [n] (filter #(zero? (mod n %)) (range 1 (inc n))))
(defn prime? [n] (= (divisors n) (list 1 n)))
(defn pernicious? [n]
  (prime? (count (filter #(= % \1) (Integer/toString n 2)))))
(println (take 25 (filter pernicious? (counting-numbers))))
(println (filter pernicious? (range 888888877  888888889)))


% The population count of an integer is never going to be
% higher than the amount of bits in it (max 64)
% so we can get away with a very simple primality test.
is_prime = proc (n: int) returns (bool)
    if n<=2 then return(n=2) end
    if n//2=0 then return(false) end
    for i: int in int$from_to_by(n+2, n/2, 2) do
        if n//i=0 then return(false) end
    end
    return(true)
end is_prime

% Find the population count of a number
pop_count = proc (n: int) returns (int)
    c: int := 0
    while n > 0 do
        c := c + n // 2
        n := n / 2
    end
    return(c)
end pop_count

% Is N pernicious?
pernicious = proc (n: int) returns (bool)
    return(is_prime(pop_count(n)))
end pernicious

start_up = proc ()
    po: stream := stream$primary_output()

    stream$putl(po, "First 25 pernicious numbers: ")
    n: int := 1
    seen: int := 0
    while seen<25 do
        if pernicious(n) then
            stream$puts(po, int$unparse(n) || " ")
            seen := seen + 1
        end
        n := n + 1
    end

    stream$putl(po, "\nPernicious numbers between 888,888,877 and 888,888,888:")
    for i: int in int$from_to(888888877,888888888) do
        if pernicious(i) then
            stream$puts(po, int$unparse(i) || " ")
        end
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. PERNICIOUS-NUMBERS.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 VARIABLES.
          03 AMOUNT             PIC 99.
          03 CAND               PIC 9(9).
          03 POPCOUNT           PIC 99.
          03 POP-N              PIC 9(9).
          03 FILLER             REDEFINES POP-N.
             05 FILLER          PIC 9(8).
             05 FILLER          PIC 9.
                88 ODD          VALUES 1, 3, 5, 7, 9.
          03 DSOR               PIC 99.
          03 DIV-RSLT           PIC 99V99.
          03 FILLER             REDEFINES DIV-RSLT.
             05 FILLER          PIC 99.
             05 FILLER          PIC 99.
                88 DIVISIBLE    VALUE ZERO.
          03 PRIME-FLAG         PIC X.
             88 PRIME           VALUE '*'.

       01 FORMAT.
          03 SIZE-FLAG          PIC X.
             88 SMALL           VALUE 'S'.
             88 LARGE           VALUE 'L'.
          03 SMALL-NUM          PIC ZZ9.
          03 LARGE-NUM          PIC Z(9)9.
          03 OUT-STR            PIC X(80).
          03 OUT-PTR            PIC 99.

       PROCEDURE DIVISION.
       BEGIN.
           PERFORM SMALL-PERNICIOUS.
           PERFORM LARGE-PERNICIOUS.
           STOP RUN.

       INIT-OUTPUT-VARS.
           MOVE ZERO TO AMOUNT.
           MOVE 1 TO OUT-PTR.
           MOVE SPACES TO OUT-STR.

       SMALL-PERNICIOUS.
           PERFORM INIT-OUTPUT-VARS.
           MOVE 'S' TO SIZE-FLAG.
           PERFORM ADD-PERNICIOUS
               VARYING CAND FROM 1 BY 1 UNTIL AMOUNT IS EQUAL TO 25.
           DISPLAY OUT-STR.

       LARGE-PERNICIOUS.
           PERFORM INIT-OUTPUT-VARS.
           MOVE 'L' TO SIZE-FLAG.
           PERFORM ADD-PERNICIOUS
               VARYING CAND FROM 888888877 BY 1
               UNTIL CAND IS GREATER THAN 888888888.
           DISPLAY OUT-STR.

       ADD-NUM.
           ADD 1 TO AMOUNT.
           IF SMALL,
               MOVE CAND TO SMALL-NUM,
               STRING SMALL-NUM DELIMITED BY SIZE INTO OUT-STR
               WITH POINTER OUT-PTR.
           IF LARGE,
               MOVE CAND TO LARGE-NUM,
               STRING LARGE-NUM DELIMITED BY SIZE INTO OUT-STR
               WITH POINTER OUT-PTR.

       ADD-PERNICIOUS.
           PERFORM FIND-POPCOUNT.
           PERFORM CHECK-PRIME.
           IF PRIME, PERFORM ADD-NUM.

       FIND-POPCOUNT.
           MOVE ZERO TO POPCOUNT.
           MOVE CAND TO POP-N.
           PERFORM COUNT-BIT UNTIL POP-N IS EQUAL TO ZERO.

       COUNT-BIT.
           IF ODD, ADD 1 TO POPCOUNT.
           DIVIDE 2 INTO POP-N.

       CHECK-PRIME.
           IF POPCOUNT IS LESS THAN 2,
               MOVE SPACE TO PRIME-FLAG
           ELSE
               MOVE '*' TO PRIME-FLAG.
           PERFORM CHECK-DSOR VARYING DSOR FROM 2 BY 1
               UNTIL NOT PRIME OR DSOR IS NOT LESS THAN POPCOUNT.

       CHECK-DSOR.
           DIVIDE POPCOUNT BY DSOR GIVING DIV-RSLT.
           IF DIVISIBLE, MOVE SPACE TO PRIME-FLAG.


(format T "~{~a ~}~%"
        (loop for n = 1 then (1+ n)
              when (primep (logcount n))
                collect n into numbers
              when (= (length numbers) 25)
                return numbers))

(format T "~{~a ~}~%"
        (loop for n from 888888877 to 888888888
              when (primep (logcount n))
                collect n))


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

    immutable pernicious = (in uint n) => (2 ^^ n.popcnt) & 0xA08A28AC;
    uint.max.iota.filter!pernicious.take(25).writeln;
    iota(888_888_877, 888_888_889).filter!pernicious.writeln;
}


class
	APPLICATION

create
	make

feature

	make
			-- Test of is_pernicious_number.
		local
			test: LINKED_LIST [INTEGER]
			i: INTEGER
		do
			create test.make
			from
				i := 1
			until
				test.count = 25
			loop
				if is_pernicious_number (i) then
					test.extend (i)
				end
				i := i + 1
			end
			across
				test as t
			loop
				io.put_string (t.item.out + " ")
			end
			io.new_line
			across
				888888877 |..| 888888888 as c
			loop
				if is_pernicious_number (c.item) then
					io.put_string (c.item.out + " ")
				end
			end
		end

	is_pernicious_number (n: INTEGER): BOOLEAN
			-- Is 'n' a pernicious_number?
		require
			positiv_input: n > 0
		do
			Result := is_prime (count_population (n))
		end

feature{NONE}

	count_population (n: INTEGER): INTEGER
			-- Population count of 'n'.
		require
			positiv_input: n > 0
		local
			j: INTEGER
			math: DOUBLE_MATH
		do
			create math
			j := math.log_2 (n).ceiling + 1
			across
				0 |..| j as c
			loop
				if n.bit_test (c.item) then
					Result := Result + 1
				end
			end
		end

	is_prime (n: INTEGER): BOOLEAN
			--Is 'n' a prime number?
		require
			positiv_input: n > 0
		local
			i: INTEGER
			max: REAL_64
			math: DOUBLE_MATH
		do
			create math
			if n = 2 then
				Result := True
			elseif n <= 1 or n \\ 2 = 0 then
				Result := False
			else
				Result := True
				max := math.sqrt (n)
				from
					i := 3
				until
					i > max
				loop
					if n \\ i = 0 then
						Result := False
					end
					i := i + 2
				end
			end
		end

end


defmodule SieveofEratosthenes do
  def init(lim) do
    find_primes(2,lim,(2..lim))
  end

  def find_primes(count,lim,nums) when (count * count) > lim do
    nums
  end

  def find_primes(count,lim,nums) when (count * count) <= lim do
    e = Enum.reject(nums,&(rem(&1,count) == 0 and &1 > count))
    find_primes(count+1,lim,e)
  end
end

defmodule PerniciousNumbers do
  def take(n) do
    primes = SieveofEratosthenes.init(100)
    Stream.iterate(1,&(&1+1))
      |> Stream.filter(&(pernicious?(&1,primes)))
      |> Enum.take(n)
      |> IO.inspect
  end

  def between(a..b) do
    primes = SieveofEratosthenes.init(100)
    a..b
      |> Stream.filter(&(pernicious?(&1,primes)))
      |> Enum.to_list
      |> IO.inspect
  end

  def ones(num) do
     num
      |> Integer.to_string(2)
      |> String.codepoints
      |> Enum.count(fn n -> n == "1" end)
  end

   def pernicious?(n,primes), do: Enum.member?(primes,ones(n))
end


open System

//Taken from https://gist.github.com/rmunn/bc49d32a586cdfa5bcab1c3e7b45d7ac
let bitcount (n : int) =
    let count2 = n - ((n >>> 1) &&& 0x55555555)
    let count4 = (count2 &&& 0x33333333) + ((count2 >>> 2) &&& 0x33333333)
    let count8 = (count4 + (count4 >>> 4)) &&& 0x0f0f0f0f
    (count8 * 0x01010101) >>> 24

//Modified from other examples to actually state the 1 is not prime
let isPrime n =
    if n < 2 then
        false
    else
        let sqrtn n = int <| sqrt (float n)
        seq { 2 .. sqrtn n } |> Seq.exists(fun i -> n % i = 0) |> not

[<EntryPoint>]
let main _ =
    [1 .. 100] |> Seq.filter (bitcount >> isPrime) |> Seq.take 25 |> Seq.toList |> printfn "%A"
    [888888877 .. 888888888] |> Seq.filter (bitcount >> isPrime) |> Seq.toList |> printfn "%A"
    0 // return an integer exit code


USING: lists lists.lazy math.bitwise math.primes math.ranges
prettyprint sequences ;

: pernicious? ( n -- ? ) bit-count prime? ;

25 0 lfrom [ pernicious? ] lfilter ltake list>array .    ! print first 25 pernicious numbers
888,888,877 888,888,888 [a,b] [ pernicious? ] filter .   ! print pernicious numbers in range


: popcount { n -- u }
  0
  begin
    n 0<>
  while
    n n 1- and to n
    1+
  repeat ;

\ primality test for 0 <= n <= 63
: prime? ( n -- ? )
  1 swap lshift 0x28208a20a08a28ac and 0<> ;

: pernicious? ( n -- ? )
  popcount prime? ;

: first_n_pernicious_numbers { n -- }
  ." First " n . ." pernicious numbers:" cr
  1
  begin
    n 0 >
  while
    dup pernicious? if
      dup .
      n 1- to n
    then
    1+
  repeat
  drop cr ;

: pernicious_numbers_between { m n -- }
  ." Pernicious numbers between " m . ." and " n 1 .r ." :" cr
  n 1+ m do
    i pernicious? if i . then
  loop
  cr ;

25 first_n_pernicious_numbers
888888877 888888888 pernicious_numbers_between

bye


program pernicious
  implicit none

  integer :: i, n

  i = 1
  n = 0
  do
    if(isprime(popcnt(i))) then
      write(*, "(i0, 1x)", advance = "no") i
      n = n + 1
      if(n == 25) exit
    end if
    i = i + 1
  end do

  write(*,*)
  do i = 888888877, 888888888
    if(isprime(popcnt(i))) write(*, "(i0, 1x)", advance = "no") i
  end do

contains

function popcnt(x)
  integer :: popcnt
  integer, intent(in) :: x
  integer :: i

  popcnt = 0
  do i = 0, 31
    if(btest(x, i)) popcnt = popcnt + 1
  end do

end function

function isprime(number)
  logical :: isprime
  integer, intent(in) :: number
  integer :: i

  if(number == 2) then
    isprime = .true.
  else if(number < 2 .or. mod(number,2) == 0) then
    isprime = .false.
  else
    isprime = .true.
    do i = 3, int(sqrt(real(number))), 2
      if(mod(number,i) == 0) then
        isprime = .false.
        exit
      end if
    end do
  end if
end function
end program


' FreeBASIC v1.05.0 win64

Function SumBinaryDigits(number As Integer) As Integer
  If number < 0 Then number = -number ' convert negative numbers to positive
  Var sum = 0
  While number > 0
    sum += number Mod 2
    number \= 2
  Wend
  Return sum
End Function

Function IsPrime(number As Integer) As Boolean
  If number <= 1 Then
    Return false
  ElseIf number <= 3 Then
    Return true
  ElseIf number Mod 2 = 0 OrElse number Mod 3 = 0 Then
    Return false
  End If
  Var i = 5
  While i * i <= number
    If number Mod i = 0 OrElse number Mod (i + 2) = 0 Then
      Return false
    End If
    i += 6
  Wend
  Return True
End Function

Function IsPernicious(number As Integer) As Boolean
  Dim popCount As Integer = SumBinaryDigits(number)
  Return IsPrime(popCount)
End Function

Dim As Integer n = 1, count = 0
Print "The following are the first 25 pernicious numbers :"
Print

Do
  If IsPernicious(n) Then
    Print Using "###"; n;
    count += 1
  End If
  n += 1
Loop Until count = 25

Print : Print
Print "The pernicious numbers between 888,888,877 and 888,888,888 inclusive are :"
Print
For n = 888888877 To 888888888
  If IsPernicious(n) Then Print Using "##########"; n;
Next
Print : Print
Print "Press any key to exit the program"
Sleep
End


package main

import "fmt"

func pernicious(w uint32) bool {
    const (
        ff    = 1<<32 - 1
        mask1 = ff / 3
        mask3 = ff / 5
        maskf = ff / 17
        maskp = ff / 255
    )
    w -= w >> 1 & mask1
    w = w&mask3 + w>>2&mask3
    w = (w + w>>4) & maskf
    return 0xa08a28ac>>(w*maskp>>24)&1 != 0
}

func main() {
    for i, n := 0, uint32(1); i < 25; n++ {
        if pernicious(n) {
            fmt.Printf("%d ", n)
            i++
        }
    }
    fmt.Println()
    for n := uint32(888888877); n <= 888888888; n++ {
        if pernicious(n) {
            fmt.Printf("%d ", n)
        }
    }
    fmt.Println()
}


class example{
static void main(String[] args){
def n=0;
def counter=0;
while(counter<25){
if(print(n)){
counter++;}
n=n+1;
}
println();
def x=888888877;
while(x<888888889){
print(x);
x++;}
}
static def print(def a){
def primes=[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47];
def c=Integer.toBinaryString(a);
String d=c;
def e=0;
for(i in d){if(i=='1'){e++;}}
if(e in primes){printf(a+" ");return 1;}
}
}


module Pernicious
   where

isPernicious :: Integer -> Bool
isPernicious num = isPrime $ toInteger $ length $ filter ( == 1 ) $ toBinary num

isPrime :: Integer -> Bool
isPrime number = divisors number == [1, number]
   where
      divisors :: Integer -> [Integer]
      divisors number = [ m | m <- [1 .. number] , number `mod` m == 0 ]

toBinary :: Integer -> [Integer]
toBinary num = reverse $ map ( `mod` 2 ) ( takeWhile ( /= 0 ) $ iterate ( `div` 2 ) num )

solution1 = take 25 $ filter isPernicious [1 ..]
solution2 = filter isPernicious [888888877 .. 888888888]


link "factors"

procedure main(A)
    every writes((pernicious(seq())\25||" ") | "\n")
    every writes((pernicious(888888877 to 888888888)||" ") | "\n")
end

procedure pernicious(n)
    return (isprime(c1bits(n)),n)
end

procedure c1bits(n)
    c := 0
    while n > 0 do c +:= 1(n%2, n/:=2)
    return c
end


public class Pernicious{
    //very simple isPrime since x will be <= Long.SIZE
    public static boolean isPrime(int x){
        if(x < 2) return false;
        for(int i = 2; i < x; i++){
            if(x % i == 0) return false;
        }
        return true;
    }

    public static int popCount(long x){
        return Long.bitCount(x);
    }

    public static void main(String[] args){
        for(long i = 1, n = 0; n < 25; i++){
            if(isPrime(popCount(i))){
                System.out.print(i + " ");
                n++;
            }
        }

        System.out.println();

        for(long i = 888888877; i <= 888888888; i++){
            if(isPrime(popCount(i))) System.out.print(i + " ");
        }
    }
}


# is_prime is designed to work with jq 1.4
def is_prime:
  if . == 2 then true
  else 2 < . and . % 2 == 1 and
       . as $in
       | (($in + 1) | sqrt) as $m
       | (((($m - 1) / 2) | floor) + 1) as $max
       | reduce range(1; $max) as $i
           (true; if . then ($in % ((2 * $i) + 1)) > 0 else false end)
  end;

def popcount:
  def bin: recurse( if . == 0 then empty else ./2 | floor end ) % 2;
  [bin] | add;

def is_pernicious: popcount | is_prime;

# Emit a stream of "count" pernicious numbers greater than
# or equal to m:
def pernicious(m; count):
   if count > 0 then
     if m | is_pernicious then m, pernicious(m+1; count -1)
     else pernicious(m+1; count)
     end
   else empty
   end;

def task:
  # display the first 25 pernicious numbers:
  [ pernicious(1;25) ],

  # display all pernicious numbers between
  #     888,888,877 and 888,888,888 (inclusive).
  [ range(888888877; 888888889) | select( is_pernicious ) ]
;

task


using Primes

ispernicious(n::Integer) = isprime(count_ones(n))
nextpernicious(n::Integer) = begin n += 1; while !ispernicious(n) n += 1 end; return n end
function perniciouses(n::Int)
    rst = Vector{Int}(n)
    rst[1] = 3
    for i in 2:n
        rst[i] = nextpernicious(rst[i-1])
    end
    return rst
end
perniciouses(a::Integer, b::Integer) = filter(ispernicious, a:b)

println("First 25 pernicious numbers: ", join(perniciouses(25), ", "))
println("Perniciouses in [888888877, 888888888]: ", join(perniciouses(888888877, 888888888), ", "))


//  version 1.0.5-2

fun isPrime(n: Int): Boolean {
    if (n < 2) return false
    if (n % 2 == 0) return n == 2
    if (n % 3 == 0) return n == 3
    var d : Int = 5
    while (d * d <= n) {
        if (n % d == 0) return false
        d += 2
        if (n % d == 0) return false
        d += 4
    }
    return true
}

fun getPopulationCount(n: Int): Int {
    if (n <= 0) return 0
    var nn = n
    var sum = 0
    while (nn > 0) {
        sum += nn % 2
        nn /= 2
    }
    return sum
}

fun isPernicious(n: Int): Boolean = isPrime(getPopulationCount(n))

fun main(args: Array<String>) {
    var n = 1
    var count = 0
    println("The first 25 pernicious numbers are:\n")
    do {
        if (isPernicious(n)) {
           print("$n ")
           count++
        }
        n++
    }
    while (count < 25)
    println("\n")
    println("The pernicious numbers between 888,888,877 and 888,888,888 inclusive are:\n")
    for (i in 888888877..888888888) {
        if (isPernicious(i)) print("$i ")
    }
}


#!/bin/ksh

# Positive integer whose population count is a prime

#	# Variables:
#
integer PNUM=25 MINN=888888877 MAXN=888888888

#	# Functions:
#
#	# Function _dec2bin(n) - return binary representation of decimal n
#
function _dec2bin {
	typeset _n ; integer _n=$1
	typeset _base ; integer _base=2
	typeset _q _r _buff ; integer _q _r
	typeset -a _arr _barr

	(( _q = _n / _base ))
	(( _r = _n % _base ))
	_arr+=( ${_r} )
	until (( _q == 0 )); do
		_n=${_q}
		(( _q = _n / _base ))
		(( _r = _n % _base ))
		_arr+=( ${_r} )
	done
	_revarr _arr _barr
	_buff=${_barr[@]}
	echo ${_buff// /}
}

#	# Function _revarr(arr, barr) - reverse arr into barr
#
function _revarr {
	typeset _arr ; nameref _arr="$1"
	typeset _barr ; nameref _barr="$2"
	typeset _i ; integer _i

	for ((_i=${#_arr[*]}-1; _i>=0; _i--)); do
		_barr+=( ${_arr[_i]} )
	done
}

#	# Function _isprime(n) return 1 for prime, 0 for not prime
#
function _isprime {
	typeset _n ; integer _n=$1
	typeset _i ; integer _i

	(( _n < 2 )) && return 0
	for (( _i=2 ; _i*_i<=_n ; _i++ )); do
		(( ! ( _n % _i ) )) && return 0
	done
	return 1
}

#	# Function _sumdigits(n) return sum of n's digits
#
function _sumdigits {
	typeset _n ; _n=$1
	typeset _i _sum ; integer _i _sum=0

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

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

integer i sbi n=3 cnt=0

printf "First $PNUM Pernicious numbers:\n"
for ((n = cnt = 0; cnt < PNUM; n++)); do
	bi=$(_dec2bin ${n})		# $n as Binary
	sbi=${bi//0/}			# Strip zeros (i.e. count ones)
	_isprime ${#sbi}		# One count prime?
	(( $? )) && { printf "%4d " ${n} ; ((++cnt)) }
done

printf "\n\nPernicious numbers between %11,d and %11,d inclusive:\n" $MINN $MAXN
for ((i=MINN; i<=MAXN; i++)); do
	bi=$(_dec2bin ${i})
	sbi=${bi//0/}
	_isprime ${#sbi}
	(( $? )) && printf "%12,d " ${i}
done
echo


-- Test primality by trial division
function isPrime (x)
    if x < 2 then return false end
    if x < 4 then return true end
    if x % 2 == 0 then return false end
    for d = 3, math.sqrt(x), 2 do
        if x % d == 0 then return false end
    end
    return true
end

-- Take decimal number, return binary string
function dec2bin (n)
    local bin, bit = ""
    while n > 0 do
        bit = n % 2
        n = math.floor(n / 2)
        bin = bit .. bin
    end
    return bin
end

-- Take decimal number, return population count as number
function popCount (n)
    local bin, count = dec2bin(n), 0
    for pos = 1, bin:len() do
        if bin:sub(pos, pos) == "1" then count = count + 1 end
    end
    return count
end

-- Print pernicious numbers in range if two arguments provided, or
function pernicious (x, y) -- the first 'x' if only one argument.
    if y then
        for n = x, y do
            if isPrime(popCount(n)) then io.write(n .. " ") end
        end
    else
        local n, count = 0, 0
        while count < x do
            if isPrime(popCount(n)) then
                io.write(n .. " ")
                count = count + 1
            end
            n = n + 1
        end
    end
    print()
end

-- Main procedure
pernicious(25)
pernicious(888888877, 888888888)


ispernicious := proc(n::posint)
  return evalb(isprime(rhs(Statistics:-Tally(StringTools:-Explode(convert(convert(n, binary), string)))[-1])));
end proc;

print_pernicious := proc(n::posint)
local k, count, list_num;
count := 0;
list_num := [];
for k while count < n do
    if ispernicious(k) then
       count := count + 1;
       list_num := [op(list_num), k];
    end if;
end do;
return list_num;
end proc:

range_pernicious := proc(n::posint, m::posint)
local k, list_num;
list_num := [];
for k from n to m do
    if ispernicious(k) then
       list_num := [op(list_num), k];
    end if;
end do;
return list_num;
end proc:


popcount[n_Integer] := IntegerDigits[n, 2] // Total
perniciousQ[n_Integer] := popcount[n] // PrimeQ
perniciouscount = 0;
perniciouslist = {};
i = 0;
While[perniciouscount < 25,
 If[perniciousQ[i], AppendTo[perniciouslist, i]; perniciouscount++];
 i++]
Print["first 25 pernicious numbers"]
perniciouslist
(*******)
perniciouslist2 = {};
Do[
 If[perniciousQ[i], AppendTo[perniciouslist2, i]]
 , {i, 888888877, 888888888}]
Print["Pernicious numbers between 888,888,877 and 888,888,888 (inclusive)"]
perniciouslist2


MODULE Pernicious;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE IsPrime(x : LONGINT) : BOOLEAN;
VAR i : LONGINT;
BEGIN
    IF x<2 THEN RETURN FALSE END;
    FOR i:=2 TO x-1 DO
        IF x MOD i = 0 THEN RETURN FALSE END
    END;
    RETURN TRUE
END IsPrime;

PROCEDURE BitCount(x : LONGINT) : LONGINT;
VAR count : LONGINT;
BEGIN
    count := 0;
    WHILE x>0 DO
        x := x BAND (x-1);
        INC(count)
    END;
    RETURN count
END BitCount;

VAR
    buf : ARRAY[0..63] OF CHAR;
    i,n : LONGINT;
BEGIN
    i := 1;
    n := 0;
    WHILE n<25 DO
        IF IsPrime(BitCount(i)) THEN
            FormatString("%l ", buf, i);
            WriteString(buf);
            INC(n)
        END;
        INC(i)
    END;
    WriteLn;

    FOR i:=888888877 TO 888888888 DO
        IF IsPrime(BitCount(i)) THEN
            FormatString("%l ", buf, i);
            WriteString(buf)
        END;
    END;

    ReadChar
END Pernicious.


import strutils

proc count(s: string; sub: char): int =
  var i = 0
  while true:
    i = s.find(sub, i)
    if i < 0:
      break
    inc i
    inc result

proc popcount(n: int): int = n.toBin(64).count('1')

const primes = {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61}

var p: seq[int]
var i = 0
while p.len < 25:
  if popcount(i) in primes: p.add i
  inc i

echo p

p = @[]
i = 888_888_877
while i <= 888_888_888:
  if popcount(i) in primes: p.add i
  inc i

echo p


fun prime(a) type integer->integer
  a where count{{a.factor}}==2
fun pernisc(a) type integer->integer
  a where sum{{a.radix:2 .char.integer}}.integer.prime

1..36.pernisc
888888877..888888888.pernisc


pern(n)=isprime(hammingweight(n))
select(pern, [1..36])
select(pern,[888888877..888888888])


program pernicious;
{$IFDEF FPC}
   {$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}// 3x speed up
{$ENDIF}
uses
  sysutils;//only used for time

type
  tbArr    = array[0..64] of byte;
{
  PrimeTil64 : array[0..64] of byte =
  (0,0,2,3,0,5,0, 7,0,0,0,11,0,13,0,0,0,17,0,19,0,0,0,23,0,0,0,0,0,29,0,
    31,0,0,0,0,0,37,0,0,0,41,0,43,0,0,0,47,0, 0,0,0,0,53,0,0,0,0,0,59,0,
    61,0,0,0);
}
const
  PrimeTil64 : tbArr =
  (0,0,1,1,0,1,0, 1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,
     1,0,0,0,0,0, 1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,
     1,0,0,0);

function n_beyond_k(n,k: NativeInt):Uint64;
var
  i : NativeInt;
Begin
  result := 1;
  IF 2*k>= n  then
    k := n-k;
  For i := 1 to k do
  Begin
    result := result *n DIV i;
    dec(n);
  end;
end;

function popcnt32(n:Uint32):NativeUint;
//https://en.wikipedia.org/wiki/Hamming_weight#Efficient_implementation
const
  K1  = $0101010101010101;
  K33 = $3333333333333333;
  K55 = $5555555555555555;
  KF1 = $0F0F0F0F0F0F0F0F;
begin
  n := n- (n shr 1) AND NativeUint(K55);
  n := (n AND NativeUint(K33))+ ((n shr 2) AND NativeUint(K33));
  n := (n + (n shr 4)) AND NativeUint(KF1);
  n := (n*NativeUint(K1)) SHR 24;
  popcnt32 := n;
end;

var
  bit1cnt,
  k : LongWord;
  PernCnt : Uint64;
Begin
  writeln('the 25 first pernicious numbers');
  k:=1;
  PernCnt:=0;
  repeat
    IF PrimeTil64[popCnt32(k)] <> 0 then Begin
      inc(PernCnt); write(k,' ');end;
    inc(k);
  until PernCnt >= 25;
  writeln;

  writeln('pernicious numbers in [888888877..888888888]');
  For k :=  888888877 to 888888888 do
    IF PrimeTil64[popCnt32(k)] <> 0  then
      write(k,' ');
  writeln(#13#10);

  k := 8;
  repeat
    PernCnt := 0;
    For bit1cnt := 0 to k do
    Begin
      //i == number of Bits set,n_beyond_k(k,i) == number of arrangements
      IF PrimeTil64[bit1cnt] <> 0 then
        inc(PernCnt,n_beyond_k(k,bit1cnt));
    end;
    writeln(PernCnt,' pernicious numbers in [0..2^',k,'-1]');
    inc(k,k);
  until k>64;
end.


sub is_pernicious {
    my $n = shift;
    my $c = 2693408940;  # primes < 32 as set bits
    while ($n) { $c >>= 1; $n &= ($n - 1); }
    $c & 1;
}

my ($i, @p) = 0;
while (@p < 25) {
    push @p, $i if is_pernicious($i);
    $i++;
}

print join ' ', @p;
print "\n";
($i, @p) = (888888877,);
while ($i < 888888888) {
    push @p, $i if is_pernicious($i);
    $i++;
}

print join ' ', @p;


with javascript_semantics
function pernicious(integer n)
    return is_prime(sum(int_to_bits(n,32)))
end function

sequence s = {}
integer n = 1
while length(s)<25 do
    if pernicious(n) then
        s &= n
    end if
    n += 1
end while
pp(s)
s = {}
for i=888_888_877 to 888_888_888 do
    if pernicious(i) then
        s &= i
    end if
end for
pp(s)


go =>

  println(take_n(pernicious_number,25,1)),
  println([J : J in 888888877..888888888, pernicious_number(J)]),
  nl.

% Get the first N numbers that satisfies function F, starting with S
take_n(F,N,S) = L =>
  I = S,
  C = 0,
  L = [],
  while(C < N)
    if call(F,I) then
       L := L ++ [I],
       C := C + 1
    end,
    I := I + 1
  end.

pop_count(N) = sum([1: I in N.to_binary_string(), I = '1']).

pernicious_number(N) => prime(pop_count(N)).


(de pernicious? (N)
   (prime? (cnt = (chop (bin N)) '("1" .))) )


pern: procedure options (main);
   declare (i, n) fixed binary (31);

   n = 3;
   do i = 1 to 25, 888888877 to 888888888;
      if i = 888888877 then do; n = i ; put skip; end;
      do while ( ^is_prime ( tally(bit(n), '1'b) ) );
         n = n + 1;
      end;
      put edit( trim(n), ' ') (a);
      n = n + 1;
   end;

is_prime: procedure (n) returns (bit(1));
   declare n fixed (15);
   declare i fixed (10);

   if n < 2 then return ('0'b);
   if n = 2 then return ('1'b);
   if mod(n, 2) = 0 then return ('0'b);

   do i = 3 to sqrt(n) by 2;
      if mod(n, i) = 0 then return ('0'b);
   end;
   return ('1'b);
end is_prime;

end pern;


To decide if a number is pernicious:
Find a population count of the number.
If the population count is prime, say yes.
Say no.

To find a population count of a number:
Privatize the number.
Loop.
If the number is 0, exit.
Bitwise and the number with the number minus 1.
Bump the population count.
Repeat.

To run:
Start up.
Show the first twenty-five pernicious numbers.
Show the pernicious numbers between 888888877 and 888888888.
Wait for the escape key.
Shut down.

To show the first twenty-five pernicious numbers:
Put 0 into a number.
Put 0 into a pernicious number count.
Loop.
If the pernicious number count is greater than 24, write "" on the console; exit.
If the number is pernicious, show the number; bump the pernicious number count.
Bump the number.
Repeat.

To show a number:
Convert the number to a string.
Write the string then " " on the console without advancing.

To show the pernicious numbers between a number and another number:
Privatize the number.
Subtract 1 from the number.
Loop.
If the number is past the other number, exit.
If the number is pernicious, show the number.
Repeat.


function pop-count($n) {
    (([Convert]::ToString($n, 2)).toCharArray() | where {$_ -eq '1'}).count
}

function isPrime ($n) {
    if ($n -eq 1) {$false}
    elseif ($n -eq 2) {$true}
    elseif ($n -eq 3) {$true}
    else{
        $m = [Math]::Floor([Math]::Sqrt($n))
        (@(2..$m | where {($_ -lt $n)  -and ($n % $_ -eq 0) }).Count -eq 0)
    }
}

$i = 0
$num = 1
$arr = while($i -lt 25) {
    if((isPrime (pop-count $num))) {
        $i++
        $num
    }
    $num++
}
"first 25 pernicious numbers"
"$arr"
""
"pernicious numbers between 888,888,877 and 888,888,888"
"$(888888877..888888888 | where{isprime(pop-count $_)})"


EnableExplicit

Procedure.i SumBinaryDigits(Number)
  If Number < 0 : number = -number : EndIf; convert negative numbers to positive
  Protected sum = 0
  While Number > 0
    sum + Number % 2
    Number / 2
  Wend
  ProcedureReturn sum
EndProcedure

Procedure.i IsPrime(Number)
  If Number <= 1
    ProcedureReturn #False
  ElseIf Number <= 3
    ProcedureReturn #True
  ElseIf Number % 2 = 0 Or Number % 3 = 0
    ProcedureReturn #False
  EndIf
  Protected i = 5
  While i * i <= Number
    If Number % i = 0 Or Number % (i + 2) = 0
      ProcedureReturn #False
    EndIf
    i + 6
  Wend
  ProcedureReturn #True
EndProcedure

Procedure.i IsPernicious(Number)
  Protected popCount = SumBinaryDigits(Number)
  ProcedureReturn Bool(IsPrime(popCount))
EndProcedure

Define n = 1, count = 0
If OpenConsole()
  PrintN("The following are the first 25 pernicious numbers :")
  PrintN("")
  Repeat
    If IsPernicious(n)
      Print(RSet(Str(n), 3))
      count + 1
    EndIf
    n + 1
  Until count = 25
  PrintN("")
  PrintN("")
  PrintN("The pernicious numbers between 888,888,877 and 888,888,888 inclusive are : ")
  PrintN("")
  For n = 888888877 To 888888888
    If IsPernicious(n)
      Print(RSet(Str(n), 10))
    EndIf
  Next
  PrintN("")
  PrintN("")
  PrintN("Press any key to close the console")
  Repeat: Delay(10) : Until Inkey() <> ""
  CloseConsole()
EndIf


  [ $ "rosetta/seive.qky" loadfile
    $ "rosetta/popcount.qky" loadfile ] now!

  ( i.e. using the code at                                     )
  ( http://rosettacode.org/wiki/Sieve_of_Eratosthenes and      )
  ( http://rosettacode.org/wiki/Population_count               )

  29 eratosthenes ( Precompute as many primes as are required  )
                  ( for the task. 888,888,888 is a 30 bit      )
                  ( number less than (2^30)-1 so  primes up to )
                  ( 29 will suffice.                           )

  [ 1+ over - times
      [ dup i^ +
        dup popcount
        isprime iff
          [ echo sp ]
        else drop ]
    drop ]                    is perniciousrange   ( n n -->   )

  25 echopopwith isprime cr

  888888877 888888888 perniciousrange cr


#lang racket
(require math/number-theory rnrs/arithmetic/bitwise-6)

(define pernicious? (compose prime? bitwise-bit-count))

(define (dnl . strs)
  (for-each displayln strs))

(define (show-sequence seq)
  (string-join (for/list ((v (in-values*-sequence seq))) (~a ((if (list? v) car values) v))) ", "))

(dnl
 "Task requirements:"
 "display the first 25 pernicious numbers."
 (show-sequence (in-parallel (sequence-filter pernicious? (in-naturals 1)) (in-range 25)))
 "display all pernicious numbers between 888,888,877 and 888,888,888 (inclusive)."
 (show-sequence (sequence-filter pernicious? (in-range 888888877 (add1 888888888)))))

(module+ test
  (require rackunit)
  (check-true (pernicious? 22)))


sub is-pernicious(Int $n --> Bool) {
    is-prime [+] $n.base(2).comb;
}

say (grep &is-pernicious, 0 .. *)[^25];
say grep &is-pernicious, 888_888_877 .. 888_888_888;


╔════════════════════════════════════════════════════════════════════════════════════════╗
╠═════ How the ─── popCount ─── function works (working from the inner─most level): ═════╣
║                                                                                ║
║ arg(1)     obtains the value of the 1st argument passed to the  (popCount)  function.  ║
║ d2x        converts a decimal string  ──►  heXadecimal  (it may have a leading zeroes).║
║ +0         adds zero to the (above) string,  removing any superfluous leading zeroes.  ║
║ translate  converts all zeroes to blanks    (the 2nd argument defaults to a blank).    ║
║ space      removes all blanks from the character string  (now only containing '1's).   ║
║ length     counts the number of characters in the string.                              ║
║ return     returns the above value to the invoker.                                     ║
║                                                                                ║
║            Note that    all    values in REXX are stored as  (eight─bit)  characters.  ║
╚════════════════════════════════════════════════════════════════════════════════════════╝


# Project : Pernicious numbers

see "The first 25 pernicious numbers:" + nl
nr = 0
for n=1 to 50
    sum = 0
    str = decimaltobase(n, 2)
    for m=1 to len(str)
        if str[m] = "1"
           sum = sum + 1
        ok
    next
    if isprime(sum)
       nr = nr + 1
       see "" + n + " "
    ok
    if nr = 25
       exit
    ok
next

func decimaltobase(nr, base)
     binary = 0
     i = 1
     while(nr != 0)
           remainder = nr % base
           nr = floor(nr/base)
           binary= binary + (remainder*i)
           i = i*10
     end
     return string(binary)

func isprime num
     if (num <= 1) return 0 ok
     if (num % 2 = 0 and num != 2) return 0 ok
     for i = 3 to floor(num / 2) -1 step 2
         if (num % i = 0) return 0 ok
     next
     return 1


require "prime"

class Integer

  def popcount
    to_s(2).count("1")   #Ruby 2.4:  digits(2).count(1)
  end

  def pernicious?
    popcount.prime?
  end

end

p 1.step.lazy.select(&:pernicious?).take(25).to_a
p ( 888888877..888888888).select(&:pernicious?)


extern crate aks_test_for_primes;

use std::iter::Filter;
use std::ops::RangeFrom;

use aks_test_for_primes::is_prime;

fn main() {
    for i in pernicious().take(25) {
        print!("{} ", i);
    }
    println!();
    for i in (888_888_877u64..888_888_888).filter(is_pernicious) {
        print!("{} ", i);
    }
}

fn pernicious() -> Filter<RangeFrom<u64>, fn(&u64) -> bool> {
    (0u64..).filter(is_pernicious as fn(&u64) -> bool)
}

fn is_pernicious(n: &u64) -> bool {
    is_prime(n.count_ones())
}


% Simplistic prime-test from prime-by-trial-division:
define is_prime(n)
{
   if (n <= 1) return(0);
   if (n == 2) return(1);
   if ((n & 1) == 0) return(0);

   variable mx = int(sqrt(n)), i;

   _for i (3, mx, 1) {
     if ((n mod i) == 0)
       return(0);
   }
   return(1);
}

define population(n)
{
   variable pc = 0;
   do {
      if (n & 1) pc++;
      n /= 2;
   }
   while (n);
   return(pc);
}

define is_pernicious(n)
{
   return(is_prime(population(n)));
}

variable plist = {}, n = 0;
while (length(plist) < 25) {
   n++;
   if (is_pernicious(n))
     list_append(plist, string(n));
}
print(strjoin(list_to_array(plist), " "));

plist = {};
_for n (888888877, 888888888, 1) {
   if (is_pernicious(n))
     list_append(plist, string(n));
}
print(strjoin(list_to_array(plist), " "));


def isPernicious( v:Long ) : Boolean = BigInt(v.toBinaryString.toList.filter( _ == '1' ).length).isProbablePrime(16)

// Generate the output
{
  val (a,b1,b2) = (25,888888877L,888888888L)
  println( Stream.from(2).filter( isPernicious(_) ).take(a).toList.mkString(",") )
  println( {for( i <- b1 to b2 if( isPernicious(i) ) ) yield i}.mkString(",") )
}


$ include "seed7_05.s7i";

const set of integer: primes is {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61};

const func integer: popcount (in integer: number) is
  return card(bitset(number));

const proc: main is func
  local
    var integer: num is 0;
    var integer: count is 0;
  begin
    for num range 0 to integer.last until count >= 25 do
      if popcount(num) in primes then
        write(num <& " ");
	incr(count);
      end if;
    end for;
    writeln;
    for num range 888888877 to 888888888 do
      if popcount(num) in primes then
        write(num <& " ");
      end if;
    end for;
    writeln;
  end func;


func is_pernicious(n) {
    n.sumdigits(2).is_prime
}

say is_pernicious.first(25).join(' ')
say is_pernicious.grep(888_888_877..888_888_888).join(' ')


import Foundation

extension BinaryInteger {
  @inlinable
  public var isPrime: Bool {
    if self == 0 || self == 1 {
      return false
    } else if self == 2 {
      return true
    }

    let max = Self(ceil((Double(self).squareRoot())))

    for i in stride(from: 2, through: max, by: 1) where self % i == 0  {
      return false
    }

    return true
  }
}

public func populationCount(n: Int) -> Int {
  guard n >= 0 else {
      return 0
  }

  return String(n, radix: 2).lazy.filter({ $0 == "1" }).count
}

let first25 = (1...).lazy.filter({ populationCount(n: $0).isPrime }).prefix(25)
let rng = (888_888_877...888_888_888).lazy.filter({ populationCount(n: $0).isPrime })

print("First 25 Pernicious numbers: \(Array(first25))")
print("Pernicious numbers between 888_888_877...888_888_888: \(Array(rng))")


primes : 0b0010100000100000100010100010000010100000100010100010100010101100

| the first 25 pernicious numbers

       $T                                | clear string
       num_pn                            | set to zero
       2 n                               | start at 2
       5 hi_bit
       if num_pn LT 25
          call popcount                  | count ones
          if primes bit pop_cnt          | if pop_cnt bit of bit vector primes is one
             + num_pn                    | inc number of pernicious numbers
             ~ n $S                      | convert to decimal string
             + ' ' $S                    | pad a space
             + $S $T                     | add to string $T
          endif
          + pop_cnt                      | next number (odd) has one more bit than previous (even)
          + n                            | next number
          if primes bit pop_cnt
             + num_pn
             ~ n $S
             + ' ' $S
             + $S $T
          endif
          + n
          goif                           | go back to if
       endif
       $T []                             | display numbers

| pernicious numbers in range 888888877 .. 888888888

       $T                                | clear string
       num_pn                            | set to zero
       888888876 n                       | start at 888888876
       29 hi_bit
       if n LE 888888888
          call popcount                  | count ones
          if primes bit pop_cnt          | if pop_cnt bit of bit vector primes is one
             + num_pn                    | inc number of pernicious numbers
             ~ n $S                      | convert to decimal string
             + ' ' $S                    | pad a space
             + $S $T                     | add to string $T
          endif
          + pop_cnt                      | next number (odd) has one more bit than previous (even)
          + n                            | next number
          if primes bit pop_cnt
             + num_pn
             ~ n $S
             + ' ' $S
             + $S $T
          endif
          + n
          goif                           | go back to if
       endif
       $T []                             | display numbers

       stop

popcount                                 | count ones in bit field
       pop_cnt                           | pop_cnt to zero
       1 bit_num                         | only count even numbers so skip bit 0
       if bit_num LE hi_bit
          if n bit bit_num
             + pop_cnt
          endif
          + bit_num
          goif
       endif
       return


package require math::numtheory

proc pernicious {n} {
    ::math::numtheory::isprime [tcl::mathop::+ {*}[split [format %b $n] ""]]
}

for {set n 0;set p {}} {[llength $p] < 25} {incr n} {
    if {[pernicious $n]} {lappend p $n}
}
puts [join $p ","]
for {set n 888888877; set p {}} {$n <= 888888888} {incr n} {
    if {[pernicious $n]} {lappend p $n}
}
puts [join $p ","]


Private Function population_count(ByVal number As Long) As Integer
    Dim result As Integer
    Dim digit As Integer
    Do While number > 0
        If number Mod 2 = 1 Then
            result = result + 1
        End If
        number = number \ 2
    Loop
    population_count = result
End Function

Function is_prime(n As Integer) As Boolean
    If n < 2 Then
        is_prime = False
        Exit Function
    End If
    For i = 2 To Sqr(n)
        If n Mod i = 0 Then
            is_prime = False
            Exit Function
        End If
    Next i
    is_prime = True
End Function

Function pernicious(n As Long)
    Dim tmp As Integer
    tmp = population_count(n)
    pernicious = is_prime(tmp)
End Function

Public Sub main()
    Dim count As Integer
    Dim n As Long: n = 1
    Do While count < 25
        If pernicious(n) Then
            Debug.Print n;
            count = count + 1
        End If
        n = n + 1
    Loop
    Debug.Print
    For n = 888888877 To 888888888
        If pernicious(n) Then
            Debug.Print n;
        End If
    Next n
End Sub


'check if the number is pernicious
Function IsPernicious(n)
	IsPernicious = False
	bin_num = Dec2Bin(n)
	sum = 0
	For h = 1 To Len(bin_num)
		sum = sum + CInt(Mid(bin_num,h,1))
	Next
	If IsPrime(sum) Then
		IsPernicious = True
	End If
End Function

'prime number validation
Function IsPrime(n)
	If n = 2 Then
		IsPrime = True
	ElseIf n <= 1 Or n Mod 2 = 0 Then
		IsPrime = False
	Else
		IsPrime = True
		For i = 3 To Int(Sqr(n)) Step 2
			If n Mod i = 0 Then
				IsPrime = False
				Exit For
			End If
		Next
	End If
End Function

'decimal to binary converter
Function Dec2Bin(n)
	q = n
	Dec2Bin = ""
	Do Until q = 0
		Dec2Bin = CStr(q Mod 2) & Dec2Bin
		q = Int(q / 2)
	Loop
End Function

'display the first 25 pernicious numbers
c = 0
WScript.StdOut.Write "First 25 Pernicious Numbers:"
WScript.StdOut.WriteLine
For k = 1 To 100
	If IsPernicious(k) Then
		WScript.StdOut.Write k & ", "
		c = c + 1
	End If
	If c = 25 Then
		Exit For
	End If
Next
WScript.StdOut.WriteBlankLines(2)

'display the pernicious numbers between  888,888,877 to 888,888,888 (inclusive)
WScript.StdOut.Write "Pernicious Numbers between 888,888,877 to 888,888,888 (inclusive):"
WScript.StdOut.WriteLine
For l = 888888877 To 888888888
	If IsPernicious(l) Then
		WScript.StdOut.Write l & ", "
	End If
Next
WScript.StdOut.WriteLine


Module Module1

    Function PopulationCount(n As Long) As Integer
        Dim cnt = 0
        Do
            If (n Mod 2) <> 0 Then
                cnt += 1
            End If
            n >>= 1
        Loop While n > 0
        Return cnt
    End Function

    Function IsPrime(x As Integer) As Boolean
        If x <= 2 OrElse (x Mod 2) = 0 Then
            Return x = 2
        End If

        Dim limit = Math.Sqrt(x)
        For i = 3 To limit Step 2
            If x Mod i = 0 Then
                Return False
            End If
        Next

        Return True
    End Function

    Function Pernicious(start As Integer, count As Integer, take As Integer) As IEnumerable(Of Integer)
        Return Enumerable.Range(start, count).Where(Function(n) IsPrime(PopulationCount(n))).Take(take)
    End Function

    Sub Main()
        For Each n In Pernicious(0, Integer.MaxValue, 25)
            Console.Write("{0} ", n)
        Next
        Console.WriteLine()

        For Each n In Pernicious(888888877, 11, 11)
            Console.Write("{0} ", n)
        Next
        Console.WriteLine()
    End Sub

End Module


:ispernum ^(@isPrime \@count \=1 @arr &\`![.toString 2])


var pernicious = Fn.new { |w|
    var ff    = 2.pow(32) - 1
    var mask1 = (ff / 3).floor
    var mask3 = (ff / 5).floor
    var maskf = (ff / 17).floor
    var maskp = (ff / 255).floor
    w = w - (w >> 1 & mask1)
    w = (w & mask3) + (w >>2 & mask3)
    w = (w + (w >> 4)) & maskf
    return 0xa08a28ac >> (w*maskp >> 24) & 1 != 0
}

var i = 0
var n = 1
while (i < 25) {
    if (pernicious.call(n)) {
        System.write("%(n) ")
        i = i + 1
    }
    n = n + 1
}
System.print()
for (n in 888888877..888888888) {
    if (pernicious.call(n)) System.write("%(n) ")
}
System.print()


F s_permutations(seq)
   V items = [[Int]()]
   L(j) seq
      [[Int]] new_items
      L(item) items
         I L.index % 2
            new_items [+]= (0..item.len).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
         E
            new_items [+]= (item.len..0).step(-1).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
      items = new_items

   R enumerate(items).map((i, item) -> (item, I i % 2 {-1} E 1))

L(n) (3, 4)
   print(‘Permutations and sign of #. items’.format(n))
   L(perm, sgn) s_permutations(Array(0 .< n))
      print(‘Perm: #. Sign: #2’.format(perm, sgn))
   print()


BEGIN # Heap's algorithm for generating permutations - from the pseudo-code on the Wikipedia page #
    # generate permutations of a #
    PROC generate = ( INT k, REF[]INT a, REF INT swap count )VOID:
         IF k = 1 THEN
            output permutation( a, swap count )
         ELSE
            # Generate permutations with kth unaltered #
            # Initially k = length a #
            generate( k - 1, a, swap count );
            # Generate permutations for kth swapped with each k-1 initial #
            FOR i FROM 0 TO k - 2 DO
                # Swap choice dependent on parity of k (even or odd) #
                swap count +:= 1;
                INT swap item = IF ODD k THEN 0 ELSE i FI;
                INT t           = a[ swap item ];
                a[ swap item ] := a[ k - 1 ];
                a[ k - 1     ] := t;
                generate( k - 1, a, swap count )
            OD
         FI # generate # ;
    # generate permutations of a #
    PROC permute = ( REF[]INT a )VOID:
         BEGIN
            INT swap count := 0;
            generate( ( UPB a + 1 ) - LWB a, a[ AT 0 ], swap count )
         END # permute # ;

    # handle a permutation #
    PROC output permutation = ( REF[]INT a, INT swap count )VOID:
         BEGIN
            print( ( "[" ) );
            FOR i FROM LWB a TO UPB a DO
               print( ( whole( a[ i ], 0 ) ) );
               IF i = UPB a THEN print( ( "]" ) ) ELSE print( ( ", " ) ) FI
            OD;
            print( ( " sign: ", IF ODD swap count THEN "-1" ELSE " 1" FI, newline ) )
         END # output permutation # ;

    [ 1 : 3 ]INT a := ( 1, 2, 3 );
    permute( a )

END


permutations: function [arr][
    d: 1
    c: array.of: size arr 0
    xs: new arr
    sign: 1

    ret: new @[@[xs, sign]]

    while [true][
        while [d > 1][
            d: d-1
            c\[d]: 0
        ]

        while [c\[d] >= d][
            d: d+1
            if d >= size arr -> return ret
        ]

        i: (1 = and d 1)? -> c\[d] -> 0
        tmp: xs\[i]
        xs\[i]: xs\[d]
        xs\[d]: tmp

        sign: neg sign
        'ret ++ @[new @[xs, sign]]
        c\[d]: c\[d] + 1
    ]

    return ret
]

loop permutations 0..2 'row ->
    print [row\0 "-> sign:" row\1]

print ""

loop permutations 0..3 'row ->
    print [row\0 "-> sign:" row\1]


Permutations_By_Swapping(str, list:=""){
	ch := SubStr(str, 1, 1)								; get left-most charachter of str
	for i, line in StrSplit(list, "`n")					; for each line in list
		loop % StrLen(line) + 1							; loop each possible position
			Newlist .= RegExReplace(line, mod(i,2) ? "(?=.{" A_Index-1 "}$)" : "^.{" A_Index-1 "}\K", ch) "`n"
	list := Newlist ? Trim(Newlist, "`n") : ch			; recreate list
	if !str := SubStr(str, 2)							; remove charachter from left hand side
		return list										; done if str is empty
	return Permutations_By_Swapping(str, list)			; else recurse
}


call perms(3)
print
call perms(4)
end

subroutine perms(n)
    dim p((n+1)*4)
    for i = 1 to n
        p[i] = -i
    next i
    s = 1

    do
        print "Perm: [ ";
        for i = 1 to n
            print abs(p[i]); " ";
        next i
        print "] Sign: "; s

        k = 0
        for i = 2 to n
            if p[i] < 0 and (abs(p[i]) > abs(p[i-1])) and (abs(p[i]) > abs(p[k])) then k = i
        next i
        for i = 1 to n-1
            if p[i] > 0 and (abs(p[i]) > abs(p[i+1])) and (abs(p[i]) > abs(p[k])) then k = i
        next i
        if k then
            for i = 1 to n    #reverse elements > k
                if abs(p[i]) > abs(p[k]) then p[i] = -p[i]
            next i
            if p[k] < 0 then i = k-1 else i = k+1
            temp = p[k]
            p[k] = p[i]
            p[i] = temp
            s = -s
        end if
    until k = 0
end subroutine


      PROCperms(3)
      PRINT
      PROCperms(4)
      END

      DEF PROCperms(n%)
      LOCAL p%(), i%, k%, s%
      DIM p%(n%)
      FOR i% = 1 TO n%
        p%(i%) = -i%
      NEXT
      s% = 1
      REPEAT
        PRINT "Perm: [ ";
        FOR i% = 1 TO n%
          PRINT ;ABSp%(i%) " ";
        NEXT
        PRINT "] Sign: ";s%
        k% = 0
        FOR i% = 2 TO n%
          IF p%(i%)<0 IF ABSp%(i%)>ABSp%(i%-1) IF ABSp%(i%)>ABSp%(k%) k% = i%
        NEXT
        FOR i% = 1 TO n%-1
          IF p%(i%)>0 IF ABSp%(i%)>ABSp%(i%+1) IF ABSp%(i%)>ABSp%(k%) k% = i%
        NEXT
        IF k% THEN
          FOR i% = 1 TO n%
            IF ABSp%(i%)>ABSp%(k%) p%(i%) *= -1
          NEXT
          i% = k%+SGNp%(k%)
          SWAP p%(k%),p%(i%)
          s% = -s%
        ENDIF
      UNTIL k% = 0
      ENDPROC


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

int flag = 1;

void heapPermute(int n, int arr[],int arrLen){
	int temp;
	int i;

	if(n==1){
		printf("\n[");

		for(i=0;i<arrLen;i++)
			printf("%d,",arr[i]);
		printf("\b] Sign : %d",flag);

		flag*=-1;
	}
	else{
		for(i=0;i<n-1;i++){
			heapPermute(n-1,arr,arrLen);

			if(n%2==0){
				temp = arr[i];
				arr[i] = arr[n-1];
				arr[n-1] = temp;
			}
			else{
				temp = arr[0];
				arr[0] = arr[n-1];
				arr[n-1] = temp;
			}
		}
		heapPermute(n-1,arr,arrLen);
	}
}

int main(int argC,char* argV[0])
{
	int *arr, i=0, count = 1;
	char* token;

	if(argC==1)
		printf("Usage : %s <comma separated list of integers>",argV[0]);
	else{
		while(argV[1][i]!=00){
			if(argV[1][i++]==',')
				count++;
		}

		arr = (int*)malloc(count*sizeof(int));

		i = 0;

		token = strtok(argV[1],",");

		while(token!=NULL){
			arr[i++] = atoi(token);
			token = strtok(NULL,",");
		}

		heapPermute(i,arr,count);
	}

	return 0;
}


#include <iostream>
#include <vector>

using namespace std;

vector<int> UpTo(int n, int offset = 0)
{
	vector<int> retval(n);
	for (int ii = 0; ii < n; ++ii)
		retval[ii] = ii + offset;
	return retval;
}

struct JohnsonTrotterState_
{
	vector<int> values_;
	vector<int> positions_;	// size is n+1, first element is not used
	vector<bool> directions_;
	int sign_;

	JohnsonTrotterState_(int n) : values_(UpTo(n, 1)), positions_(UpTo(n + 1, -1)), directions_(n + 1, false), sign_(1) {}

	int LargestMobile() const	// returns 0 if no mobile integer exists
	{
		for (int r = values_.size(); r > 0; --r)
		{
			const int loc = positions_[r] + (directions_[r] ? 1 : -1);
			if (loc >= 0 && loc < values_.size() && values_[loc] < r)
				return r;
		}
		return 0;
	}

	bool IsComplete() const { return LargestMobile() == 0; }

	void operator++()	// implement Johnson-Trotter algorithm
	{
		const int r = LargestMobile();
		const int rLoc = positions_[r];
		const int lLoc = rLoc + (directions_[r] ? 1 : -1);
		const int l = values_[lLoc];
		// do the swap
		swap(values_[lLoc], values_[rLoc]);
		swap(positions_[l], positions_[r]);
		sign_ = -sign_;
		// change directions
		for (auto pd = directions_.begin() + r + 1; pd != directions_.end(); ++pd)
			*pd = !*pd;
	}
};

int main(void)
{
	JohnsonTrotterState_ state(4);
	do
	{
		for (auto v : state.values_)
			cout << v << " ";
		cout << "\n";
		++state;
	} while (!state.IsComplete());
}


(defn permutation-swaps
  "List of swap indexes to generate all permutations of n elements"
  [n]
  (if (= n 2) `((0 1))
    (let [old-swaps (permutation-swaps (dec n))
          swaps-> (partition 2 1 (range n))
          swaps<- (reverse swaps->)]
      (mapcat (fn [old-swap side]
                (case side
                  :first swaps<-
                  :right (conj swaps<- old-swap)
                  :left (conj swaps-> (map inc old-swap))))
              (conj old-swaps nil)
              (cons :first (cycle '(:left :right)))))))

(defn swap [v [i j]]
  (-> v
      (assoc i (nth v j))
      (assoc j (nth v i))))

(defn permutations [n]
  (let [permutations (reduce
                       (fn [all-perms new-swap]
                         (conj all-perms (swap (last all-perms)
                                               new-swap)))
                       (vector (vec (range n)))
                       (permutation-swaps n))
        output (map vector
                    permutations
                    (cycle '(1 -1)))]
    output))

(doseq [n [2 3 4]]
  (dorun (map println (permutations n))))


(defstruct (directed-number (:conc-name dn-))
  (number nil :type integer)
  (direction nil :type (member :left :right)))

(defmethod print-object ((dn directed-number) stream)
  (ecase (dn-direction dn)
    (:left  (format stream "<~D" (dn-number dn)))
    (:right (format stream "~D>" (dn-number dn)))))

(defun dn> (dn1 dn2)
  (declare (directed-number dn1 dn2))
  (> (dn-number dn1) (dn-number dn2)))

(defun dn-reverse-direction (dn)
  (declare (directed-number dn))
  (setf (dn-direction dn) (ecase (dn-direction dn)
                            (:left  :right)
                            (:right :left))))

(defun make-directed-numbers-upto (upto)
  (let ((numbers (make-array upto :element-type 'integer)))
    (dotimes (n upto numbers)
      (setf (aref numbers n) (make-directed-number :number (1+ n) :direction :left)))))

(defun max-mobile-pos (numbers)
  (declare ((vector directed-number) numbers))
  (loop with pos-limit = (1- (length numbers))
        with max-value and max-pos
        for num across numbers
        for pos from 0
        do (ecase (dn-direction num)
             (:left  (when (and (plusp pos) (dn> num (aref numbers (1- pos)))
                                (or (null max-value) (dn> num max-value)))
                       (setf max-value num
                             max-pos   pos)))
             (:right (when (and (< pos pos-limit) (dn> num (aref numbers (1+ pos)))
                                (or (null max-value) (dn> num max-value)))
                       (setf max-value num
                             max-pos   pos))))
        finally (return max-pos)))

(defun permutations (upto)
  (loop with numbers = (make-directed-numbers-upto upto)
        for max-mobile-pos = (max-mobile-pos numbers)
        for sign = 1 then (- sign)
        do (format t "~A sign: ~:[~;+~]~D~%" numbers (plusp sign) sign)
        while max-mobile-pos
        do (let ((max-mobile-number (aref numbers max-mobile-pos)))
             (ecase (dn-direction max-mobile-number)
               (:left  (rotatef (aref numbers (1- max-mobile-pos))
                                (aref numbers max-mobile-pos)))
               (:right (rotatef (aref numbers max-mobile-pos)
                                (aref numbers (1+ max-mobile-pos)))))
             (loop for n across numbers
                   when (dn> n max-mobile-number)
                     do (dn-reverse-direction n)))))

(permutations 3)
(permutations 4)


import std.algorithm, std.array, std.typecons, std.range;

struct Spermutations(bool doCopy=true) {
    private immutable uint n;
    alias TResult = Tuple!(int[], int);

    int opApply(in int delegate(in ref TResult) nothrow dg) nothrow {
        int result;

        int sign = 1;
        alias Int2 = Tuple!(int, int);
        auto p = n.iota.map!(i => Int2(i, i ? -1 : 0)).array;
        TResult aux;

        aux[0] = p.map!(pi => pi[0]).array;
        aux[1] = sign;
        result = dg(aux);
        if (result)
            goto END;

        while (p.any!q{ a[1] }) {
            // Failed to use std.algorithm here, too much complex.
            auto largest = Int2(-100, -100);
            int i1 = -1;
            foreach (immutable i, immutable pi; p)
                if (pi[1])
                    if (pi[0] > largest[0]) {
                        i1 = i;
                        largest = pi;
                    }
            immutable n1 = largest[0],
                      d1 = largest[1];

            sign *= -1;
            int i2;
            if (d1 == -1) {
                i2 = i1 - 1;
                p[i1].swap(p[i2]);
                if (i2 == 0 || p[i2 - 1][0] > n1)
                    p[i2][1] = 0;
            } else if (d1 == 1) {
                i2 = i1 + 1;
                p[i1].swap(p[i2]);
                if (i2 == n - 1 || p[i2 + 1][0] > n1)
                    p[i2][1] = 0;
            }

            if (doCopy) {
                aux[0] = p.map!(pi => pi[0]).array;
            } else {
                foreach (immutable i, immutable pi; p)
                    aux[0][i] = pi[0];
            }
            aux[1] = sign;
            result = dg(aux);
            if (result)
                goto END;

            foreach (immutable i3, ref pi; p) {
                immutable n3 = pi[0],
                          d3 = pi[1];
                if (n3 > n1)
                    pi[1] = (i3 < i2) ? 1 : -1;
            }
        }

        END: return result;
    }
}

Spermutations!doCopy spermutations(bool doCopy=true)(in uint n) {
    return typeof(return)(n);
}

version (permutations_by_swapping1) {
    void main() {
        import std.stdio;
        foreach (immutable n; [3, 4]) {
            writefln("\nPermutations and sign of %d items", n);
            foreach (const tp; n.spermutations)
                writefln("Perm: %s  Sign: %2d", tp[]);
        }
    }
}


(lib 'list)

(for/fold (sign 1) ((σ (in-permutations 4)) (count 100))
    (printf "perm: %a count:%4d sign:%4d" σ count sign) (* sign -1))

perm: (0 1 2 3) count:   0 sign:   1
perm: (0 1 3 2) count:   1 sign:  -1
perm: (0 3 1 2) count:   2 sign:   1
perm: (3 0 1 2) count:   3 sign:  -1
perm: (3 0 2 1) count:   4 sign:   1
perm: (0 3 2 1) count:   5 sign:  -1
perm: (0 2 3 1) count:   6 sign:   1
perm: (0 2 1 3) count:   7 sign:  -1
perm: (2 0 1 3) count:   8 sign:   1
perm: (2 0 3 1) count:   9 sign:  -1
perm: (2 3 0 1) count:  10 sign:   1
perm: (3 2 0 1) count:  11 sign:  -1
perm: (3 2 1 0) count:  12 sign:   1
perm: (2 3 1 0) count:  13 sign:  -1
perm: (2 1 3 0) count:  14 sign:   1
perm: (2 1 0 3) count:  15 sign:  -1
perm: (1 2 0 3) count:  16 sign:   1
perm: (1 2 3 0) count:  17 sign:  -1
perm: (1 3 2 0) count:  18 sign:   1
perm: (3 1 2 0) count:  19 sign:  -1
perm: (3 1 0 2) count:  20 sign:   1
perm: (1 3 0 2) count:  21 sign:  -1
perm: (1 0 3 2) count:  22 sign:   1
perm: (1 0 2 3) count:  23 sign:  -1


defmodule Permutation do
  def by_swap(n) do
    p = Enum.to_list(0..-n) |> List.to_tuple
    by_swap(n, p, 1)
  end

  defp by_swap(n, p, s) do
    IO.puts "Perm: #{inspect for i <- 1..n, do: abs(elem(p,i))}  Sign: #{s}"
    k = 0 |> step_up(n, p) |> step_down(n, p)
    if k > 0 do
      pk = elem(p,k)
      i = if pk>0, do: k+1, else: k-1
      p = Enum.reduce(1..n, p, fn i,acc ->
        if abs(elem(p,i)) > abs(pk), do: put_elem(acc, i, -elem(acc,i)), else: acc
      end)
      pi = elem(p,i)
      p = put_elem(p,i,pk) |> put_elem(k,pi)            # swap
      by_swap(n, p, -s)
    end
  end

  defp step_up(k, n, p) do
    Enum.reduce(2..n, k, fn i,acc ->
      if elem(p,i)<0 and abs(elem(p,i))>abs(elem(p,i-1)) and abs(elem(p,i))>abs(elem(p,acc)),
        do: i, else: acc
    end)
  end

  defp step_down(k, n, p) do
    Enum.reduce(1..n-1, k, fn i,acc ->
      if elem(p,i)>0 and abs(elem(p,i))>abs(elem(p,i+1)) and abs(elem(p,i))>abs(elem(p,acc)),
        do: i, else: acc
    end)
  end
end

Enum.each(3..4, fn n ->
  Permutation.by_swap(n)
  IO.puts ""
end)


(*Implement Johnson-Trotter algorithm
  Nigel Galloway January 24th 2017*)
module Ring
let PlainChanges (N:'n[]) = seq{
  let gn  = [|for n in N -> 1|]
  let ni  = [|for n in N -> 0|]
  let gel = Array.length(N)-1
  yield N
  let rec _Ni g e l = seq{
    match (l,g) with
    |_ when l<0   -> gn.[g] <- -gn.[g]; yield! _Ni (g-1) e (ni.[g-1] + gn.[g-1])
    |(1,0)        -> ()
    |_ when l=g+1 -> gn.[g] <- -gn.[g]; yield! _Ni (g-1) (e+1) (ni.[g-1] + gn.[g-1])
    |_ -> let n = N.[g-ni.[g]+e];
          N.[g-ni.[g]+e] <- N.[g-l+e]; N.[g-l+e] <- n; yield N
          ni.[g] <- l; yield! _Ni gel 0 (ni.[gel] + gn.[gel])}
  yield! _Ni gel 0 1
}


S" fsl-util.fs" REQUIRED
S" fsl/dynmem.seq" REQUIRED

cell darray p{

: sgn
  DUP 0 > IF
    DROP 1
  ELSE 0 < IF
    -1
  ELSE
    0
  THEN THEN ;
: arr-swap {: addr1 addr2 | tmp -- :}
  addr1 @ TO tmp
  addr2 @ addr1 !
  tmp addr2 ! ;
: perms {: n xt | my-i k s -- :}
  & p{ n 1+ }malloc malloc-fail? ABORT" perms :: out of memory"
  0 p{ 0 } !
  n 1+ 1 DO
    I NEGATE p{ I } !
  LOOP
  1 TO s
  BEGIN
    1 n 1+ DO
      p{ I } @ ABS
    -1 +LOOP
    n 1+ s xt EXECUTE
    0 TO k
    n 1+ 2 DO
      p{ I } @ 0 < ( flag )
      p{ I } @ ABS  p{ I 1- } @ ABS  > ( flag flag )
      p{ I } @ ABS p{ k } @ ABS > ( flag flag flag )
      AND AND IF
        I TO k
      THEN
    LOOP
    n 1 DO
      p{ I } @ 0 > ( flag )
      p{ I } @ ABS  p{ I 1+ } @ ABS  > ( flag flag )
      p{ I } @ ABS  p{ k } @ ABS  > ( flag flag flag )
      AND AND IF
        I TO k
      THEN
    LOOP
    k IF
      n 1+ 1 DO
        p{ I } @ ABS  p{ k } @ ABS  > IF
          p{ I } @ NEGATE p{ I } !
        THEN
      LOOP
      p{ k } @ sgn k + TO my-i
      p{ k } p{ my-i } arr-swap
      s NEGATE TO s
    THEN
  k 0 = UNTIL ;
: .perm ( p0 p1 p2 ... pn n s )
  >R
  ." Perm: [ "
  1 DO
    . SPACE
  LOOP
  R> ." ] Sign: " . CR ;

3 ' .perm perms CR
4 ' .perm perms


' version 31-03-2017
' compile with: fbc -s console

Sub perms(n As ULong)

    Dim As Long p(n), i, k, s = 1

    For i = 1 To n
        p(i) = -i
    Next

    Do
        Print "Perm: [ ";
        For i = 1 To n
            Print Abs(p(i)); " ";
        Next
        Print "] Sign: "; s

        k = 0
        For i = 2 To n
            If p(i) < 0 Then
                If Abs(p(i)) > Abs(p(i -1)) Then
                    If Abs(p(i)) > Abs(p(k)) Then k = i
                End If
            End If
        Next

        For i = 1 To n -1
            If p(i) > 0 Then
                If Abs(p(i)) > Abs(p(i +1)) Then
                    If Abs(p(i)) > Abs(p(k)) Then k = i
                End If
            End If
        Next

        If k Then
            For  i = 1 To n
                If Abs(p(i)) > Abs(p(k)) Then p(i) = -p(i)
            Next
            i = k + Sgn(p(k))
            Swap p(k), p(i)
            s = -s
        End If

    Loop Until k = 0

End Sub

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

perms(3)
print
perms(4)

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


package permute

// Iter takes a slice p and returns an iterator function.  The iterator
// permutes p in place and returns the sign.  After all permutations have
// been generated, the iterator returns 0 and p is left in its initial order.
func Iter(p []int) func() int {
    f := pf(len(p))
    return func() int {
        return f(p)
    }
}

// Recursive function used by perm, returns a chain of closures that
// implement a loopless recursive SJT.
func pf(n int) func([]int) int {
    sign := 1
    switch n {
    case 0, 1:
        return func([]int) (s int) {
            s = sign
            sign = 0
            return
        }
    default:
        p0 := pf(n - 1)
        i := n
        var d int
        return func(p []int) int {
            switch {
            case sign == 0:
            case i == n:
                i--
                sign = p0(p[:i])
                d = -1
            case i == 0:
                i++
                sign *= p0(p[1:])
                d = 1
                if sign == 0 {
                    p[0], p[1] = p[1], p[0]
                }
            default:
                p[i], p[i-1] = p[i-1], p[i]
                sign = -sign
                i += d
            }
            return sign
        }
    }
}


sPermutations :: [a] -> [([a], Int)]
sPermutations = flip zip (cycle [-1, 1]) . foldr aux [[]]
  where
    aux x items = do
      (f, item) <- zip (repeat id) items
      f (insertEv x item)
    insertEv x [] = [[x]]
    insertEv x l@(y:ys) = (x : l) : ((y :) <$> insertEv x ys)

main :: IO ()
main = do
  putStrLn "3 items:"
  mapM_ print $ sPermutations [1 .. 3]
  putStrLn "\n4 items:"
  mapM_ print $ sPermutations [1 .. 4]


procedure main(A)
    every write("Permutations of length ",n := !A) do
       every p := permute(n) do write("\t",showList(p[1])," -> ",right(p[2],2))
end

procedure permute(n)
    items := [[]]
    every (j := 1 to n, new_items := []) do {
        every item := items[i := 1 to *items] do {
            if *item = 0 then put(new_items, [j])
            else if i%2 = 0 then
                every k := 1 to *item+1 do {
                    new_item := item[1:k] ||| [j] ||| item[k:0]
                    put(new_items, new_item)
                    }
            else
                every k := *item+1 to 1 by -1 do {
                    new_item := item[1:k] ||| [j] ||| item[k:0]
                    put(new_items, new_item)
                    }
            }
       items := new_items
       }
    suspend (i := 0, [!items, if (i+:=1)%2 = 0 then 1 else -1])
end

procedure showList(A)
    every (s := "[") ||:= image(!A)||", "
    return s[1:-2]||"]"
end


package org.rosettacode.java;

import java.util.Arrays;
import java.util.stream.IntStream;

public class HeapsAlgorithm {

	public static void main(String[] args) {
		Object[] array = IntStream.range(0, 4)
				.boxed()
				.toArray();
		HeapsAlgorithm algorithm = new HeapsAlgorithm();
		algorithm.recursive(array);
		System.out.println();
		algorithm.loop(array);
	}

	void recursive(Object[] array) {
		recursive(array, array.length, true);
	}

	void recursive(Object[] array, int n, boolean plus) {
		if (n == 1) {
			output(array, plus);
		} else {
			for (int i = 0; i < n; i++) {
				recursive(array, n - 1, i == 0);
				swap(array, n % 2 == 0 ? i : 0, n - 1);
			}
		}
	}

	void output(Object[] array, boolean plus) {
		System.out.println(Arrays.toString(array) + (plus ? " +1" : " -1"));
	}

	void swap(Object[] array, int a, int b) {
		Object o = array[a];
		array[a] = array[b];
		array[b] = o;
	}

	void loop(Object[] array) {
		loop(array, array.length);
	}

	void loop(Object[] array, int n) {
		int[] c = new int[n];
		output(array, true);
		boolean plus = false;
		for (int i = 0; i < n; ) {
			if (c[i] < i) {
				if (i % 2 == 0) {
					swap(array, 0, i);
				} else {
					swap(array, c[i], i);
				}
				output(array, plus);
				plus = !plus;
				c[i]++;
				i = 0;
			} else {
				c[i] = 0;
				i++;
			}
		}
	}
}


# The helper function, _recurse, is tail-recursive and therefore in
# versions of jq with TCO (tail call optimization) there is no
# overhead associated with the recursion.

def permutations:
  def abs: if . < 0 then -. else . end;
  def sign: if . < 0 then -1 elif . == 0 then 0 else 1 end;
  def swap(i;j): .[i] as $i | .[i] = .[j] | .[j] = $i;

  # input: [ parity, extendedPermutation]
  def _recurse:
    .[0] as $s | .[1] as $p | (($p | length) -1) as $n
    | [ $s, ($p[1:] | map(abs)) ],
      (reduce range(2; $n+1) as $i
         (0;
          if $p[$i] < 0 and -($p[$i]) > ($p[$i-1]|abs) and -($p[$i]) > ($p[.]|abs)
          then $i
          else .
          end)) as $k
      | (reduce range(1; $n) as $i
           ($k;
            if $p[$i] > 0 and $p[$i] > ($p[$i+1]|abs) and $p[$i] > ($p[.]|abs)
            then $i
            else .
            end)) as $k
      | if $k == 0 then empty
        else (reduce range(1; $n) as $i
	       ($p;
                if (.[$i]|abs) > (.[$k]|abs) then .[$i] *= -1
                else .
                end )) as $p
        | ($k + ($p[$k]|sign)) as $i
        | ($p | swap($i; $k)) as $p
        | [ -($s), $p ] | _recurse
        end ;

  . as $in
  | length as $n
  | (reduce range(0; $n+1) as $i ([]; . + [ -$i ])) as $p
  # recurse state: [$s, $p]
  | [ 1, $p] | _recurse
  | .[1] as $p
  | .[1] = reduce range(0; $n) as $i ([]; . + [$in[$p[$i]  - 1]]) ;

def count(stream): reduce stream as $x (0; .+1);


function johnsontrottermove!(ints, isleft)
    len = length(ints)
    function ismobile(pos)
        if isleft[pos] && (pos > 1) && (ints[pos-1] < ints[pos])
            return true
        elseif !isleft[pos] && (pos < len) && (ints[pos+1] < ints[pos])
            return true
        end
        false
    end
    function maxmobile()
        arr = [ints[pos] for pos in 1:len if ismobile(pos)]
        if isempty(arr)
            0, 0
        else
            maxmob = maximum(arr)
            maxmob, findfirst(x -> x == maxmob, ints)
        end
    end
    function directedswap(pos)
        tmp = ints[pos]
        tmpisleft = isleft[pos]
        if isleft[pos]
            ints[pos] = ints[pos-1]; ints[pos-1] = tmp
            isleft[pos] = isleft[pos-1]; isleft[pos-1] = tmpisleft
        else
            ints[pos] = ints[pos+1]; ints[pos+1] = tmp
            isleft[pos] = isleft[pos+1]; isleft[pos+1] = tmpisleft
        end
    end
    (moveint, movepos) = maxmobile()
    if movepos > 0
        directedswap(movepos)
        for (i, val) in enumerate(ints)
            if val > moveint
                isleft[i] = !isleft[i]
            end
        end
        ints, isleft, true
    else
        ints, isleft, false
    end
end
function johnsontrotter(low, high)
    ints = collect(low:high)
    isleft = [true for i in ints]
    firstconfig = copy(ints)
    iters = 0
    while true
        iters += 1
        println("$ints $(iters & 1 == 1 ? "+1" : "-1")")
        if johnsontrottermove!(ints, isleft)[3] == false
            break
        end
    end
    println("There were $iters iterations.")
end
johnsontrotter(1,4)


// version 1.1.2

fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
    val p = IntArray(n) { it }  // permutation
    val q = IntArray(n) { it }  // inverse permutation
    val d = IntArray(n) { -1 }  // direction = 1 or -1
    var sign = 1
    val perms = mutableListOf<IntArray>()
    val signs = mutableListOf<Int>()

    fun permute(k: Int) {
        if (k >= n) {
            perms.add(p.copyOf())
            signs.add(sign)
            sign *= -1
            return
        }
        permute(k + 1)
        for (i in 0 until k) {
            val z = p[q[k] + d[k]]
            p[q[k]] = z
            p[q[k] + d[k]] = k
            q[z] = q[k]
            q[k] += d[k]
            permute(k + 1)
        }
        d[k] *= -1
    }

    permute(0)
    return perms to signs
}

fun printPermsAndSigns(perms: List<IntArray>, signs: List<Int>) {
    for ((i, perm) in perms.withIndex()) {
        println("${perm.contentToString()} -> sign = ${signs[i]}")
    }
}

fun main(args: Array<String>) {
    val (perms, signs) = johnsonTrotter(3)
    printPermsAndSigns(perms, signs)
    println()
    val (perms2, signs2) = johnsonTrotter(4)
    printPermsAndSigns(perms2, signs2)
}


_JT={}
function JT(dim)
  local n={ values={}, positions={}, directions={}, sign=1 }
  setmetatable(n,{__index=_JT})
  for i=1,dim do
    n.values[i]=i
    n.positions[i]=i
    n.directions[i]=-1
  end
  return n
end

function _JT:largestMobile()
  for i=#self.values,1,-1 do
    local loc=self.positions[i]+self.directions[i]
    if loc >= 1 and loc <= #self.values and self.values[loc] < i then
      return i
    end
  end
  return 0
end

function _JT:next()
  local r=self:largestMobile()
  if r==0 then return false end
  local rloc=self.positions[r]
  local lloc=rloc+self.directions[r]
  local l=self.values[lloc]
  self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc]
  self.positions[l],self.positions[r] = self.positions[r],self.positions[l]
  self.sign=-self.sign
  for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end
  return true
end

-- test

perm=JT(4)
repeat
  print(unpack(perm.values))
until not perm:next()


# iterative Boothroyd method
iterator permutations*[T](ys: openarray[T]): tuple[perm: seq[T], sign: int] =
  var
    d = 1
    c = newSeq[int](ys.len)
    xs = newSeq[T](ys.len)
    sign = 1

  for i, y in ys: xs[i] = y
  yield (xs, sign)

  block outter:
    while true:
      while d > 1:
        dec d
        c[d] = 0
      while c[d] >= d:
        inc d
        if d >= ys.len: break outter

      let i = if (d and 1) == 1: c[d] else: 0
      swap xs[i], xs[d]
      sign *= -1
      yield (xs, sign)
      inc c[d]

when isMainModule:
  for i in permutations([0,1,2]):
    echo i

  echo ""

  for i in permutations([0,1,2,3]):
    echo i


/* REXX Compute permutations of things elements       */
/* implementing Heap's algorithm nicely shown in      */
/*   https://en.wikipedia.org/wiki/Heap%27s_algorithm */
/* Recursive Algorithm                                */
Parse Arg things
e.=''
Select
  When things='?' Then
    Call help
  When things='' Then
    things=4
  When words(things)>1 Then Do
    elements=things
    things=words(things)
    Do i=0 By 1 While elements<>''
      Parse Var elements e.i elements
      End
    End
  Otherwise
    If datatype(things)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
  End
n=0
Do i=0 To things-1
  a.i=i
  End
Call generate things
Say time('R') 'seconds'
Exit

generate: Procedure Expose a. n e. things
  Parse Arg k
  If k=1 Then
    Call show
  Else Do
    Call generate k-1
    Do i=0 To k-2
      ka=k-1
      If k//2=0 Then
        Parse Value a.i a.ka With a.ka a.i
      Else
        Parse Value a.0 a.ka With a.ka a.0
      Call generate k-1
      End
    End
  Return

show: Procedure Expose a. n e. things
  n=n+1
  ol=''
  Do i=0 To things-1
    z=a.i
    If e.0<>'' Then
      ol=ol e.z
    Else
      ol=ol z
    End
  Say strip(ol)
  Return
Exit

help:
  Parse Arg msg
  If msg<>'' Then Do
    Say 'ERROR:' msg
    Say ''
    End
  Say 'rexx permx            -> Permutations of 1 2 3 4               '
  Say 'rexx permx 2          -> Permutations of 1 2                   '
  Say 'rexx permx a b c d    -> Permutations of a b c d in 2 positions'
  Exit


#!perl
use strict;
use warnings;

# This code uses "Even's Speedup," as described on
# the Wikipedia page about the Steinhaus–Johnson–
# Trotter algorithm.

# Any resemblance between this code and the Python
# code elsewhere on the page is purely a coincidence,
# caused by them both implementing the same algorithm.

# The code was written to be read relatively easily
# while demonstrating some common perl idioms.

sub perms(&@) {
   my $callback = shift;
   my @perm = map [$_, -1], @_;
   $perm[0][1] = 0;

   my $sign = 1;
   while( ) {
      $callback->($sign, map $_->[0], @perm);
      $sign *= -1;

      my ($chosen, $index) = (-1, -1);
      for my $i ( 0 .. $#perm ) {
         ($chosen, $index) = ($perm[$i][0], $i)
           if $perm[$i][1] and $perm[$i][0] > $chosen;
      }
      return if $index == -1;

      my $direction = $perm[$index][1];
      my $next = $index + $direction;

      @perm[ $index, $next ] = @perm[ $next, $index ];

      if( $next <= 0 or $next >= $#perm ) {
         $perm[$next][1] = 0;
      } elsif( $perm[$next + $direction][0] > $chosen ) {
         $perm[$next][1] = 0;
      }

      for my $i ( 0 .. $next - 1 ) {
         $perm[$i][1] = +1 if $perm[$i][0] > $chosen;
      }
      for my $i ( $next + 1 .. $#perm ) {
         $perm[$i][1] = -1 if $perm[$i][0] > $chosen;
      }
   }
}

my $n = shift(@ARGV) || 4;

perms {
   my ($sign, @perm) = @_;
   print "[", join(", ", @perm), "]";
   print $sign < 0 ? " => -1\n" : " => +1\n";
} 1 .. $n;


function spermutations(integer p, integer i)
--
-- generate the i'th permutation of [1..p]:
-- first obtain the appropriate permutation of [1..p-1],
-- then insert p/move it down k(=0..p-1) places from the end.
--
    sequence res
    integer k = mod(i-1,2*p)
    if k>=p then k=2*p-1-k  end if
    if p>1 then
        res = spermutations(p-1,floor((i-1)/p)+1)
        res = res[1..length(res)-k]&p&res[length(res)-k+1..$]
    else
        res = {1}
    end if
    return res
end function

for p=1 to 4 do
    printf(1,"==%d==\n",p)
    for i=1 to factorial(p) do
        integer parity = iff(and_bits(i,1)?1:-1)
        ?{i,spermutations(p,i),parity}
    end for
end for


(let
   (N 4
      L
      (mapcar
         '((I) (list I 0))
         (range 1 N) ) )
   (for I L
      (printsp (car I)) )
   (prinl)
   (while
      # find the lagest mobile integer
      (setq
         X
         (maxi
            '((I) (car (get L (car I))))
            (extract
               '((I J)
                  (let? Y
                     (get
                        L
                        ((if (=0 (cadr I)) dec inc) J) )
                     (when (> (car I) (car Y))
                        (list J (cadr I)) ) ) )
               L
               (range 1 N) ) )
         Y (get L (car X)) )
      # swap integer and adjacent int it is looking at
      (xchg
         (nth L (car X))
         (nth
            L
            ((if (=0 (cadr X)) dec inc) (car X)) ) )
      # reverse direction of all ints large than our
      (for I L
         (when (< (car Y) (car I))
            (set (cdr I)
               (if (=0 (cadr I)) 1 0) ) ) )
      # print current positions
      (for I L
         (printsp (car I)) )
      (prinl) ) )
(bye)


function output([Object[]]$A, [Int]$k, [ref]$sign)
{
    "Perm: [$([String]::Join(', ', $A))] Sign: $($sign.Value)"
}

function permutation([Object[]]$array)
{
    function generate([Object[]]$A, [Int]$k, [ref]$sign)
    {
        if($k -eq 1)
        {
            output $A $k $sign
            $sign.Value = -$sign.Value
        }
        else
        {
            $k -= 1
            generate $A  $k $sign
            for([Int]$i = 0; $i -lt $k; $i += 1)
             {
                if($i % 2 -eq 0)
                {
                    $A[$i], $A[$k] = $A[$k], $A[$i]
                }
                else
                {
                    $A[0], $A[$k] = $A[$k], $A[0]
                }
                generate $A $k $sign
            }
        }
    }
    generate $array $array.Count ([ref]1)
}
permutation @(0, 1, 2)
""
permutation @(0, 1, 2, 3)


from operator import itemgetter

DEBUG = False # like the built-in __debug__

def spermutations(n):
    """permutations by swapping. Yields: perm, sign"""
    sign = 1
    p = [[i, 0 if i == 0 else -1] # [num, direction]
         for i in range(n)]

    if DEBUG: print ' #', p
    yield tuple(pp[0] for pp in p), sign

    while any(pp[1] for pp in p): # moving
        i1, (n1, d1) = max(((i, pp) for i, pp in enumerate(p) if pp[1]),
                           key=itemgetter(1))
        sign *= -1
        if d1 == -1:
            # Swap down
            i2 = i1 - 1
            p[i1], p[i2] = p[i2], p[i1]
            # If this causes the chosen element to reach the First or last
            # position within the permutation, or if the next element in the
            # same direction is larger than the chosen element:
            if i2 == 0 or p[i2 - 1][0] > n1:
                # The direction of the chosen element is set to zero
                p[i2][1] = 0
        elif d1 == 1:
            # Swap up
            i2 = i1 + 1
            p[i1], p[i2] = p[i2], p[i1]
            # If this causes the chosen element to reach the first or Last
            # position within the permutation, or if the next element in the
            # same direction is larger than the chosen element:
            if i2 == n - 1 or p[i2 + 1][0] > n1:
                # The direction of the chosen element is set to zero
                p[i2][1] = 0
        if DEBUG: print ' #', p
        yield tuple(pp[0] for pp in p), sign

        for i3, pp in enumerate(p):
            n3, d3 = pp
            if n3 > n1:
                pp[1] = 1 if i3 < i2 else -1
                if DEBUG: print ' # Set Moving'

if __name__ == '__main__':
    from itertools import permutations

    for n in (3, 4):
        print '\nPermutations and sign of %i items' % n
        sp = set()
        for i in spermutations(n):
            sp.add(i[0])
            print('Perm: %r Sign: %2i' % i)
            #if DEBUG: raw_input('?')
        # Test
        p = set(permutations(range(n)))
        assert sp == p, 'Two methods of generating permutations do not agree'


#lang racket

(define (add-at l i x)
  (if (zero? i) (cons x l) (cons (car l) (add-at (cdr l) (sub1 i) x))))

(define (permutations l)
  (define (loop l)
    (cond [(null? l) '(())]
          [else (for*/list ([(p i) (in-indexed (loop (cdr l)))]
                            [i ((if (odd? i) identity reverse)
                                (range (add1 (length p))))])
                  (add-at p i (car l)))]))
  (for/list ([p (loop (reverse l))] [i (in-cycle '(1 -1))]) (cons i p)))

(define (show-permutations l)
  (printf "Permutations of ~s:\n" l)
  (for ([p (permutations l)])
    (printf "  ~a (~a)\n" (apply ~a (add-between (cdr p) ", ")) (car p))))

(for ([n (in-range 3 5)]) (show-permutations (range n)))


sub insert($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. +@xs) }
sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }

multi perms([]) {
    [] => +1
}

multi perms([$x, *@xs]) {
    perms(@xs).map({ |order($_.value, insert($x, $_.key)) }) Z=> |(+1,-1) xx *
}

.say for perms([0..2]);


/*REXX program  generates all  permutations  of   N   different objects by  swapping.   */
parse arg things bunch .                         /*obtain optional arguments from the CL*/
if things=='' | things==","  then things=4       /*Not specified?  Then use the default.*/
if bunch =='' | bunch ==","  then bunch =things  /* "      "         "   "   "     "    */
call permSets things, bunch                      /*invoke permutations by swapping sub. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!:        procedure;  !=1;        do j=2  to arg(1);    !=!*j;     end;           return !
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y               /*take   X  things   Y   at a time.    */
          !.=0;      pad=left('', x*y)           /*X can't be > length of below str (62)*/
          z=left('123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', x);  q=z
          #=1                                    /*the number of permutations  (so far).*/
          !.z=1;    s=1;   times=!(x) % !(x-y)   /*calculate (#) TIMES  using factorial.*/
          w=max(length(z), length('permute') )   /*maximum width of  Z and also PERMUTE.*/
          say center('permutations for '   x   ' things taken '   y   " at a time",60,'═')
          say
          say   pad    'permutation'       center("permute", w, '─')         "sign"
          say   pad    '───────────'       center("───────", w, '─')         "────"
          say   pad    center(#, 11)       center(z        , w)              right(s, 4-1)

             do $=1   until  #==times            /*perform permutation until # of times.*/
               do   k=1    for x-1               /*step thru things for  things-1 times.*/
                 do m=k+1  to  x;      ?=        /*this method doesn't use  adjacency.  */
                     do n=1  for x               /*build the new permutation by swapping*/
                     if n\==k & n\==m  then               ? =  ?  ||  substr(z, n, 1)
                                       else if n==k  then ? =  ?  ||  substr(z, m, 1)
                                                     else ? =  ?  ||  substr(z, k, 1)
                     end   /*n*/
                 z=?                             /*save this permutation for next swap. */
                 if !.?  then iterate m          /*if defined before, then try next one.*/
                 _=0                             /* [↓]  count number of swapped symbols*/
                    do d=1  for x  while $\==1;  _= _ + (substr(?,d,1)\==substr(prev,d,1))
                    end   /*d*/
                 if _>2  then do;        _=z
                              a=$//x+1;  q=q + _ /* [← ↓]  this swapping tries adjacency*/
                              b=q//x+1;  if b==a  then b=a + 1;       if b>x  then b=a - 1
                              z=overlay( substr(z,b,1), overlay( substr(z,a,1), _, b),  a)
                              iterate $          /*now, try this particular permutation.*/
                              end
                 #=#+1;  s= -s;   say pad   center(#, 11)    center(?, w)    right(s, 4-1)
                 !.?=1;  prev=?;      iterate $  /*now, try another swapped permutation.*/
                 end   /*m*/
               end     /*k*/
             end       /*$*/
          return                                 /*we're all finished with permutating. */


def perms(n)
  p = Array.new(n+1){|i| -i}
  s = 1
  loop do
    yield p[1..-1].map(&:abs), s
    k = 0
    for i in 2..n
      k = i if p[i] < 0 and p[i].abs > p[i-1].abs and p[i].abs > p[k].abs
    end
    for i in 1...n
      k = i if p[i] > 0 and p[i].abs > p[i+1].abs and  p[i].abs > p[k].abs
    end
    break if k.zero?
    for i in 1..n
      p[i] *= -1 if p[i].abs > p[k].abs
    end
    i = k + (p[k] <=> 0)
    p[k], p[i] = p[i], p[k]
    s = -s
  end
end

for i in 3..4
  perms(i){|perm, sign| puts "Perm: #{perm}  Sign: #{sign}"}
  puts
end


// Implementation of Heap's algorithm.
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
fn generate<T, F>(a: &mut [T], output: F)
where
    F: Fn(&[T], isize),
{
    let n = a.len();
    let mut c = vec![0; n];
    let mut i = 1;
    let mut sign = 1;
    output(a, sign);
    while i < n {
        if c[i] < i {
            if (i & 1) == 0 {
                a.swap(0, i);
            } else {
                a.swap(c[i], i);
            }
            sign = -sign;
            output(a, sign);
            c[i] += 1;
            i = 1;
        } else {
            c[i] = 0;
            i += 1;
        }
    }
}

fn print_permutation<T: std::fmt::Debug>(a: &[T], sign: isize) {
    println!("{:?} {}", a, sign);
}

fn main() {
    println!("Permutations and signs for three items:");
    let mut a = vec![0, 1, 2];
    generate(&mut a, print_permutation);

    println!("\nPermutations and signs for four items:");
    let mut b = vec![0, 1, 2, 3];
    generate(&mut b, print_permutation);
}


object JohnsonTrotter extends App {

  private def perm(n: Int): Unit = {
    val p = new Array[Int](n) // permutation
    val pi = new Array[Int](n) // inverse permutation
    val dir = new Array[Int](n) // direction = +1 or -1

    def perm(n: Int, p: Array[Int], pi: Array[Int], dir: Array[Int]): Unit = {
      if (n >= p.length) for (aP <- p) print(aP)
      else {
        perm(n + 1, p, pi, dir)
        for (i <- 0 until n) { // swap
          printf("   (%d %d)\n", pi(n), pi(n) + dir(n))
          val z = p(pi(n) + dir(n))
          p(pi(n)) = z
          p(pi(n) + dir(n)) = n
          pi(z) = pi(n)
          pi(n) = pi(n) + dir(n)
          perm(n + 1, p, pi, dir)
        }
        dir(n) = -dir(n)
      }
    }

    for (i <- 0 until n) {
      dir(i) = -1
      p(i) = i
      pi(i) = i
    }
    perm(0, p, pi, dir)
    print("   (0 1)\n")
  }

  perm(4)

}


func perms(n) {
   var perms = [[+1]]
   for x in (1..n) {
      var sign = -1
      perms = gather {
        for s,*p in perms {
          var r = (0 .. p.len)
          take((s < 0 ? r : r.flip).map {|i|
            [sign *= -1, p[^i], x, p[i..p.end]]
          }...)
        }
      }
   }
   perms
}

var n = 4
for p in perms(n) {
    var s = p.shift
    s > 0 && (s = '+1')
    say "#{p} => #{s}"
}


// Implementation of Heap's algorithm.
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
func generate<T>(array: inout [T], output: (_: [T], _: Int) -> Void) {
    let n = array.count
    var c = Array(repeating: 0, count: n)
    var i = 1
    var sign = 1
    output(array, sign)
    while i < n {
        if c[i] < i {
            if (i & 1) == 0 {
                array.swapAt(0, i)
            } else {
                array.swapAt(c[i], i)
            }
            sign = -sign
            output(array, sign)
            c[i] += 1
            i = 1
        } else {
            c[i] = 0
            i += 1
        }
    }
}

func printPermutation<T>(array: [T], sign: Int) {
    print("\(array) \(sign)")
}

print("Permutations and signs for three items:")
var a = [0, 1, 2]
generate(array: &a, output: printPermutation)

print("\nPermutations and signs for four items:")
var b = [0, 1, 2, 3]
generate(array: &b, output: printPermutation)


# A simple swap operation
proc swap {listvar i1 i2} {
    upvar 1 $listvar l
    set tmp [lindex $l $i1]
    lset l $i1 [lindex $l $i2]
    lset l $i2 $tmp
}

proc permswap {n v1 v2 body} {
    upvar 1 $v1 perm $v2 sign

    # Initialize
    set sign -1
    for {set i 0} {$i < $n} {incr i} {
	lappend items $i
	lappend dirs -1
    }

    while 1 {
	# Report via callback
	set perm $items
	set sign [expr {-$sign}]
	uplevel 1 $body

	# Find the largest mobile integer (lmi) and its index (idx)
	set i [set idx -1]
	foreach item $items dir $dirs {
	    set j [expr {[incr i] + $dir}]
	    if {$j < 0 || $j >= [llength $items]} continue
	    if {$item > [lindex $items $j] && ($idx == -1 || $item > $lmi)} {
		set lmi $item
		set idx $i
	    }
	}

	# If none, we're done
	if {$idx == -1} break

	# Swap the largest mobile integer with "what it is looking at"
	set nextIdx [expr {$idx + [lindex $dirs $idx]}]
	swap items $idx $nextIdx
	swap dirs $idx $nextIdx

	# Reverse directions on larger integers
	set i -1
	foreach item $items dir $dirs {
	    lset dirs [incr i] [expr {$item > $lmi ? -$dir : $dir}]
	}
    }
}


var johnsonTrotter = Fn.new { |n|
    var p = List.filled(n, 0)  // permutation
    var q = List.filled(n, 0)  // inverse permutation
    for (i in 0...n) p[i] = q[i] = i
    var d = List.filled(n, -1) // direction = 1 or -1
    var sign = 1
    var perms = []
    var signs = []

    var permute // recursive closure
    permute = Fn.new { |k|
        if (k >= n) {
            perms.add(p.toList)
            signs.add(sign)
            sign = sign * -1
            return
        }
        permute.call(k + 1)
        for (i in 0...k) {
            var z = p[q[k] + d[k]]
            p[q[k]] = z
            p[q[k] + d[k]] = k
            q[z] = q[k]
            q[k] = q[k] + d[k]
            permute.call(k + 1)
        }
        d[k] = d[k] * -1
    }
    permute.call(0)
    return [perms, signs]
}

var printPermsAndSigns = Fn.new { |perms, signs|
    var i = 0
    for (perm in perms) {
        System.print("%(perm) -> sign = %(signs[i])")
        i = i + 1
    }
}

var res = johnsonTrotter.call(3)
var perms = res[0]
var signs = res[1]
printPermsAndSigns.call(perms, signs)
System.print()
res = johnsonTrotter.call(4)
perms = res[0]
signs = res[1]
printPermsAndSigns.call(perms, signs)


include c:\cxpl\codes;

proc PERMS(N);
int  N;                         \number of elements
int  I, K, S, T, P;
[P:= Reserve((N+1)*4);
for I:= 0 to N do P(I):= -I;    \initialize facing left (also set P(0)=0)
S:= 1;
repeat  Text(0, "Perm: [ ");
        for I:= 1 to N do
                [IntOut(0, abs(P(I)));  ChOut(0, ^ )];
        Text(0, "] Sign: ");  IntOut(0, S);  CrLf(0);

        K:= 0;                  \find largest mobile element
        for I:= 2 to N do                         \for left-facing elements
            if P(I) < 0 and
                abs(P(I)) > abs(P(I-1)) and       \ greater than neighbor
                abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
        for I:= 1 to N-1 do                       \for right-facing elements
            if P(I) > 0 and
                abs(P(I)) > abs(P(I+1)) and       \ greater than neighbor
                abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
        if K # 0 then           \mobile element found
           [for I:= 1 to N do   \reverse elements > K
                if abs(P(I)) > abs(P(K)) then P(I):= P(I)*-1;
            I:= K + (if P(K)<0 then -1 else 1);
            T:= P(K);  P(K):= P(I);  P(I):= T;    \swap K with element looked at
            S:= -S;             \alternate signs
            ];
until   K = 0;                  \no mobile element remains
];

[PERMS(3);
CrLf(0);
PERMS(4);
]


fcn permute(seq)
{
   insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
      (0).pump(list.len()+1,List,'wrap(n){list[0,n].extend(x,list[n,*]) })};
   insertEverywhereB := fcn(x,t){ //--> insertEverywhere().reverse()
      [t.len()..-1,-1].pump(t.len()+1,List,'wrap(n){t[0,n].extend(x,t[n,*])})};

   seq.reduce('wrap(items,x){
      f := Utils.Helpers.cycle(insertEverywhereB,insertEverywhere);
      items.pump(List,'wrap(item){f.next()(x,item)},
	      T.fp(Void.Write,Void.Write));
   },T(T));
}