SIMSET
BEGIN

    LINK CLASS LOF_INT(N); INTEGER N;;

    LINK CLASS LOF_LOF_INT(H); REF(HEAD) H;;

    REF(HEAD) PROCEDURE MAP(P_LI, P_LLI);
        REF(HEAD) P_LI;
        REF(HEAD) P_LLI;
    BEGIN
        REF(HEAD) V_RESULT;
        V_RESULT :- NEW HEAD;
        IF NOT P_LLI.EMPTY THEN BEGIN
            REF(LOF_LOF_INT) V_LLI;
            V_LLI :- P_LLI.FIRST QUA LOF_LOF_INT;
            WHILE V_LLI =/= NONE DO BEGIN
                REF(HEAD) V_NEWLIST;
                V_NEWLIST :- NEW HEAD;
                ! ADD THE SAME 1ST ELEMENT TO EVERY NEWLIST ;
                NEW LOF_INT(P_LI.FIRST QUA LOF_INT.N).INTO(V_NEWLIST);
                IF NOT V_LLI.H.EMPTY THEN BEGIN
                    REF(LOF_INT) V_LI;
                    V_LI :- V_LLI.H.FIRST QUA LOF_INT;
                    WHILE V_LI =/= NONE DO BEGIN
                        NEW LOF_INT(V_LI.N).INTO(V_NEWLIST);
                        V_LI :- V_LI.SUC;
                    END;
                END;
                NEW LOF_LOF_INT(V_NEWLIST).INTO(V_RESULT);
                V_LLI :- V_LLI.SUC;
            END;
        END;
        MAP :- V_RESULT;
    END MAP;

    REF(HEAD) PROCEDURE SUBSETS(P_LI);
        REF(HEAD) P_LI;
    BEGIN
        REF(HEAD) V_RESULT;
        IF P_LI.EMPTY THEN BEGIN
            V_RESULT :- NEW HEAD;
            NEW LOF_LOF_INT(NEW HEAD).INTO(V_RESULT);
        END ELSE BEGIN
            REF(HEAD) V_SUBSET, V_MAP;
            REF(LOF_INT) V_LI;
            V_SUBSET :- NEW HEAD;
            V_LI :- P_LI.FIRST QUA LOF_INT;
            ! SKIP OVER 1ST ELEMENT ;
            IF V_LI =/= NONE THEN V_LI :- V_LI.SUC;
            WHILE V_LI =/= NONE DO BEGIN
                NEW LOF_INT(V_LI.N).INTO(V_SUBSET);
                V_LI :- V_LI.SUC;
            END;
            V_RESULT :- SUBSETS(V_SUBSET);
            V_MAP :- MAP(P_LI, V_RESULT);
            IF NOT V_MAP.EMPTY THEN BEGIN
                REF(LOF_LOF_INT) V_LLI;
                V_LLI :- V_MAP.FIRST QUA LOF_LOF_INT;
                WHILE V_LLI =/= NONE DO BEGIN
                    NEW LOF_LOF_INT(V_LLI.H).INTO(V_RESULT);
                    V_LLI :- V_LLI.SUC;
                END;
            END;
        END;
        SUBSETS :- V_RESULT;
    END SUBSETS;

    PROCEDURE PRINT_LIST(P_LI); REF(HEAD) P_LI;
    BEGIN
        OUTTEXT("[");
        IF NOT P_LI.EMPTY THEN BEGIN
            INTEGER I;
            REF(LOF_INT) V_LI;
            I := 0;
            V_LI :- P_LI.FIRST QUA LOF_INT;
            WHILE V_LI =/= NONE DO BEGIN
                IF I > 0 THEN OUTTEXT(",");
                OUTINT(V_LI.N, 0);
                V_LI :- V_LI.SUC;
                I := I+1;
            END;
        END;
        OUTTEXT("]");
    END PRINT_LIST;

    PROCEDURE PRINT_LIST_LIST(P_LLI); REF(HEAD) P_LLI;
    BEGIN
        OUTTEXT("[");
        IF NOT P_LLI.EMPTY THEN BEGIN
            INTEGER I;
            REF(LOF_LOF_INT) V_LLI;
            I := 0;
            V_LLI :- P_LLI.FIRST QUA LOF_LOF_INT;
            WHILE V_LLI =/= NONE DO BEGIN
                IF I > 0 THEN BEGIN
                    OUTTEXT(",");
                !   OUTIMAGE;
                END;
                PRINT_LIST(V_LLI.H);
                V_LLI :- V_LLI.SUC;
                I := I+1;
            END;
        END;
        OUTTEXT("]");
        OUTIMAGE;
    END PRINT_LIST_LIST;

    INTEGER N;
    REF(HEAD) V_RANGE;
    REF(HEAD) V_LISTS;

    V_RANGE :- NEW HEAD;
    V_LISTS :- SUBSETS(V_RANGE);
    PRINT_LIST_LIST(V_LISTS);
    OUTIMAGE;
    FOR N := 1 STEP 1 UNTIL 4 DO BEGIN
        NEW LOF_INT(N).INTO(V_RANGE);
        V_LISTS :- SUBSETS(V_RANGE);
        PRINT_LIST_LIST(V_LISTS);
        OUTIMAGE;
    END;
END.


Collection extend [
    power [
        ^(0 to: (1 bitShift: self size) - 1) readStream collect: [ :each || i |
            i := 0.
            self select: [ :elem | (each bitAt: (i := i + 1)) = 1 ] ]
    ]
].


fun subsets xs = foldr (fn (x, rest) => rest @ map (fn ys => x::ys) rest) [[]] xs


def isPrime = {
    it == 2 ||
    it > 1 &&
    (2..Math.max(2, (int) Math.sqrt(it))).every{ k -> it % k != 0 }
}

(0..20).grep(isPrime)


isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5..floor.sqrt.fromIntegral $ n+1])


func powersetFrom<T>(_ elements: Set<T>) -> Set<Set<T>> {
  guard elements.count > 0 else {
    return [[]]
  }
  var powerset: Set<Set<T>> = [[]]
  for element in elements {
    for subset in powerset {
      powerset.insert(subset.union([element]))
    }
  }
  return powerset
}

// Example:
powersetFrom([1, 2, 4])


proc subsets {l} {
    set res [list [list]]
    foreach e $l {
        foreach subset $res {lappend res [lappend subset $e]}
    }
    return $res
}
puts [subsets {a b c d}]


(defun power-set (s)
  (mappend* (op comb s) (range 0 (length s))))


   DO n = 1, 1E6
     Euler = n^2 + n + 41
     IF( Prime(Euler) == 0 ) WRITE(Messagebox) Euler, ' is NOT prime for n =', n
   ENDDO                            ! e.g.    1681 = 40^2 + 40 + 41 is NOT prime
END

FUNCTION Prime(number)
   Prime = number == 2
   IF( (number > 2) * MOD(number,2) ) THEN
     DO i = 3, number^0.5, 2
       IF(MOD(number,i) == 0) THEN
         Prime = 0
         RETURN
       ENDIF
     ENDDO
     Prime = 1
   ENDIF
END


procedure isprime(n)                            #: return n if prime (using trial division) or fail
if not n = integer(n) | n < 2 then fail         # ensure n is an integer greater than 1
every if 0 = (n % (2 to sqrt(n))) then fail
return n
end


p() { [ $# -eq 0 ] && echo || (shift; p "[email protected]") | while read r ; do echo -e "$1 $r\n$r"; done }


| cat A
a
b
c

| cat A |\
   xargs -n 1 ksh -c 'echo \{`cat A`\}' |\
   xargs |\
   sed -e 's; ;,;g' \
       -e 's;^;echo ;g' \
       -e 's;\},;}\\ ;g' |\
   ksh |unfold `wc -l A` |\
   xargs -n1 -I{} ksh -c 'echo {} |\
        unfold 1 |sort -u |xargs' |sort -u

a
a b
a b c
a c
b
b c
c


powerset = ~&NiC+ ~&i&& ~&at^?\~&aNC ~&ahPfatPRXlNrCDrT


public static boolean prime(long a){
   if(a == 2){
      return true;
   }else if(a <= 1 || a % 2 == 0){
      return false;
   }
   long max = (long)Math.sqrt(a);
   for(long n= 3; n <= max; n+= 2){
      if(a % n == 0){ return false; }
   }
   return true;
}


[A C E] powerlist
=[[A C E] [A C] [A E] [A] [C E] [C] [E] []]


Option Base 1
Private Function power_set(ByRef st As Collection) As Collection
    Dim subset As Collection, pwset As New Collection
    For i = 0 To 2 ^ st.Count - 1
        Set subset = New Collection
        For j = 1 To st.Count
            If i And 2 ^ (j - 1) Then subset.Add st(j)
        Next j
        pwset.Add subset
    Next i
    Set power_set = pwset
End Function
Private Function print_set(ByRef st As Collection) As String
    'assume st is a collection of collections, holding integer variables
    Dim s() As String, t() As String
    ReDim s(st.Count)
    'Debug.Print "{";
    For i = 1 To st.Count
        If st(i).Count > 0 Then
            ReDim t(st(i).Count)
            For j = 1 To st(i).Count
                Select Case TypeName(st(i)(j))
                    Case "Integer": t(j) = CStr(st(i)(j))
                    Case "Collection": t(j) = "{}" 'assumes empty
                End Select
            Next j
            s(i) = "{" & Join(t, ", ") & "}"
        Else
            s(i) = "{}"
        End If
    Next i
    print_set = "{" & Join(s, ", ") & "}"
End Function
Public Sub rc()
    Dim rcset As New Collection, result As Collection
    For i = 1 To 4
        rcset.Add i
    Next i
    Debug.Print print_set(power_set(rcset))
    Set rcset = New Collection
    Debug.Print print_set(power_set(rcset))
    Dim emptyset As New Collection
    rcset.Add emptyset
    Debug.Print print_set(power_set(rcset))
    Debug.Print
End Sub


function isPrime(n) {
  if (n == 2 || n == 3 || n == 5 || n == 7) {
    return true;
  } else if ((n < 2) || (n % 2 == 0)) {
    return false;
  } else {
    for (var i = 3; i <= Math.sqrt(n); i += 2) {
      if (n % i == 0)
        return false;
    }
    return true;
  }
}


DEFINE prime ==
        2
        [ [dup * >] nullary  [rem 0 >] dip  and ]
        [ succ ]
        while
        dup * < .


Function Dec2Bin(n)
	q = n
	Dec2Bin = ""
	Do Until q = 0
		Dec2Bin = CStr(q Mod 2) & Dec2Bin
		q = Int(q / 2)
	Loop
	Dec2Bin = Right("00000" & Dec2Bin,6)
End Function

Function PowerSet(s)
	arrS = Split(s,",")
	PowerSet = "{"
	For i = 0 To 2^(UBound(arrS)+1)-1
		If i = 0 Then
			PowerSet = PowerSet & "{},"
		Else
			binS = Dec2Bin(i)
			PowerSet = PowerSet & "{"
			c = 0
			For j = Len(binS) To 1 Step -1
				If CInt(Mid(binS,j,1)) = 1 Then
					PowerSet = PowerSet & arrS(c) & ","
				End If
				c = c + 1
			Next
			PowerSet = Mid(PowerSet,1,Len(PowerSet)-1) & "},"
		End If
	Next
	PowerSet = Mid(PowerSet,1,Len(PowerSet)-1) & "}"
End Function

WScript.StdOut.Write PowerSet("1,2,3,4")


import "./perm" for Powerset

var sets  = [ [1, 2, 3, 4], [], [[]] ]
for (set in sets) {
    System.print("The power set of %(set) is:")
    System.print(Powerset.list(set))
    System.print()
}


function isprime_trialdivision{T<:Integer}(n::T)
    1 < n || return false
    n != 2 || return true
    isodd(n) || return false
    for i in 3:isqrt(n)
        n%i != 0 || return false
    end
    return true
end

n = 100
a = filter(isprime_trialdivision, [1:n])

if all(a .== primes(n))
    println("The primes <= ", n, " are:\n    ", a)
else
    println("The function does not accurately calculate primes.")
end


func PowSet(Set, Size);
int  Set, Size;
int  N, M, Mask, DoComma;
[ChOut(0, ^{);
for N:= 0 to 1<<Size -1 do
    [if N>0 then ChOut(0, ^,);
    ChOut(0, ^{);
    Mask:= 1;  DoComma:= false;
    for M:= 0 to Size-1 do
        [if Mask & N then
            [if DoComma then ChOut(0, ^,);
            IntOut(0, Set(M));
            DoComma:= true;
            ];
        Mask:= Mask << 1;
        ];
    ChOut(0, ^});
    ];
Text(0, "}^m^j");
];

[PowSet([2, 3, 5, 7], 4);
 PowSet([1], 1);
 PowSet(0, 0);
]


fcn pwerSet(list){
  (0).pump(list.len(),List, Utils.Helpers.pickNFrom.fp1(list),
     T(Void.Write,Void.Write) ) .append(list)
}


// version 1.1.2
fun isPrime(n: Int): Boolean {
    if (n < 2) return false
    if (n % 2 == 0) return n == 2
    val limit = Math.sqrt(n.toDouble()).toInt()
    return (3..limit step 2).none { n % it == 0 }
}

fun main(args: Array<String>) {
    // test by printing all primes below 100 say
    (2..99).filter { isPrime(it) }.forEach { print("$it ") }
}


val .isPrime = f(.i) {
    val .n = abs(.i)
    if .n <= 2: return .n == 2

    val .chkdiv = f(.n, .i) {
        if .i x .i <= .n {
            return .n ndiv .i and self(.n, .i+2)
        }
        return true
    }

    return .n ndiv 2 and .chkdiv(.n, 3)
}

writeln where .isPrime, series 100


function Convert-PriceFraction
{
    [CmdletBinding()]
    [OutputType([double])]
    Param
    (
        [Parameter(Mandatory=$true,
                   ValueFromPipeline=$true,
                   ValueFromPipelineByPropertyName=$true,
                   Position=0)]
        [ValidateScript({$_ -ge 0.0 -and $_ -le 1.0})]
        [double]
        $InputObject
    )

    Process
    {
        foreach ($fraction in $InputObject)
        {
            switch ($fraction)
            {
                {$_ -lt 0.06} {0.10; break}
                {$_ -lt 0.11} {0.18; break}
                {$_ -lt 0.16} {0.26; break}
                {$_ -lt 0.21} {0.32; break}
                {$_ -lt 0.26} {0.38; break}
                {$_ -lt 0.31} {0.44; break}
                {$_ -lt 0.36} {0.50; break}
                {$_ -lt 0.41} {0.54; break}
                {$_ -lt 0.46} {0.58; break}
                {$_ -lt 0.51} {0.62; break}
                {$_ -lt 0.56} {0.66; break}
                {$_ -lt 0.61} {0.70; break}
                {$_ -lt 0.66} {0.74; break}
                {$_ -lt 0.71} {0.78; break}
                {$_ -lt 0.76} {0.82; break}
                {$_ -lt 0.81} {0.86; break}
                {$_ -lt 0.86} {0.90; break}
                {$_ -lt 0.91} {0.94; break}
                {$_ -lt 0.96} {0.98; break}
                Default       {1.00}
            }
        }
    }
}


print "Rosetta Code - Primality by trial division"
print
[start]
input "Enter an integer: "; x
if x=0 then print "Program complete.": end
if isPrime(x) then print x; " is prime" else print x; " is not prime"
goto [start]

function isPrime(p)
    p=int(abs(p))
    if p=2 or then isPrime=1: exit function 'prime
    if p=0 or p=1 or (p mod 2)=0 then exit function 'not prime
    for i=3 to sqr(p) step 2
        if (p mod i)=0 then exit function 'not prime
    next i
    isPrime=1
end function


on isPrime (n)
    if n<=1 or (n>2 and n mod 2=0) then return FALSE
    sq = sqrt(n)
    repeat with i = 3 to sq
        if n mod i = 0 then return FALSE
    end repeat
    return TRUE
end


Procedure.f PriceFraction(price.f)
  ;returns price unchanged if value is invalid
  Protected fraction
  Select price * 100
    Case 0 To 5
      fraction = 10
    Case 06 To 10
      fraction = 18
    Case 11 To 15
      fraction = 26
    Case 16 To 20
      fraction = 32
    Case 21 To 25
      fraction = 38
    Case 26 To 30
      fraction = 44
    Case 31 To 35
      fraction = 5
    Case 36 To 40
      fraction = 54
    Case 41 To 45
      fraction = 58
    Case 46 To 50
      fraction = 62
    Case 51 To 55
      fraction = 66
    Case 56 To 60
      fraction = 7
    Case 61 To 65
      fraction = 74
    Case 66 To 70
      fraction = 78
    Case 71 To 75
      fraction = 82
    Case 76 To 80
      fraction = 86
    Case 81 To 85
      fraction = 9
    Case 86 To 90
      fraction = 94
    Case 91 To 95
      fraction = 98
    Case 96 To 100
      fraction = 100
    Default
      ProcedureReturn price
  EndSelect

  ProcedureReturn fraction / 100
EndProcedure

If OpenConsole()
  Define x.f, i

  For i = 1 To 10
    x = Random(10000)/10000
    PrintN(StrF(x, 4) + " -> " + StrF(PriceFraction(x), 2))
  Next

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


to prime? :n
   if :n < 2 [output "false]
   if :n = 2 [output "true]
   if equal? 0 modulo :n 2 [output "false]
   for [i 3 [sqrt :n] 2] [if equal? 0 modulo :n :i [output "false]]
   output "true
end


over : 2 pick
 2dup : over over
 even? : 1 & 0 =

 # trial n d yields "n d 0/1 false" or "n d+2 true"
 trial : 2 +                 true
 trial : 2dup % 0 =   then 0 false
 trial : 2dup dup * < then 1 false
 trial-loop : trial &repeat

 # prime? n yields flag
 prime? : 3 trial-loop >flag drop drop
 prime? : dup even? then drop false
 prime? : dup 2 =   then drop true
 prime? : dup 2 <   then drop false


function IsPrime( n )
    if n <= 1 or ( n ~= 2 and n % 2 == 0 ) then
        return false
    end

    for i = 3, math.sqrt(n), 2 do
	if n % i == 0 then
  	    return false
	end
    end

    return true
end


[ $ 'bigrat.qky' loadfile ] now!

[ 2over 2over v< if 2swap 2drop ] is vmax  ( n/d n/d --> n/d )

[ 100 1 v* 1 1 v-
  0 1 vmax 5 1 v/ /
  [ table
    10 18 26 32 38
    44 50 54 58 62
    66 70 74 78 82
    86 90 94 98 100 ] 100 ]       is scale ( n/d     --> n/d )

[ swap echo sp echo ]             is br    ( n/d     -->     )

[ 2dup br say ' --> '
  scale br cr ]                   is test  ( n/d     -->     )

0 100 test
50 100 test
65 100 test
66 100 test
100 100 test
7368 10000 test

( Show how to enter and display results as a decimal too. )
$ '0.7368' dup echo$
say ' --> '
$->v drop scale
2 point$ echo$


      Inventory [email protected], [email protected]
      IsPrime=lambda  Known1 (x as decimal) -> {
            =0=1
            if exist(Known1, x) then =1=1 : exit
            if x<=5 OR frac(x) then {if x == 2 OR x == 3 OR x == 5 then Append Known1, x  : =1=1
            Break}
            if frac(x/2) else exit
            if frac(x/3) else exit
            x1=sqrt(x):d = [email protected]
            {if frac(x/d ) else exit
                  d += 2: if d>x1 then Append Known1, x : =1=1 : exit
                  if frac(x/d) else exit
                  d += 4: if d<= x1 else Append Known1, x :  =1=1: exit
             loop}
      }

      i=2
      While Len(Known1)<20 {
            dummy=Isprime(i)
            i++
      }
      Print "first ";len(known1);" primes"
      Print Known1
      Print "From 110 to 130"
      count=0
      For i=110 to 130 {
            If isPrime(i) Then Print i, : count++
      }
      Print
      Print "Found ";count;" primes"


TrialDivision := proc( n :: integer )
        if n <= 1 then
                false
        elif n = 2 then
                true
        elif type( n, 'even' ) then
                false
        else
                for local i from 3 by 2 while i * i <= n do
                        if irem( n, i ) = 0 then
                                return false
                        end if
                end do;
                true
        end if
end proc:


IsPrime[n_Integer] := Block[{},
  If[n <= 1, Return[False]];
  If[n == 2, Return[True]]; If[Mod[n, 2] == 0, Return[False]];
  For[k = 3, k <= Sqrt[n], k += 2, If[Mod[n, k] == 0, Return[False]]];
  Return[True]]


function isPrime = primalityByTrialDivision(n)

    if n == 2
        isPrime = true;
        return
    elseif (mod(n,2) == 0) || (n <= 1)
        isPrime = false;
        return
    end

    %First n mod (3 to sqrt(n)) is taken. This will be a vector where the
    %first element is equal to n mod 3 and the last element is equal to n
    %mod sqrt(n). Then the all function is applied to that vector. If all
    %of the elements of this vector are non-zero (meaning n is prime) then
    %all() returns true. Otherwise, n is composite, so it returns false.
    %This return value is then assigned to the variable isPrime.
    isPrime = all(mod(n, (3:round(sqrt(n))) ));

end


isprme(n):= catch(
  for k: 2 thru sqrt(n) do if mod(n, k)=0 then throw(false),
  true);

map(isprme, [2, 3, 4, 65, 100, 181, 901]);
/* [true, true, false, false, false, true, false] */


/*REXX program re─scales a (decimal fraction)  price  (in the range of:   0¢  ──►  $1). */
pad= '     '                                     /*for inserting spaces into a message. */
          do j=0  to 1  by .01                   /*process the prices from 0¢  to  ≤ $1 */
          if j==0  then j= 0.00                  /*handle the special case of zero cents*/
          say pad  'original price ──►'    j   pad   adjPrice(j)     " ◄── adjusted price"
          end   /*j*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
adjPrice: procedure;  parse arg ?                /*a table is used to facilitate changes*/
                                     select
                                     when ?<0.06  then ?= 0.10
                                     when ?<0.11  then ?= 0.18
                                     when ?<0.16  then ?= 0.26
                                     when ?<0.21  then ?= 0.32
                                     when ?<0.26  then ?= 0.38
                                     when ?<0.31  then ?= 0.44
                                     when ?<0.36  then ?= 0.50
                                     when ?<0.41  then ?= 0.54
                                     when ?<0.46  then ?= 0.58
                                     when ?<0.51  then ?= 0.62
                                     when ?<0.56  then ?= 0.66
                                     when ?<0.61  then ?= 0.70
                                     when ?<0.66  then ?= 0.74
                                     when ?<0.71  then ?= 0.78
                                     when ?<0.76  then ?= 0.82
                                     when ?<0.81  then ?= 0.86
                                     when ?<0.86  then ?= 0.90
                                     when ?<0.91  then ?= 0.94
                                     when ?<0.96  then ?= 0.98
                                     when ?<1.01  then ?= 1.00
                                     otherwise    nop
                                     end   /*select*/
          return ?


(
  :n 3 :i n sqrt :m true :p
  (i m <=) (
    (n i mod 0 ==) (m @i false @p) when
    i 2 + @i
  ) while p
) :_prime?  ; helper function

(
  (
    ((2 <) (false))
    ((dup even?) (2 ==))
    ((true) (_prime?))
  ) case
) :prime?


ISPRIME(N)
 QUIT:(N=2) 1
 NEW I,R
 SET R=N#2
 IF R FOR I=3:2:(N**.5) SET R=N#I Q:'R
 KILL I
 QUIT R


see pricefraction(0.5)

func pricefraction n
     if n < 0.06 return 0.10 ok
     if n < 0.11 return 0.18 ok
     if n < 0.16 return 0.26 ok
     if n < 0.21 return 0.32 ok
     if n < 0.26 return 0.38 ok
     if n < 0.31 return 0.44 ok
     if n < 0.36 return 0.50 ok
     if n < 0.41 return 0.54 ok
     if n < 0.46 return 0.58 ok
     if n < 0.51 return 0.62 ok
     if n < 0.56 return 0.66 ok
     if n < 0.61 return 0.70 ok
     if n < 0.66 return 0.74 ok
     if n < 0.71 return 0.78 ok
     if n < 0.76 return 0.82 ok
     if n < 0.81 return 0.86 ok
     if n < 0.86 return 0.90 ok
     if n < 0.91 return 0.94 ok
     if n < 0.96 return 0.98 ok
     return 1


def rescale_price_fraction(value)
  raise ArgumentError, "value=#{value}, must have: 0 <= value < 1.01" if value < 0 || value >= 1.01
  if     value < 0.06  then  0.10
  elsif  value < 0.11  then  0.18
  elsif  value < 0.16  then  0.26
  elsif  value < 0.21  then  0.32
  elsif  value < 0.26  then  0.38
  elsif  value < 0.31  then  0.44
  elsif  value < 0.36  then  0.50
  elsif  value < 0.41  then  0.54
  elsif  value < 0.46  then  0.58
  elsif  value < 0.51  then  0.62
  elsif  value < 0.56  then  0.66
  elsif  value < 0.61  then  0.70
  elsif  value < 0.66  then  0.74
  elsif  value < 0.71  then  0.78
  elsif  value < 0.76  then  0.82
  elsif  value < 0.81  then  0.86
  elsif  value < 0.86  then  0.90
  elsif  value < 0.91  then  0.94
  elsif  value < 0.96  then  0.98
  elsif  value < 1.01  then  1.00
  end
end


/* NetRexx */

options replace format comments java crossref savelog symbols nobinary

parse arg nbr rangeBegin rangeEnd .

if nbr = '' | nbr = '.' then do
  if rangeBegin = '' | rangeBegin = '.' then rangeBegin = 1
  if rangeEnd   = '' | rangeEnd   = '.' then rangeEnd   = 100
  if rangeEnd > rangeBegin then direction = 1
                           else direction = -1

  say 'List of prime numbers from' rangeBegin 'to' rangeEnd':'
  primes = ''
  loop nn = rangeBegin to rangeEnd by direction
    if isPrime(nn) then primes = primes nn
    end nn
    primes = primes.strip
    say '  'primes.changestr(' ', ',')
    say '  Total number of primes:' primes.words
  end
else do
  if isPrime(nbr) then say nbr.right(20) 'is prime'
                  else say nbr.right(20) 'is not prime'
  end

return

method isPrime(nbr = long) public static binary returns boolean

  ip = boolean

  select
    when nbr < 2 then do
      ip = isFalse
      end
    when '2 3 5 7'.wordpos(Rexx(nbr)) \= 0 then do
      -- crude shortcut ripped from the Rexx example
      ip = isTrue
      end
    when  nbr // 2 == 0 | nbr // 3 == 0 then do
      -- another shortcut permitted by the one above
      ip = isFalse
      end
    otherwise do
      nn = long
      nnStartTerm = long 3 -- a reasonable start term - nn <= 2 is never prime
      nnEndTerm = long Math.ceil(Math.sqrt(nbr)) -- a reasonable end term
      ip = isTrue -- prime the pump (pun intended)
      loop nn = nnStartTerm to nnEndTerm by 2
         -- Note: in Rexx and NetRexx "//" is the 'remainder of division operator' (which is not the same as modulo)
        if nbr // nn = 0 then do
          ip = isFalse
          leave nn
          end
        end nn
      end
    end

  return ip

method isTrue public static returns boolean
  return 1 == 1

method isFalse public static returns boolean
  return \isTrue


; Here are some simpler functions to help us:

(define (divisible? larger-number smaller-number)
	(zero? (% larger-number smaller-number)))

(define (int-root number)
	(floor (sqrt number)))

(define (even-prime? number)
	(= number 2))

; Trial division for odd numbers

(define (find-odd-factor? odd-number)
	(catch
		(for (possible-factor 3 (int-root odd-number) 2)
			(if (divisible? odd-number possible-factor)
				(throw true)))))

(define (odd-prime? number)
	(and
		(odd? number)
		(or
			(= number 3)
			(and
				(> number 3)
				(not (find-odd-factor? number))))))

; Now for the final overall Boolean function.

(define (is-prime? possible-prime)
	(or
		(even-prime? possible-prime)
		(odd-prime? possible-prime)))

; Let's use this to actually find some prime numbers.

(println (filter is-prime? (sequence 1 100)))
(exit)


import sequtils, math

proc prime(a: int): bool =
  if a == 2: return true
  if a < 2 or a mod 2 == 0: return false
  for i in countup(3, sqrt(a.float).int, 2):
    if a mod i == 0:
      return false
  return true

proc prime2(a: int): bool =
  result = not (a < 2 or any(toSeq(2 .. sqrt(a.float).int), a mod it == 0))

proc prime3(a: int): bool =
  if a == 2: return true
  if a < 2 or a mod 2 == 0: return false
  return not any(toSeq countup(3, sqrt(a.float).int, 2), a mod it == 0)

for i in 2..30:
  echo i, " ", prime(i)


function : IsPrime(n : Int) ~ Bool {
  if(n <= 1) {
    return false;
  };

  for(i := 2; i * i <= n; i += 1;) {
    if(n % i = 0) {
      return false;
    };
  };

  return true;
}


let is_prime n =
  if n = 2 then true
  else if n < 2 || n mod 2 = 0 then false
  else
    let rec loop k =
      if k * k > n then true
      else if n mod k = 0 then false
      else loop (k+2)
    in loop 3


def priceFraction(x:Double)=x match {
   case n if n>=0 && n<0.06 => 0.10
   case n if n<0.11 => 0.18
   case n if n<0.36 => ((((n*100).toInt-11)/5)*6+26)/100.toDouble
   case n if n<0.96 => ((((n*100).toInt-31)/5)*4+50)/100.toDouble
   case _ => 1.00
}

def testPriceFraction()=
   for(n <- 0.00 to (1.00, 0.01)) println("%.2f  %.2f".format(n, priceFraction(n)))


function b = isthisprime(n)
  for r = 1:rows(n)
    for c = 1:columns(n)
      b(r,c) = false;
      if ( n(r,c) == 2 )
	b(r,c) = true;
      elseif ( (n(r,c) < 2) || (mod(n(r,c),2) == 0) )
	b(r,c) = false;
      else
	b(r,c) = true;
	for i = 3:2:sqrt(n(r,c))
	  if ( mod(n(r,c), i) == 0 )
	    b(r,c) = false;
	    break;
	  endif
	endfor
      endif
    endfor
  endfor
endfunction

% as test, print prime numbers from 1 to 100
p = [1:100];
pv = isthisprime(p);
disp(p( pv ));


Integer method: isPrime
| i |
   self 1 <= ifTrue: [ false return ]
   self 3 <= ifTrue: [ true return ]
   self isEven ifTrue: [ false return ]
   3 self sqrt asInteger for: i [ self i mod ifzero: [ false return ] ]
   true ;


$ include "seed7_05.s7i";
  include "float.s7i";

const func float: computePrice (in float: x) is func
  result
    var float: price is 0.0;
  begin
    if x >= 0.0 and x < 0.06 then
      price := 0.10;
    elsif x < 0.11 then
      price := 0.18;
    elsif x < 0.36 then
      price := flt(((trunc(x * 100.0) - 11) div 5) * 6 + 26) / 100.0;
    elsif x < 0.96 then
      price := flt(((trunc(x * 100.0) - 31) div 5) * 4 + 50) / 100.0;
    else
      price := 1.0;
    end if;
  end func;

const proc: main is func
  local
    var integer: i is 0;
  begin
    for i range 0 to 100 do
      writeln(flt(i) / 100.0 digits 2 <& " " <& computePrice(flt(i) / 100.0) digits 2);
    end for;
  end func;


(define (prime? number)
   (define max (sqrt number))
   (define (loop divisor)
      (or (> divisor max)
          (and (> (modulo number divisor) 0)
               (loop (+ divisor 2)))))
   (or (= number 1)
       (= number 2)
       (and
          (> (modulo number 2) 0)
          (loop 3))))


   fun {Prime N}
      local IPrime in
	 fun {IPrime N Acc}
	    if N < Acc*Acc then true
	    elseif (N mod Acc) == 0 then false
	    else {IPrime N Acc+1}
	    end
	 end
	 if N < 2 then false
	 else {IPrime N 2} end
      end
   end


fun prime(p) type integer->integer
  p.gt(1) where q=p.sqrt NO(p.mod(2..q)==0)

1..100.prime


trial(n)={
  if(n < 4, return(n > 1)); /* Handle negatives */
  forprime(p=2,sqrtint(n),
    if(n%p == 0, return(0))
  );
  1
};


program primes;

function prime(n: integer): boolean;
var
  i: integer; max: real;
begin
  if n = 2 then
    prime := true
  else if (n <= 1) or (n mod 2 = 0) then
    prime := false
  else begin
    prime := true; i := 3; max := sqrt(n);
    while i <= max do begin
      if n mod i = 0 then begin
        prime := false; exit
      end;
      i := i + 2
    end
  end
end;

{ Test and display primes 0 .. 50 }
var
  n: integer;
begin
  for n := 0 to 50 do
    if (prime(n)) then
      write(n, ' ');
end.


# Used once to turn the table into a "nice" form
proc parseTable table {
    set map {}
    set LINE_RE {^ *>= *([0-9.]+) *< *([0-9.]+) *:= *([0-9.]+) *$}
    foreach line [split $table \n] {
	if {[string trim $line] eq ""} continue
	if {[regexp $LINE_RE $line -> min max target]} {
	    lappend map $min $max $target
	} else {
	    error "invalid table format: $line"
	}
    }
    return $map
}

# How to apply the "nice" table to a particular value
proc priceFraction {map value} {
    foreach {minimum maximum target} $map {
	if {$value >= $minimum && $value < $maximum} {return $target}
    }
    # Failed to map; return the input
    return $value
}


sub prime { my $n = shift || $_;
    $n % $_ or return for 2 .. sqrt $n;
    $n > 1
}

print join(', ' => grep prime, 1..100), "\n";


function is_prime_by_trial_division(integer n)
    if n<2 then return 0 end if
    if n=2 then return 1 end if
    if remainder(n,2)=0 then return 0 end if
    for i=3 to floor(sqrt(n)) by 2 do
        if remainder(n,i)=0 then
            return 0
        end if
    end for
    return 1
end function
?filter(tagset(32),is_prime_by_trial_division)


For i = 0 To 100 Step 5
  Print Using "+?.##"; i, Using "+?.##"; FUNC(_Normalize (FUNC(_Classify (i))))
Next

End

_Normalize                             ' normalize the price
  Param (1)                            ' class
  Local (4)                            ' accumulator, increment, switch and iterator

  [email protected] = 0 : [email protected] = 10 : [email protected] = 2            ' setup accumulator, increment and switch

  For [email protected] = 0 to [email protected]                     ' from zero to class
    If And([email protected] + 1, [email protected]) Then [email protected] = And([email protected] + [email protected], 15) : [email protected] = [email protected] - 2
    [email protected] = [email protected] + [email protected]                       ' switch increment if needed
  Next                                 ' accumulate price
Return (Min([email protected], 100))                  ' clip top of price in accumulator
                                       ' calculate class
_Classify Param (1) : Return (([email protected] - ([email protected]>0)) / 5)


<?php
function prime($a) {
  if (($a % 2 == 0 && $a != 2) || $a < 2)
    return false;
  $limit = sqrt($a);
  for ($i = 2; $i <= $limit; $i++)
    if ($a % $i == 0)
      return false;
  return true;
}

foreach (range(1, 100) as $x)
  if (prime($x)) echo "$x\n";

?>


is_prime1(N) =>
  if N == 2 then
    true
  elseif N <= 1 ; N mod 2 == 0 then
    false
  else
    foreach(I in 3..2..ceiling(sqrt(N)))
       N mod I > 0
    end
  end.


Function pf(p)
    If p < 0.06 Then
        pf = 0.10
    ElseIf p < 0.11 Then
    	pf = 0.18
    ElseIf p < 0.16 Then
    	pf = 0.26
    ElseIf p < 0.21 Then
    	pf = 0.32
    ElseIf p < 0.26 Then
    	pf = 0.38
    ElseIf p < 0.31 Then
    	pf = 0.44
    ElseIf p < 0.36 Then
    	pf = 0.50
    ElseIf p < 0.41 Then
    	pf = 0.54
    ElseIf p < 0.46 Then
    	pf = 0.58
    ElseIf p < 0.51 Then
    	pf = 0.62
    ElseIf p < 0.56 Then
    	pf = 0.66
    ElseIf p < 0.61 Then
    	pf = 0.70
    ElseIf p < 0.66 Then
    	pf = 0.74
    ElseIf p < 0.71 Then
    	pf = 0.78
    ElseIf p < 0.76 Then
    	pf = 0.82
    ElseIf p < 0.81 Then
    	pf = 0.86
    ElseIf p < 0.86 Then
    	pf = 0.90
    ElseIf p < 0.91 Then
    	pf = 0.94
    ElseIf p < 0.96 Then
    	pf = 0.98
    Else
    	pf = 1.00
    End If
End Function

WScript.Echo pf(0.7388727)
WScript.Echo pf(0.8593103)
WScript.Echo pf(0.826687)
WScript.Echo pf(0.3444635)


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;


100H: /* TEST FOR PRIMALITY BY TRIAL DIVISION                                */

   DECLARE FALSE LITERALLY '0', TRUE LITERALLY '0FFH';
   /* CP/M BDOS SYSTEM CALL                                                  */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C );  END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S );  END;
   PR$NL:     PROCEDURE; CALL PR$STRING( .( 0DH, 0AH, '$' ) );       END;
   PR$NUMBER: PROCEDURE( N );
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
      N$STR( W := LAST( N$STR ) ) = '$';
      N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PR$STRING( .N$STR( W ) );
   END PR$NUMBER;
   /* INTEGER SUARE ROOT: BASED ON THE ONE IN THE PL/M FOR FROBENIUS NUMBERS */
   SQRT: PROCEDURE( N )ADDRESS;
      DECLARE ( N, X0, X1 ) ADDRESS;
      IF N <= 3 THEN DO;
          IF N = 0 THEN X0 = 0; ELSE X0 = 1;
          END;
      ELSE DO;
         X0 = SHR( N, 1 );
         DO WHILE( ( X1 := SHR( X0 + ( N / X0 ), 1 ) ) < X0 );
            X0 = X1;
         END;
      END;
      RETURN X0;
   END SQRT;

   IS$PRIME: PROCEDURE( N )BYTE; /* RETURNS TRUE IF N IS PRIME, FALSE IF NOT */
      DECLARE N ADDRESS;
      IF N < 2 THEN RETURN FALSE;
      ELSE IF ( N AND 1 ) = 0 THEN RETURN N = 2;
      ELSE DO;
         /* ODD NUMBER > 2                                                   */
         DECLARE I ADDRESS;
         DO I = 3 TO SQRT( N ) BY 2;
            IF N MOD I = 0 THEN RETURN FALSE;
         END;
         RETURN TRUE;
      END;
   END IS$PRIME;

   /* TEST THE IS$PRIME PROCEDURE                                            */
   DECLARE I ADDRESS;
   DO I = 0 TO 100;
      IF IS$PRIME( I ) THEN DO;
         CALL PR$CHAR( ' ' );
         CALL PR$NUMBER( I );
      END;
   END;
   CALL PR$NL;

EOF


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)
    }
}
1..15 | foreach{"isPrime $_ : $(isPrime $_)"}


prime(2).
prime(N) :-
  between(3, inf, N),
  1 is N mod 2,             % odd
  M is floor(sqrt(N+1)),    % round-off paranoia
  Max is (M-1) // 2,        % integer division
  forall( between(1, Max, I), N mod (2*I+1) > 0 ).


Procedure.i IsPrime(n)
   Protected k

   If n = 2
      ProcedureReturn #True
   EndIf

   If n <= 1 Or n % 2 = 0
      ProcedureReturn #False
   EndIf

   For k = 3 To Int(Sqr(n)) Step 2
      If n % k = 0
         ProcedureReturn #False
      EndIf
   Next

   ProcedureReturn #True
EndProcedure


def prime(a):
    return not (a < 2 or any(a % x == 0 for x in xrange(2, int(a**0.5) + 1)))


(define prime?-0
  K N -> true where (> (* K K) N)
  K N -> false where (= 0 (MOD N K))
  K N -> (prime?-0 (+ K 2) N))

(define prime?
  1 -> false
  2 -> true
  N -> false where (= 0 (MOD N 2))
  N -> (prime?-0 3 N))


  [ dup 4 < iff [ 1 > ] done
    dup 1 & not iff [ drop false ] done
    true swap dup sqrt
    0 = iff [ 2drop not ] done
    1 >> times
      [ dup i^ 1 << 3 + mod 0 = if
          [ dip not conclude ] ]
    drop ]                              is isprime ( n --> b )


isPrime <- function(n) {
  if (n == 2) return(TRUE)
  if ( (n <= 1) || ( n %% 2 == 0 ) ) return(FALSE)
  for( i in 3:sqrt(n) ) {
    if ( n %% i == 0 ) return(FALSE)
  }
  TRUE
}


#lang racket

(define (prime? number)
  (cond ((not (positive? number)) #f)
        ((= 1 number) #f)
        ((even? number) (= 2 number))
        (else (for/and ((i (in-range 3 (ceiling (sqrt number)))))
                (not (zero? (remainder number i)))))))


sub prime (Int $i --> Bool) {
    $i > 1 and so $i %% none 2..$i.sqrt;
}


prime?: func [n] [
    case [
        n = 2 [ true  ]
        n <= 1 or (n // 2 = 0) [ false ]
        true [
            for i 3 round square-root n 2 [
                if n // i = 0 [ return false ]
            ]
            true
        ]
    ]
]


/*REXX program tests for  primality by using  (kinda smartish)  trial division.         */
parse arg n .;  if n==''  then n=10000           /*let the user choose the upper limit. */
tell=(n>0);     n=abs(n)                         /*display the primes  only if   N > 0. */
p=0                                              /*a count of the primes found (so far).*/
      do j=-57  to n                             /*start in the cellar and work up.     */
      if \isPrime(j)  then iterate               /*if not prime,  then keep looking.    */
      p=p+1                                      /*bump the jelly bean counter.         */
      if tell  then say right(j,20) 'is prime.'  /*maybe display prime to the terminal. */
      end   /*j*/
say
say  "There are "      p       " primes up to "        n        ' (inclusive).'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPrime: procedure;    parse arg x                       /*get the number to be tested. */
         if wordpos(x, '2 3 5 7')\==0  then return 1     /*is number a teacher's pet?   */
         if x<2 | x//2==0 | x//3==0    then return 0     /*weed out the riff-raff.      */
            do k=5  by  6  until k*k>x                   /*skips odd multiples of  3.   */
            if x//k==0 | x//(k+2)==0   then return 0     /*a pair of divides.      ___  */
            end   /*k*/                                  /*divide up through the  √ x   */
                                                         /*Note:  //   is  ÷  remainder.*/
         return 1                                        /*done dividing, it's prime.   */


give n
flag = isPrime(n)
if flag = 1 see n + " is a prime number"
else see n + " is not a prime number" ok

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


def prime(a)
  if a == 2
    true
  elsif a <= 1 || a % 2 == 0
    false
  else
    divisors = (3..Math.sqrt(a)).step(2)
    divisors.none? { |d| a % d == 0 }
  end
end
p (1..50).select{|i| prime(i)}


' Test and display primes 1 .. 50
for i = 1 TO 50
  if prime(i) <> 0 then print i;" ";
next i

FUNCTION prime(n)
if n < 2         then prime = 0 : goto [exit]
if n = 2         then prime = 1 : goto [exit]
if n mod 2 = 0   then prime = 0 : goto [exit]
prime = 1
for i = 3 to int(n^.5) step 2
 if n mod i = 0 then  prime = 0 : goto [exit]
next i
[exit]
END FUNCTION


fn is_prime(n: u64) -> bool {
    match n {
        0 | 1 => false,
        2 => true,
        _even if n % 2 == 0 => false,
        _ => {
            let sqrt_limit = (n as f64).sqrt() as u64;
            (3..=sqrt_limit).step_by(2).find(|i| n % i == 0).is_none()
        }
    }
}

fn main() {
    for i in (1..30).filter(|i| is_prime(*i)) {
        println!("{} ", i);
    }
}


$lines

$constant FALSE = 0
$constant TRUE = 0FFFFH

rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p / q)

rem - return true (-1) if n is prime, otherwise false (0)
function isprime(n = integer) = integer
  var i, limit, result = integer
  if n = 2 then
    result = TRUE
  else if (n < 2) or (mod(n,2) = 0) then
    result = FALSE
  else
    begin
      limit = int(sqr(n))
      i = 3
      while (i <= limit) and (mod(n, i) <> 0) do
        i = i + 2
      result = not (i <= limit)
    end
end = result

rem - test by looking for primes in range 1 to 50
var i = integer
for i = 1 to 50
  if isprime(i) then print using "#####";i;
next i

end


define is_prime(n)
{
   if (n == 2) return(1);
   if (n <= 1) return(0);
   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 ptest()
{
   variable lst = {};

   _for $1 (1, 64, 1)
     if (is_prime($1))
       list_append(lst, string($1));
   print(strjoin(list_to_array(lst), ", "));
}
ptest();


data primes;
do n=1 to 1000;
  link primep;
  if primep then output;
end;
stop;

primep:
if n < 4 then do;
  primep=n=2 or n=3;
  return;
end;
primep=0;
if mod(n,2)=0 then return;
do k=3 to sqrt(n) by 2;
  if mod(n,k)=0 then return;
end;
primep=1;
return;
keep n;
run;


  def isPrime(n: Int) =
    n > 1 && (Iterator.from(2) takeWhile (d => d * d <= n) forall (n % _ != 0))


(define (prime? number)
  (define (*prime? divisor)
    (or (> (* divisor divisor) number)
        (and (> (modulo number divisor) 0)
             (*prime? (+ divisor 1)))))
  (and (> number 1)
       (*prime? 2)))


const func boolean: isPrime (in integer: number) is func
  result
    var boolean: prime is FALSE;
  local
    var integer: upTo is 0;
    var integer: testNum is 3;
  begin
    if number = 2 then
      prime := TRUE;
    elsif odd(number) and number > 2 then
      upTo := sqrt(number);
      while number rem testNum <> 0 and testNum <= upTo do
        testNum +:= 2;
      end while;
      prime := testNum > upTo;
    end if;
  end func;


func is_prime(a) {
  given (a) {
    when (2)                   { true  }
    case (a <= 1 || a.is_even) { false }
    default                    { 3 .. a.isqrt -> any { .divides(a) } -> not }
  }
}


| isPrime |
isPrime := [:n |
    n even ifTrue: [ ^n=2 ]
    ifFalse: [
        3 to: n sqrt do: [:i |
            (n \\ i = 0) ifTrue: [ ^false ]
        ].
        ^true
    ]
]


define('isprime(n)i,max') :(isprime_end)
isprime isprime = n
        le(n,1) :s(freturn)
        eq(n,2) :s(return)
        eq(remdr(n,2),0) :s(freturn)
        max = sqrt(n); i = 1
isp1    i = le(i + 2,max) i + 2 :f(return)
        eq(remdr(n,i),0) :s(freturn)f(isp1)
isprime_end


declare @number int
set @number = 514229 -- number to check

;with cte(number) as
(
 select 2
 union all
 select number+1
 from cte
 where number+1 < @number
)
select
      cast(@number as varchar(100)) +
      case
          when exists
				  (
					select *
					from
					(
						select number, @number % number modNumber
						from cte
					) tmp
					where tmp.modNumber = 0
				  )
				          then ' is composite'
		  else
						 ' is prime'
	  end primalityTest
option (maxrecursion 0)


fun is_prime n =
  if n = 2 then true
  else if n < 2 orelse n mod 2 = 0 then false
  else let
    fun loop k =
      if k * k > n then true
      else if n mod k = 0 then false
      else loop (k+2)
    in loop 3
  end


import Foundation

extension Int {
  func isPrime() -> Bool {

    switch self {
    case let x where x < 2:
      return false
    case 2:
      return true
    default:
      return
        self % 2 != 0 &&
        !stride(from: 3, through: Int(sqrt(Double(self))), by: 2).contains {self % $0 == 0}
    }
  }
}


proc is_prime n {
    if {$n <= 1} {return false}
    if {$n == 2} {return true}
    if {$n % 2 == 0} {return false}
    for {set i 3} {$i <= sqrt($n)} {incr i 2} {
        if {$n % $i == 0} {return false}
    }
    return true
}


Prompt A
If A=2:Then
Disp "PRIME"
Stop
End

If (fPart(A/2)=0 and A>0) or A<2:Then
Disp "NOT PRIME"
Stop
End

1→P
For(B,3,int(√(A)))
If FPart(A/B)=0:Then
0→P
√(A)→B
End
B+1→B
End

If P=1:Then
Disp "PRIME"
Else
Disp "NOT PRIME"
End


    PRINT "ENTER A NUMBER "
    INPUT P
    GOSUB 100
    IF Z = 1 THEN PRINT "It is prime."
    IF Z = 0 THEN PRINT "It isn't prime."
    END

100 REM PRIMALITY OF THE NUMBER P BY TRIAL DIVISION
    IF P < 2 THEN RETURN
    LET Z = 1
    IF P < 4 THEN RETURN
    LET I = 2
110 IF (P/I)*I = P THEN LET Z = 0
    IF Z = 0 THEN RETURN
    LET I = I + 1
    IF I*I <= P THEN GOTO 110
    RETURN


10 LET n=0: LET p=0
20 INPUT "Enter number: ";n
30 LET p=0 : IF n>1 THEN GOSUB 1000
40 IF p=0 THEN PRINT n;" is not prime!"
50 IF p#0 THEN PRINT n;" is prime!"
60 GOTO 10
1000 REM ***************
1001 REM * PRIME CHECK *
1002 REM ***************
1010 LET p=0
1020 IF (n%2)=0 THEN RETURN
1030 LET p=1 : PUSH n,0 : GOSUB 9030
1040 FOR i=3 TO POP() STEP 2
1050 IF (n%i)=0 THEN LET p=0: PUSH n,0 : GOSUB 9030 : LET i=POP()
1060 NEXT i
1070 RETURN
9030 Push ((10^(Pop()*2))*Pop()) : @(255)=Tos()
9040 Push (@(255) + (Tos()/@(255)))/2
     If Abs(@(255)-Tos())<2 Then @(255)=Pop() : If Pop() Then Push @(255) : Return
     @(255) = Pop() : Goto 9040
     REM ** This is an integer SQR subroutine. Output is scaled by 10^(TOS()).


function primep {
	typeset n=$1 p=3
	(( n == 2 )) && return 0	# 2 is prime.
	(( n & 1 )) || return 1		# Other evens are not prime.
	(( n >= 3 )) || return 1

	# Loop for odd p from 3 to sqrt(n).
	# Comparing p * p <= n can overflow.
	while (( p <= n / p )); do
		# If p divides n, then n is not prime.
		(( n % p )) || return 1
		(( p += 2 ))
	done
	return 0	# Yes, n is prime.
}


#import std
#import nat

prime = ~<{0,1}&& -={2,3}!| ~&h&& (all remainder)^Dtt/~& [email protected]


[prime?
     2
     [[dup * >] [true] [false] ifte [% 0 >] dip and]
       [succ]
     while
     dup * <].


Option Explicit

Sub FirstTwentyPrimes()
Dim count As Integer, i As Long, t(19) As String
   Do
      i = i + 1
      If IsPrime(i) Then
         t(count) = i
         count = count + 1
      End If
   Loop While count <= UBound(t)
   Debug.Print Join(t, ", ")
End Sub

Function IsPrime(Nb As Long) As Boolean
   If Nb = 2 Then
      IsPrime = True
   ElseIf Nb < 2 Or Nb Mod 2 = 0 Then
      Exit Function
   Else
      Dim i As Long
      For i = 3 To Sqr(Nb) Step 2
         If Nb Mod i = 0 Then Exit Function
      Next
      IsPrime = True
   End If
End Function


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

For n = 1 To 50
	If IsPrime(n) Then
		WScript.StdOut.Write n & " "
	End If
Next


import "/fmt" for Fmt

var isPrime = Fn.new { |n|
    if (n < 2) return false
    if (n%2 == 0) return n == 2
    var p = 3
    while (p * p <= n) {
        if (n%p == 0) return false
        p = p + 2
    }
    return true
}

var tests = [2, 5, 12, 19, 57, 61, 97]
System.print("Are the following prime?")
for (test in tests) {
    System.print("%(Fmt.d(2, test)) -> %(isPrime.call(test) ? "yes" : "no")")
}


func Prime(N);          \Return 'true' if N is a prime number
int  N;
int  I;
[if N <= 1 then return false;
for I:= 2 to sqrt(N) do
        if rem(N/I) = 0 then return false;
return true;
];

int  Num;
repeat  Num:= IntIn(0);
        Text(0, if Prime(Num) then "is " else "not ");
        Text(0, "prime^M^J");
until   Num = 0


for i = 1 to 99
    if isPrime(i)  print str$(i), " ";
next i
print
end

sub isPrime(v)
    if v < 2  return False
    if mod(v, 2) = 0  return v = 2
    if mod(v, 3) = 0  return v = 3
    d = 5
    while d * d <= v
        if mod(v, d) = 0 then return False else d = d + 2 : fi
    wend
    return True
end sub


fcn isPrime(n){
   if(n.isEven or n<2) return(n==2);
   (not [3..n.toFloat().sqrt().toInt(),2].filter1('wrap(m){n%m==0}))
}


F average(arr)
   R sum(arr) / Float(arr.len)

F poly_regression(x, y)
   V xm = average(x)
   V ym = average(y)
   V x2m = average(x.map(i -> i * i))
   V x3m = average(x.map(i -> i ^ 3))
   V x4m = average(x.map(i -> i ^ 4))
   V xym  = average(zip(x, y).map((i, j) -> i * j))
   V x2ym = average(zip(x, y).map((i, j) -> i * i * j))
   V sxx = x2m - xm * xm
   V sxy = xym - xm * ym
   V sxx2 = x3m - xm * x2m
   V sx2x2 = x4m - x2m * x2m
   V sx2y = x2ym - x2m * ym
   V b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
   V c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
   V a = ym - b * xm - c * x2m

   F abc(xx)
      R (@a + @b * xx) + (@c * xx * xx)

   print("y = #. + #.x + #.x^2\n".format(a, b, c))
   print(‘ Input  Approximation’)
   print(‘ x   y     y1’)

   L(i) 0 .< x.len
      print(‘#2 #3  #3.1’.format(x[i], y[i], abc(i)))

V x = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
V y = [1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321]
poly_regression(x, y)


with Ada.Numerics.Real_Arrays;  use Ada.Numerics.Real_Arrays;

function Fit (X, Y : Real_Vector; N : Positive) return Real_Vector is
   A : Real_Matrix (0..N, X'Range);  -- The plane
begin
   for I in A'Range (2) loop
      for J in A'Range (1) loop
         A (J, I) := X (I)**J;
      end loop;
   end loop;
   return Solve (A * Transpose (A), A * Y);
end Fit;


MODE FIELD = REAL;

MODE
  VEC = [0]FIELD,
  MAT = [0,0]FIELD;

PROC VOID raise index error := VOID: (
  print(("stop", new line));
  stop
);

COMMENT from http://rosettacode.org/wiki/Matrix_Transpose#ALGOL_68 END COMMENT
OP ZIP = ([,]FIELD in)[,]FIELD:(
  [2 LWB in:2 UPB in,1 LWB in:1UPB in]FIELD out;
  FOR i FROM LWB in TO UPB in DO
     out[,i]:=in[i,]
  OD;
  out
);

COMMENT from http://rosettacode.org/wiki/Matrix_multiplication#ALGOL_68 END COMMENT
OP * = (VEC a,b)FIELD: ( # basically the dot product #
    FIELD result:=0;
    IF LWB a/=LWB b OR UPB a/=UPB b THEN raise index error FI;
    FOR i FROM LWB a TO UPB a DO result+:= a[i]*b[i] OD;
    result
  );

OP * = (VEC a, MAT b)VEC: ( # overload vector times matrix #
    [2 LWB b:2 UPB b]FIELD result;
    IF LWB a/=LWB b OR UPB a/=UPB b THEN raise index error FI;
    FOR j FROM 2 LWB b TO 2 UPB b DO result[j]:=a*b[,j] OD;
    result
  );

OP * = (MAT a, b)MAT: ( # overload matrix times matrix #
     [LWB a:UPB a, 2 LWB b:2 UPB b]FIELD result;
     IF 2 LWB a/=LWB b OR 2 UPB a/=UPB b THEN raise index error FI;
     FOR k FROM LWB result TO UPB result DO result[k,]:=a[k,]*b OD;
     result
   );

COMMENT from http://rosettacode.org/wiki/Pyramid_of_numbers#ALGOL_68 END COMMENT
OP / = (VEC a, MAT b)VEC: ( # vector division #
  [LWB a:UPB a,1]FIELD transpose a;
  transpose a[,1]:=a;
  (transpose a/b)[,1]
);

OP / = (MAT a, MAT b)MAT:( # matrix division #
  [LWB b:UPB b]INT p ;
  INT sign;
  [,]FIELD lu = lu decomp(b, p, sign);
  [LWB a:UPB a, 2 LWB a:2 UPB a]FIELD out;
  FOR col FROM 2 LWB a TO 2 UPB a DO
    out[,col] := lu solve(b, lu, p, a[,col]) [@LWB out[,col]]
  OD;
  out
);

FORMAT int repr = $g(0)$,
       real repr = $g(-7,4)$;

PROC fit =  (VEC x, y, INT order)VEC:
BEGIN
   [0:order, LWB x:UPB x]FIELD a;  # the plane #
   FOR i FROM 2 LWB a TO 2 UPB a  DO
      FOR j FROM LWB a TO UPB a DO
         a [j, i] := x [i]**j
      OD
   OD;
   ( y * ZIP a ) / ( a * ZIP a )
END # fit #;

PROC print polynomial = (VEC x)VOID: (
   BOOL empty := TRUE;
   FOR i FROM UPB x BY -1 TO LWB x DO
     IF x[i] NE 0 THEN
       IF x[i] > 0 AND NOT empty THEN print ("+") FI;
       empty := FALSE;
       IF x[i] NE 1 OR i=0 THEN
         IF ENTIER x[i] = x[i] THEN
           printf((int repr, x[i]))
         ELSE
           printf((real repr, x[i]))
         FI
       FI;
       CASE i+1 IN
         SKIP,print(("x"))
       OUT
         printf(($"x**"g(0)$,i))
       ESAC
     FI
   OD;
   IF empty THEN print("0") FI;
   print(new line)
);

fitting: BEGIN
   VEC c =
          fit
          (  (0.0, 1.0,  2.0,  3.0,  4.0,  5.0,   6.0,   7.0,   8.0,   9.0,  10.0),
             (1.0, 6.0, 17.0, 34.0, 57.0, 86.0, 121.0, 162.0, 209.0, 262.0, 321.0),
             2
          );
   print polynomial(c);
   VEC d =
          fit
          ( (0, 1, 2, 3, 4, 5, 6, 7, 8, 9),
            (2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0),
            2
          );
   print polynomial(d)
END # fitting #


regression(xa,ya){
	n := xa.Count()
	xm := ym := x2m := x3m := x4m := xym := x2ym := 0

	loop % n {
		i := A_Index
		xm := xm + xa[i]
		ym := ym + ya[i]
		x2m := x2m + xa[i] * xa[i]
		x3m := x3m + xa[i] * xa[i] * xa[i]
		x4m := x4m + xa[i] * xa[i] * xa[i] * xa[i]
		xym := xym + xa[i] * ya[i]
		x2ym := x2ym + xa[i] * xa[i] * ya[i]
	}

	xm := xm / n
	ym := ym / n
	x2m := x2m / n
	x3m := x3m / n
	x4m := x4m / n
	xym := xym / n
	x2ym := x2ym / n

	sxx := x2m - xm * xm
	sxy := xym - xm * ym
	sxx2 := x3m - xm * x2m
	sx2x2 := x4m - x2m * x2m
	sx2y := x2ym - x2m * ym

	b := (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
	c := (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
	a := ym - b * xm - c * x2m

	result := "Input`tApproximation`nx   y`ty1`n"
	loop % n
		i := A_Index, result .= xa[i] ", " ya[i] "`t" eval(a, b, c, xa[i]) "`n"
	return "y = " c "x^2" " + " b "x + " a "`n`n" result
}
eval(a,b,c,x){
	return a + (b + c*x) * x
}


#ifndef _POLIFITGSL_H
#define _POLIFITGSL_H
#include <gsl/gsl_multifit.h>
#include <stdbool.h>
#include <math.h>
bool polynomialfit(int obs, int degree,
		   double *dx, double *dy, double *store); /* n, p */
#endif


        public static double[] Polyfit(double[] x, double[] y, int degree)
        {
            // Vandermonde matrix
            var v = new DenseMatrix(x.Length, degree + 1);
            for (int i = 0; i < v.RowCount; i++)
                for (int j = 0; j <= degree; j++) v[i, j] = Math.Pow(x[i], j);
            var yv = new DenseVector(y).ToColumnMatrix();
            QR<double> qr = v.QR();
            // Math.Net doesn't have an "economy" QR, so:
            // cut R short to square upper triangle, then recompute Q
            var r = qr.R.SubMatrix(0, degree + 1, 0, degree + 1);
            var q = v.Multiply(r.Inverse());
            var p = r.Inverse().Multiply(q.TransposeThisAndMultiply(yv));
            return p.Column(0).ToArray();
        }


#include <algorithm>
#include <iostream>
#include <numeric>
#include <vector>

void polyRegression(const std::vector<int>& x, const std::vector<int>& y) {
    int n = x.size();
    std::vector<int> r(n);
    std::iota(r.begin(), r.end(), 0);
    double xm = std::accumulate(x.begin(), x.end(), 0.0) / x.size();
    double ym = std::accumulate(y.begin(), y.end(), 0.0) / y.size();
    double x2m = std::transform_reduce(r.begin(), r.end(), 0.0, std::plus<double>{}, [](double a) {return a * a; }) / r.size();
    double x3m = std::transform_reduce(r.begin(), r.end(), 0.0, std::plus<double>{}, [](double a) {return a * a * a; }) / r.size();
    double x4m = std::transform_reduce(r.begin(), r.end(), 0.0, std::plus<double>{}, [](double a) {return a * a * a * a; }) / r.size();

    double xym = std::transform_reduce(x.begin(), x.end(), y.begin(), 0.0, std::plus<double>{}, std::multiplies<double>{});
    xym /= fmin(x.size(), y.size());

    double x2ym = std::transform_reduce(x.begin(), x.end(), y.begin(), 0.0, std::plus<double>{}, [](double a, double b) { return a * a * b; });
    x2ym /= fmin(x.size(), y.size());

    double sxx = x2m - xm * xm;
    double sxy = xym - xm * ym;
    double sxx2 = x3m - xm * x2m;
    double sx2x2 = x4m - x2m * x2m;
    double sx2y = x2ym - x2m * ym;

    double b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    double c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    double a = ym - b * xm - c * x2m;

    auto abc = [a, b, c](int xx) {
        return a + b * xx + c * xx*xx;
    };

    std::cout << "y = " << a << " + " << b << "x + " << c << "x^2" << std::endl;
    std::cout << " Input  Approximation" << std::endl;
    std::cout << " x   y     y1" << std::endl;

    auto xit = x.cbegin();
    auto xend = x.cend();
    auto yit = y.cbegin();
    auto yend = y.cend();
    while (xit != xend && yit != yend) {
        printf("%2d %3d  %5.1f\n", *xit, *yit, abc(*xit));
        xit = std::next(xit);
        yit = std::next(yit);
    }
}

int main() {
    using namespace std;

    vector<int> x(11);
    iota(x.begin(), x.end(), 0);

    vector<int> y{ 1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321 };

    polyRegression(x, y);

    return 0;
}


;; Least square fit of a polynomial of order n the x-y-curve.
(defun polyfit (x y n)
  (let* ((m (cadr (array-dimensions x)))
         (A (make-array `(,m ,(+ n 1)) :initial-element 0)))
    (loop for i from 0 to (- m 1) do
          (loop for j from 0 to n do
                (setf (aref A i j)
                      (expt (aref x 0 i) j))))
    (lsqr A (mtp y))))


import std.algorithm;
import std.range;
import std.stdio;

auto average(R)(R r) {
    auto t = r.fold!("a+b", "a+1")(0, 0);
    return cast(double) t[0] / t[1];
}

void polyRegression(int[] x, int[] y) {
    auto n = x.length;
    auto r = iota(0, n).array;
    auto xm = x.average();
    auto ym = y.average();
    auto x2m = r.map!"a*a".average();
    auto x3m = r.map!"a*a*a".average();
    auto x4m = r.map!"a*a*a*a".average();
    auto xym = x.zip(y).map!"a[0]*a[1]".average();
    auto x2ym = x.zip(y).map!"a[0]*a[0]*a[1]".average();

    auto sxx = x2m - xm * xm;
    auto sxy = xym - xm * ym;
    auto sxx2 = x3m - xm * x2m;
    auto sx2x2 = x4m - x2m * x2m;
    auto sx2y = x2ym - x2m * ym;

    auto b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    auto c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    auto a = ym - b * xm - c * x2m;

    real abc(int xx) {
        return a + b * xx + c * xx * xx;
    }

    writeln("y = ", a, " + ", b, "x + ", c, "x^2");
    writeln(" Input  Approximation");
    writeln(" x   y     y1");
    foreach (i; 0..n) {
        writefln("%2d %3d  %5.1f", x[i], y[i], abc(x[i]));
    }
}

void main() {
    auto x = iota(0, 11).array;
    auto y = [1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321];
    polyRegression(x, y);
}


module fitting
contains

  function polyfit(vx, vy, d)
    implicit none
    integer, intent(in)                   :: d
    integer, parameter                    :: dp = selected_real_kind(15, 307)
    real(dp), dimension(d+1)              :: polyfit
    real(dp), dimension(:), intent(in)    :: vx, vy

    real(dp), dimension(:,:), allocatable :: X
    real(dp), dimension(:,:), allocatable :: XT
    real(dp), dimension(:,:), allocatable :: XTX

    integer :: i, j

    integer     :: n, lda, lwork
    integer :: info
    integer, dimension(:), allocatable :: ipiv
    real(dp), dimension(:), allocatable :: work

    n = d+1
    lda = n
    lwork = n

    allocate(ipiv(n))
    allocate(work(lwork))
    allocate(XT(n, size(vx)))
    allocate(X(size(vx), n))
    allocate(XTX(n, n))

    ! prepare the matrix
    do i = 0, d
       do j = 1, size(vx)
          X(j, i+1) = vx(j)**i
       end do
    end do

    XT  = transpose(X)
    XTX = matmul(XT, X)

    ! calls to LAPACK subs DGETRF and DGETRI
    call DGETRF(n, n, XTX, lda, ipiv, info)
    if ( info /= 0 ) then
       print *, "problem"
       return
    end if
    call DGETRI(n, XTX, lda, ipiv, work, lwork, info)
    if ( info /= 0 ) then
       print *, "problem"
       return
    end if

    polyfit = matmul( matmul(XTX, XT), vy)

    deallocate(ipiv)
    deallocate(work)
    deallocate(X)
    deallocate(XT)
    deallocate(XTX)

  end function

end module


#Include "crt.bi"  'for rounding only

Type vector
    Dim As Double element(Any)
End Type

Type matrix
    Dim As Double element(Any,Any)
    Declare Function inverse() As matrix
    Declare Function transpose() As matrix
    private:
    Declare Function GaussJordan(As vector) As vector
End Type

'mult operators
Operator *(m1 As matrix,m2 As matrix) As matrix
    Dim rows As Integer=Ubound(m1.element,1)
    Dim columns As Integer=Ubound(m2.element,2)
    If Ubound(m1.element,2)<>Ubound(m2.element,1) Then
        Print "Can't do"
        Exit Operator
    End If
    Dim As matrix ans
    Redim ans.element(rows,columns)
    Dim rxc As Double
    For r As Integer=1 To rows
        For c As Integer=1 To columns
            rxc=0
            For k As Integer = 1 To Ubound(m1.element,2)
                rxc=rxc+m1.element(r,k)*m2.element(k,c)
            Next k
            ans.element(r,c)=rxc
        Next c
    Next r
    Operator= ans
End Operator

Operator *(m1 As matrix,m2 As vector) As vector
    Dim rows As Integer=Ubound(m1.element,1)
    Dim columns As Integer=Ubound(m2.element,2)
    If Ubound(m1.element,2)<>Ubound(m2.element) Then
        Print "Can't do"
        Exit Operator
    End If
    Dim As vector ans
    Redim ans.element(rows)
    Dim rxc As Double
    For r As Integer=1 To rows
        rxc=0
        For k As Integer = 1 To Ubound(m1.element,2)
            rxc=rxc+m1.element(r,k)*m2.element(k)
        Next k
        ans.element(r)=rxc
    Next r
    Operator= ans
End Operator

Function matrix.transpose() As matrix
    Dim As matrix b
    Redim b.element(1 To Ubound(this.element,2),1 To Ubound(this.element,1))
    For i As Long=1 To Ubound(this.element,1)
        For j As Long=1 To Ubound(this.element,2)
            b.element(j,i)=this.element(i,j)
        Next
    Next
    Return b
End Function

Function matrix.GaussJordan(rhs As vector) As vector
    Dim As Integer n=Ubound(rhs.element)
    Dim As vector ans=rhs,r=rhs
    Dim As matrix b=This
    #macro pivot(num)
        For p1 As Integer  = num To n - 1
            For p2 As Integer  = p1 + 1 To n
                If Abs(b.element(p1,num))<Abs(b.element(p2,num)) Then
                    Swap r.element(p1),r.element(p2)
                    For g As Integer=1 To n
                        Swap b.element(p1,g),b.element(p2,g)
                    Next g
                End If
            Next p2
        Next p1
    #endmacro
    For k As Integer=1 To n-1
        pivot(k)
        For row As Integer =k To n-1
            If b.element(row+1,k)=0 Then Exit For
            Var f=b.element(k,k)/b.element(row+1,k)
            r.element(row+1)=r.element(row+1)*f-r.element(k)
            For g As Integer=1 To n
                b.element((row+1),g)=b.element((row+1),g)*f-b.element(k,g)
            Next g
        Next row
    Next k
    'back substitute
    For z As Integer=n To 1 Step -1
        ans.element(z)=r.element(z)/b.element(z,z)
        For j As Integer = n To z+1 Step -1
            ans.element(z)=ans.element(z)-(b.element(z,j)*ans.element(j)/b.element(z,z))
        Next j
    Next    z
    Function = ans
End Function

Function matrix.inverse() As matrix
    Var ub1=Ubound(this.element,1),ub2=Ubound(this.element,2)
    Dim As matrix ans
    Dim As vector temp,null_
    Redim temp.element(1 To ub1):Redim null_.element(1 To ub1)
    Redim ans.element(1 To ub1,1 To ub2)
    For a As Integer=1 To ub1
        temp=null_
        temp.element(a)=1
        temp=GaussJordan(temp)
        For b As Integer=1 To ub1
            ans.element(b,a)=temp.element(b)
        Next b
    Next a
    Return ans
End Function

'vandermode of x
Function vandermonde(x_values() As Double,w As Long) As matrix
    Dim As matrix mat
    Var n=Ubound(x_values)
    Redim mat.element(1 To n,1 To w)
    For a As Integer=1 To n
        For b As Integer=1 To w
            mat.element(a,b)=x_values(a)^(b-1)
        Next b
    Next a
    Return mat
End Function

'main preocedure
Sub regress(x_values() As Double,y_values() As Double,ans() As Double,n As Long)
    Redim ans(1 To Ubound(x_values))
    Dim As matrix m1= vandermonde(x_values(),n)
    Dim As matrix T=m1.transpose
    Dim As vector y
    Redim y.element(1 To Ubound(ans))
    For n As Long=1 To Ubound(y_values)
        y.element(n)=y_values(n)
    Next n
    Dim As vector result=(((T*m1).inverse)*T)*y
    Redim Preserve ans(1 To n)
    For n As Long=1 To Ubound(ans)
        ans(n)=result.element(n)
    Next n
End Sub

'Evaluate a polynomial at x
Function polyeval(Coefficients() As Double,Byval x As Double) As Double
    Dim As Double acc
    For i As Long=Ubound(Coefficients) To Lbound(Coefficients) Step -1
        acc=acc*x+Coefficients(i)
    Next i
    Return acc
End Function

Function CRound(Byval x As Double,Byval precision As Integer=30) As String
    If precision>30 Then precision=30
    Dim As zstring * 40 z:Var s="%." &str(Abs(precision)) &"f"
    sprintf(z,s,x)
    If Val(z) Then Return Rtrim(Rtrim(z,"0"),".")Else Return "0"
End Function

Function show(a() As Double,places as long=10) As String
    Dim As String s,g
    For n As Long=Lbound(a) To Ubound(a)
        If n<3 Then g="" Else g="^"+Str(n-1)
        if val(cround(a(n),places))<>0 then
            s+= Iif(Sgn(a(n))>=0,"+","")+cround(a(n),places)+ Iif(n=Lbound(a),"","*x"+g)+" "
        end if
    Next n
    Return s
End Function

dim as double x(1 to ...)={0,  1,  2,  3,  4,  5,  6,   7,   8,   9,   10}
dim as double y(1 to ...)={1,  6,  17, 34, 57, 86, 121, 162, 209, 262, 321}

Redim As Double ans()
regress(x(),y(),ans(),3)

print show(ans())
sleep


PolynomialRegression := function(x, y, n)
	local a;
	a := List([0 .. n], i -> List(x, s -> s^i));
	return TransposedMat((a * TransposedMat(a))^-1 * a * TransposedMat([y]))[1];
end;

x := [0,  1,  2,  3,  4,  5,  6,   7,   8,   9,   10];
y := [1,  6,  17, 34, 57, 86, 121, 162, 209, 262, 321];

# Return coefficients in ascending degree order
PolynomialRegression(x, y, 2);
# [ 1, 2, 3 ]


# The polynomial approximation
f(x) = a*x**2 + b*x + c

# Initial values for parameters
a = 0.1
b = 0.1
c = 0.1

# Fit f to the following data by modifying the variables a, b, c
fit f(x) '-' via a, b, c
   0   1
   1   6
   2  17
   3  34
   4  57
   5  86
   6 121
   7 162
   8 209
   9 262
  10 321
e

print sprintf("\n --- \n Polynomial fit: %.4f x^2 + %.4f x + %.4f\n", a, b, c)


package main

import (
	"fmt"
	"log"

	"gonum.org/v1/gonum/mat"
)

func main() {
	var (
		x = []float64{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
		y = []float64{1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321}

		degree = 2

		a = Vandermonde(x, degree+1)
		b = mat.NewDense(len(y), 1, y)
		c = mat.NewDense(degree+1, 1, nil)
	)

	var qr mat.QR
	qr.Factorize(a)

	const trans = false
	err := qr.SolveTo(c, trans, b)
	if err != nil {
		log.Fatalf("could not solve QR: %+v", err)
	}
	fmt.Printf("%.3f\n", mat.Formatted(c))
}

func Vandermonde(a []float64, d int) *mat.Dense {
	x := mat.NewDense(len(a), d, nil)
	for i := range a {
		for j, p := 0, 1.0; j < d; j, p = j+1, p*a[i] {
			x.Set(i, j, p)
		}
	}
	return x
}


import Data.List
import Data.Array
import Control.Monad
import Control.Arrow
import Matrix.LU

ppoly p x = map (x**) p

polyfit d ry = elems $ solve mat vec  where
   mat = listArray ((1,1), (d,d)) $ liftM2 concatMap ppoly id [0..fromIntegral $ pred d]
   vec = listArray (1,d) $ take d ry


REAL :: n=10, x(n), y(n), m=3, p(m)

   x = (0,  1,  2,  3,  4,  5,  6,   7,   8,   9,   10)
   y = (1,  6,  17, 34, 57, 86, 121, 162, 209, 262, 321)

   p = 2 ! initial guess for the polynom's coefficients

   SOLVE(NUL=Theory()-y(nr), Unknown=p, DataIdx=nr, Iters=iterations)

   WRITE(ClipBoard, Name) p, iterations

FUNCTION Theory()
   ! called by the solver of the SOLVE function. All variables are global
   Theory = p(1)*x(nr)^2 + p(2)*x(nr) + p(3)
 END


(import [numpy [polyfit]])

(setv x (range 11))
(setv y [1 6 17 34 57 86 121 162 209 262 321])

(print (polyfit x y 2))


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

public class PolynomialRegression {
    private static void polyRegression(int[] x, int[] y) {
        int n = x.length;
        int[] r = IntStream.range(0, n).toArray();
        double xm = Arrays.stream(x).average().orElse(Double.NaN);
        double ym = Arrays.stream(y).average().orElse(Double.NaN);
        double x2m = Arrays.stream(r).map(a -> a * a).average().orElse(Double.NaN);
        double x3m = Arrays.stream(r).map(a -> a * a * a).average().orElse(Double.NaN);
        double x4m = Arrays.stream(r).map(a -> a * a * a * a).average().orElse(Double.NaN);
        double xym = 0.0;
        for (int i = 0; i < x.length && i < y.length; ++i) {
            xym += x[i] * y[i];
        }
        xym /= Math.min(x.length, y.length);
        double x2ym = 0.0;
        for (int i = 0; i < x.length && i < y.length; ++i) {
            x2ym += x[i] * x[i] * y[i];
        }
        x2ym /= Math.min(x.length, y.length);

        double sxx = x2m - xm * xm;
        double sxy = xym - xm * ym;
        double sxx2 = x3m - xm * x2m;
        double sx2x2 = x4m - x2m * x2m;
        double sx2y = x2ym - x2m * ym;

        double b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
        double c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
        double a = ym - b * xm - c * x2m;

        IntToDoubleFunction abc = (int xx) -> a + b * xx + c * xx * xx;

        System.out.println("y = " + a + " + " + b + "x + " + c + "x^2");
        System.out.println(" Input  Approximation");
        System.out.println(" x   y     y1");
        for (int i = 0; i < n; ++i) {
            System.out.printf("%2d %3d  %5.1f\n", x[i], y[i], abc.applyAsDouble(x[i]));
        }
    }

    public static void main(String[] args) {
        int[] x = IntStream.range(0, 11).toArray();
        int[] y = new int[]{1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321};
        polyRegression(x, y);
    }
}


// version 1.1.51

fun polyRegression(x: IntArray, y: IntArray) {
    val xm = x.average()
    val ym = y.average()
    val x2m = x.map { it * it }.average()
    val x3m = x.map { it * it * it }.average()
    val x4m = x.map { it * it * it * it }.average()
    val xym = x.zip(y).map { it.first * it.second }.average()
    val x2ym = x.zip(y).map { it.first * it.first * it.second }.average()

    val sxx = x2m - xm * xm
    val sxy = xym - xm * ym
    val sxx2 = x3m - xm * x2m
    val sx2x2 = x4m - x2m * x2m
    val sx2y = x2ym - x2m * ym

    val b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    val c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    val a = ym - b * xm - c * x2m

    fun abc(xx: Int) = a + b * xx + c * xx * xx

    println("y = $a + ${b}x + ${c}x^2\n")
    println(" Input  Approximation")
    println(" x   y     y1")
    for ((xi, yi) in x zip y) {
        System.out.printf("%2d %3d  %5.1f\n", xi, yi, abc(xi))
    }
}

fun main() {
    val x = IntArray(11) { it }
    val y = intArrayOf(1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321)
    polyRegression(x, y)
}


function eval(a,b,c,x)
    return a + (b + c * x) * x
end

function regression(xa,ya)
    local n = #xa

    local xm = 0.0
    local ym = 0.0
    local x2m = 0.0
    local x3m = 0.0
    local x4m = 0.0
    local xym = 0.0
    local x2ym = 0.0

    for i=1,n do
        xm = xm + xa[i]
        ym = ym + ya[i]
        x2m = x2m + xa[i] * xa[i]
        x3m = x3m + xa[i] * xa[i] * xa[i]
        x4m = x4m + xa[i] * xa[i] * xa[i] * xa[i]
        xym = xym + xa[i] * ya[i]
        x2ym = x2ym + xa[i] * xa[i] * ya[i]
    end
    xm = xm / n
    ym = ym / n
    x2m = x2m / n
    x3m = x3m / n
    x4m = x4m / n
    xym = xym / n
    x2ym = x2ym / n

    local sxx = x2m - xm * xm
    local sxy = xym - xm * ym
    local sxx2 = x3m - xm * x2m
    local sx2x2 = x4m - x2m * x2m
    local sx2y = x2ym - x2m * ym

    local b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    local c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    local a = ym - b * xm - c * x2m

    print("y = "..a.." + "..b.."x + "..c.."x^2")

    for i=1,n do
        print(string.format("%2d %3d  %3d", xa[i], ya[i], eval(a, b, c, xa[i])))
    end
end

local xa = {0, 1,  2,  3,  4,  5,   6,   7,   8,   9,  10}
local ya = {1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321}
regression(xa, ya)


ПC	С/П	ПD	ИП9	+	П9	ИПC	ИП5	+	П5
ИПC	x^2	П2	ИП6	+	П6	ИП2	ИПC	*	ИП7
+	П7	ИП2	x^2	ИП8	+	П8	ИПC	ИПD	*
ИПA	+	ПA	ИП2	ИПD	*	ИПB	+	ПB	ИПD
КИП4	С/П	БП	00


MODULE PolynomialRegression;
FROM FormatString IMPORT FormatString;
FROM RealStr IMPORT RealToStr;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE Eval(a,b,c,x : REAL) : REAL;
BEGIN
    RETURN a + b*x + c*x*x;
END Eval;

PROCEDURE Regression(x,y : ARRAY OF INTEGER);
VAR
    n,i : INTEGER;
    xm,x2m,x3m,x4m : REAL;
    ym : REAL;
    xym,x2ym : REAL;
    sxx,sxy,sxx2,sx2x2,sx2y : REAL;
    a,b,c : REAL;
    buf : ARRAY[0..63] OF CHAR;
BEGIN
    n := SIZE(x)/SIZE(INTEGER);

    xm := 0.0;
    ym := 0.0;
    x2m := 0.0;
    x3m := 0.0;
    x4m := 0.0;
    xym := 0.0;
    x2ym := 0.0;
    FOR i:=0 TO n-1 DO
        xm := xm + FLOAT(x[i]);
        ym := ym + FLOAT(y[i]);
        x2m := x2m + FLOAT(x[i]) * FLOAT(x[i]);
        x3m := x3m + FLOAT(x[i]) * FLOAT(x[i]) * FLOAT(x[i]);
        x4m := x4m + FLOAT(x[i]) * FLOAT(x[i]) * FLOAT(x[i]) * FLOAT(x[i]);
        xym := xym + FLOAT(x[i]) * FLOAT(y[i]);
        x2ym := x2ym + FLOAT(x[i]) * FLOAT(x[i]) * FLOAT(y[i]);
    END;
    xm := xm / FLOAT(n);
    ym := ym / FLOAT(n);
    x2m := x2m / FLOAT(n);
    x3m := x3m / FLOAT(n);
    x4m := x4m / FLOAT(n);
    xym := xym / FLOAT(n);
    x2ym := x2ym / FLOAT(n);

    sxx := x2m - xm * xm;
    sxy := xym - xm * ym;
    sxx2 := x3m - xm * x2m;
    sx2x2 := x4m - x2m * x2m;
    sx2y := x2ym - x2m * ym;

    b := (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    c := (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2);
    a := ym - b * xm - c * x2m;

    WriteString("y = ");
    RealToStr(a, buf);
    WriteString(buf);
    WriteString(" + ");
    RealToStr(b, buf);
    WriteString(buf);
    WriteString("x + ");
    RealToStr(c, buf);
    WriteString(buf);
    WriteString("x^2");
    WriteLn;

    FOR i:=0 TO n-1 DO
        FormatString("%2i %3i  ", buf, x[i], y[i]);
        WriteString(buf);
        RealToStr(Eval(a,b,c,FLOAT(x[i])), buf);
        WriteString(buf);
        WriteLn;
    END;
END Regression;

TYPE R = ARRAY[0..10] OF INTEGER;
VAR
    x,y : R;
BEGIN
    x := R{0,1,2,3,4,5,6,7,8,9,10};
    y := R{1,6,17,34,57,86,121,162,209,262,321};
    Regression(x,y);

    ReadChar;
END PolynomialRegression.


import lenientops, sequtils, stats, strformat

proc polyRegression(x, y: openArray[int]) =

  let xm = mean(x)
  let ym = mean(y)
  let x2m = mean(x.mapIt(it * it))
  let x3m = mean(x.mapIt(it * it * it))
  let x4m = mean(x.mapIt(it * it * it * it))
  let xym = mean(zip(x, y).mapIt(it[0] * it[1]))
  let x2ym = mean(zip(x, y).mapIt(it[0] * it[0] * it[1]))

  let sxx = x2m - xm * xm
  let sxy = xym - xm * ym
  let sxx2 = x3m - xm * x2m
  let sx2x2 = x4m - x2m * x2m
  let sx2y = x2ym - x2m * ym

  let b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
  let c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
  let a = ym - b * xm - c * x2m

  func abc(x: int): float = a + b * x + c * x * x

  echo &"y = {a} + {b}x + {c}x²\n"
  echo " Input  Approximation"
  echo " x   y     y1"
  for (xi, yi) in zip(x, y):
    echo &"{xi:2} {yi:3}  {abc(xi):5}"

let x = toSeq(0..10)
let y = [1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321]
polyRegression(x, y)


open Base
open Stdio

let mean fa =
  let open Float in
  (Array.reduce_exn fa ~f:(+)) / (of_int (Array.length fa))

let regression xs ys =
  let open Float in
  let xm = mean xs in
  let ym = mean ys in
  let x2m = Array.map xs ~f:(fun x -> x * x) |> mean in
  let x3m = Array.map xs ~f:(fun x -> x * x * x) |> mean in
  let x4m = Array.map xs ~f:(fun x -> let x2 = x * x in x2 * x2) |> mean in
  let xzipy = Array.zip_exn xs ys in
  let xym = Array.map xzipy ~f:(fun (x, y) -> x * y) |> mean in
  let x2ym = Array.map xzipy ~f:(fun (x, y) -> x * x * y) |> mean in

  let sxx = x2m - xm * xm in
  let sxy = xym - xm * ym in
  let sxx2 = x3m - xm * x2m in
  let sx2x2 = x4m - x2m * x2m in
  let sx2y = x2ym - x2m * ym in

  let b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2) in
  let c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2) in
  let a = ym - b * xm - c * x2m in

  let abc xx = a + b * xx + c * xx * xx in

  printf "y = %.1f + %.1fx + %.1fx^2\n\n" a b c;
  printf " Input  Approximation\n";
  printf " x   y     y1\n";
  Array.iter xzipy ~f:(fun (xi, yi) ->
    printf "%2g %3g  %5.1f\n" xi yi (abc xi)
  )

let () =
  let x = Array.init 11 ~f:Float.of_int in
  let y = [| 1.; 6.; 17.; 34.; 57.; 86.; 121.; 162.; 209.; 262.; 321. |] in
  regression x y


-- demo\rosetta\Polynomial_regression.exw
with javascript_semantics
constant x = {0,1,2,3,4,5,6,7,8,9,10},
         y = {1,6,17,34,57,86,121,162,209,262,321},
         n = length(x)

function regression()
    atom xm = 0, ym = 0, x2m = 0, x3m = 0, x4m = 0, xym = 0, x2ym = 0
    for i=1 to n do
        atom xi = x[i],
             yi = y[i]
        xm += xi
        ym += yi
        x2m += power(xi,2)
        x3m += power(xi,3)
        x4m += power(xi,4)
        xym += xi*yi
        x2ym += power(xi,2)*yi
    end for
    xm /= n
    ym /= n
    x2m /= n
    x3m /= n
    x4m /= n
    xym /= n
    x2ym /= n
    atom Sxx = x2m-power(xm,2),
         Sxy = xym-xm*ym,
         Sxx2 = x3m-xm*x2m,
         Sx2x2 = x4m-power(x2m,2),
         Sx2y = x2ym-x2m*ym,
         B = (Sxy*Sx2x2-Sx2y*Sxx2)/(Sxx*Sx2x2-power(Sxx2,2)),
         C = (Sx2y*Sxx-Sxy*Sxx2)/(Sxx*Sx2x2-power(Sxx2,2)),
         A = ym-B*xm-C*x2m
    return {C,B,A}
end function

atom {a,b,c} = regression()

function f(atom x)
    return a*x*x+b*x+c
end function

printf(1,"y=%gx^2+%gx+%g\n",{a,b,c})
printf(1,"\n  x   y  f(x)\n")
for i=1 to n do
    printf(1," %2d %3d   %3g\n",{x[i],y[i],f(x[i])})
end for

-- And a simple plot (re-using x,y from above)

include pGUI.e
include IupGraph.e

function get_data(Ihandle graph)
    integer {w,h} = IupGetIntInt(graph,"DRAWSIZE")
    IupSetInt(graph,"YTICK",iff(h<240?iff(h<150?80:40):20))
    return {{x,y,CD_RED}}
end function

IupOpen()
Ihandle graph = IupGraph(get_data,"RASTERSIZE=640x440")
IupSetAttributes(graph,"XTICK=1,XMIN=0,XMAX=10")
IupSetAttributes(graph,"YTICK=20,YMIN=0,YMAX=320")
Ihandle dlg = IupDialog(graph,`TITLE="simple plot"`)
IupSetAttributes(dlg,"MINSIZE=245x150")
IupShow(dlg)
if platform()!=JS then
     IupMainLoop()
     IupClose()
end if


F popcount(n)
   R bin(n).count(‘1’)

print((0.<30).map(i -> popcount(Int64(3) ^ i)))

[Int] evil, odious
V i = 0
L evil.len < 30 | odious.len < 30
   V p = popcount(i)
   I (p % 2) != 0
      odious.append(i)
   E
      evil.append(i)
   i++

print(evil[0.<30])
print(odious[0.<30])


*        Population count          09/05/2019
POPCNT   CSECT
         USING  POPCNT,R13         base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LD     F0,UN              1
         STD    F0,BB              bb=1
         MVC    PG(7),=C'pow  3:'  init buffer
         L      R10,NN             nn
         BCTR   R10,0              nn-1
         LA     R9,PG+7            @pg
         LA     R6,0               i=0
       DO WHILE=(CR,R6,LE,R10)     do i=0 to nn-1
         LM     R0,R1,BB             r0r1=bb
         BAL    R14,POPCOUNT         call popcount(bb)
         LR     R1,R0                popcount(bb)
         XDECO  R1,XDEC              edit popcount(bb)
         MVC    0(3,R9),XDEC+9       output popcount(bb)
         LD     F0,BB                bb
         AW     F0,BB                bb*2
         AW     F0,BB                bb*3
         STD    F0,BB                bb=bb*3
         LA     R9,3(R9)             @pg
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         XPRNT  PG,L'PG            print buffer
         SR     R7,R7              j=0
       DO WHILE=(C,R7,LE,=F'1')    do j=0 to 1
         MVC    PG,=CL132' '         clear buffer
       IF   LTR,R7,Z,R7 THEN         if j=0 then
         MVC    PG(7),=C'evil:  '      init buffer
       ELSE     ,                    else
         MVC    PG(7),=C'odious:'      init buffer
       ENDIF    ,                    endif
         LA     R9,PG+7              @pg
         SR     R8,R8                n=0
         SR     R6,R6                i=0
       DO WHILE=(C,R8,LT,NN)         do i=0 by 1 while(n<nn)
         XR     R0,R0                  r0=0
         LR     R1,R6                  r1=i
         BAL    R14,POPCOUNT           r0=popcount(i)
         SRDA   R0,32                  ~
         D      R0,=F'2'               popcount(i)/2
       IF    CR,R0,EQ,R7 THEN          if popcount(i)//2=j then
         LA     R8,1(R8)                 n=n+1
         XDECO  R6,XDEC                  edit i
         MVC    0(3,R9),XDEC+9           output i
         LA     R9,3(R9)                 @pg
       ENDIF    ,                      endif
         LA     R6,1(R6)             i++
       ENDDO    ,                    enddo i
         XPRNT  PG,L'PG              print buffer
         LA     R7,1(R7)             j++
       ENDDO    ,                  enddo j
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
*------- ----   ------------------
POPCOUNT EQU    *                  popcount(x)
         ICM    R0,B'1000',=X'00'  zap exponant part
         XR     R3,R3              y=0
         LA     R4,56              mantissa size = 56
LOOP     STC    R1,CC              do i=1 to 56
         TM     CC,X'01'             if bit(x,i)=1
         BNO    NOTONE               then{
         LA     R3,1(R3)               y++}
NOTONE   SRDA   R0,1                 shift right double arithmetic
         BCT    R4,LOOP            enddo i
         LR     R0,R3              return(y)
         BR     R14                return
*------- ----   ------------------
NN       DC     F'30'              nn=30
BB       DS     D                  bb
UN       DC     X'4E00000000000001'  un=1 (unnormalized)
PG       DC     CL132' '           buffer
XDEC     DS     CL12               temp for xdeco
CC       DS     C
         REGEQU
         END    POPCNT


	org	100h
	mvi	e,30	; 3^0 to 3^29 inclusive
powers:	push	d	; Keep counter
	;;;	Calculate Hamming weight of pow3
	lxi	b,6	; C = 6 bytes, B = counter
	lxi	h,pow3
ham48:	mov	a,m	; Get byte
	ana	a	; Clear carry
hambt:	ral		; Rotate into carry
	jnc	$+4	; Increment counter if carry set
	inr	b
	ana	a	; Done yet?
	jnz	hambt	; If not, keep going
	dcr	c	; More bytes?
	inx	h
	jnz	ham48	; If not, keep going
	mov	a,b	; Print result
	call	outa
	;;;	Multiply pow3 by 3
	mvi	b,6	; Make copy
	lxi	h,pow3
	lxi	d,pow3c
copy:	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	copy
	;;;	Multiply by 3 (add copy to it twice)
	lxi	h,pow3c
	lxi	d,pow3
	call	add48
	call	add48
	pop	d	; Restore counter
	dcr	e	; Count down from 30
	jnz	powers
	call	outnl
	;;;	Print first 30 evil numbers
	;;;	An evil number has even parity
	lxi	b,-226	; B=current number (start -1), C=counter
evil:	inr	b	; Increment number
	jpo	evil	; If odious, try next number
	push	b	; Otherwise, output it,
	mov	a,b
	call	outa
	pop	b
	dcr	c	; Decrement counter
	jnz	evil	; If not zero, get more numbers
	call	outnl
	;;;	Print first 30 odious numbers
	;;;	An odious number has odd parity
	lxi	b,-226
odious:	inr	b
	jpe	odious	; If number is evil, try next number
	push	b
	mov 	a,b
	call	outa
	pop	b
	dcr	c
	jnz	odious
	;;;	Print newline
outnl:	lxi	d,nl
	mvi	c,9
	jmp	5
	;;;	Print 2-digit number in A
outa:	lxi	d,0A2Fh	; D=10, E=high digit
mkdgt:	inr	e
	sub	d
	jnc	mkdgt
	adi	'0'+10	; Low digit
	push	psw	; Save low digit
	mvi	c,2	; Print high digit
	call	5
	pop	psw	; Restore low digit
	mov	e,a	; Print low digit
	mvi	c,2
	call	5
	mvi	e,' '	; Print space
	mvi	c,2
	jmp	5
	;;;	Add 48-byte number at [HL] to [DE]
add48:	push	h	; Keep pointers
	push	d
	mvi	b,6	; 6 bytes
	ana	a	; Clear carry
a48l:	ldax	d	; Get byte at [DE]
	adc	m	; Add byte at [HL]
	stax	d	; Store result at [DE]
	inx	h	; Increment pointers
	inx	d
	dcr	b	; Any more bytes left?
	jnz	a48l	; If so, do next byte
	pop	d	; Restore pointers
	pop	h
	ret
nl:	db	13,10,'$'
pow3:	db	1,0,0,0,0,0	; pow3, starts at 1
pow3c:	equ	$		; room for copy


#lang racket
(require math plot)

(define xs '(0 1  2  3  4  5   6   7   8   9  10))
(define ys '(1 6 17 34 57 86 121 162 209 262 321))

(define (fit x y n)
  (define Y (->col-matrix y))
  (define V (vandermonde-matrix x (+ n 1)))
  (define VT (matrix-transpose V))
  (matrix->vector (matrix-solve (matrix* VT V) (matrix* VT Y))))

(define ((poly v) x)
  (for/sum ([c v] [i (in-naturals)])
    (* c (expt x i))))

(plot (list (points   (map vector xs ys))
            (function (poly (fit xs ys 2)))))


	cpu	8086
	bits	16
	org	100h
section	.text
	;;;	Calculate hamming weights of 3^0 to 3^29.
	;;;	3^29 needs a 48-bit representation, which
	;;;	we'll put in BP:SI:DI.
	xor	bp,bp		; BP:SI:DI = 1
	xor	si,si
	xor	di,di
	inc	di
	mov	cx,30
	;;;	Calculate pop count of BP:SI:DI
pow3s:	push	bp		; Keep state
	push	si
	push	di
	xor	ax,ax		; AL = counter
ham48:	rcl	bp,1
	rcl	si,1
	rcl	di,1
	adc	al,ah
	mov	dx,bp
	or	dx,si
	or	dx,di
	jnz	ham48
	pop	di		; Restore state
	pop	si
	pop	bp
	call	outal		; Output
	;;;	Multiply by 3
	push	bp		; Keep state
	push	si
	push	di
	add	di,di 		; Mul by two (add to itself)
	adc	si,si
	adc	bp,bp
	pop	ax		; Add original (making x3)
	add	di,ax
	pop	ax
	adc	si,ax
	pop	ax
	adc	bp,ax
	loop	pow3s
	call	outnl
	;;;	Print first 30 evil numbers
	;;;	This is much easier, since they fit in a byte,
	;;;	and we only need to know whether the Hamming weight
	;;;	is odd or even, which is the same as the built-in
	;;;	parity check
	mov	cl,30
	xor	bx,bx
	dec	bx
evil:	inc	bx		; Increment number to test
	jpo	.next		; If parity is odd, number is not evil
	mov	al,bl		; Otherwise, output the number
	call	outal
	dec	cx		; One fewer left
.next:	test	cx,cx
	jnz	evil		; Next evil number
	call	outnl
	;;;	For the odious numbers it is the same
	mov	cl,30
	xor	bx,bx
	dec	bx
odious:	inc	bx
	jpe	.next 		; Except this time we skip the evil numbers
	mov	al,bl
	call	outal
	dec	cx
.next:	test	cx,cx
	jnz	odious
	;;;	Print newline
outnl:	mov	ah,2
	mov	dl,13
	int	21h
	mov	dl,10
	int	21h
	ret
	;;;	Print 2-digit number in AL
outal:	aam
	add 	ax,3030h
	xchg	dx,ax
	xchg	dl,dh
	mov	ah,2
	int	21h
	xchg	dl,dh
	int	21h
	mov 	dl,' '
	int	21h
	ret


require 'matrix'

def regress x, y, degree
  x_data = x.map { |xi| (0..degree).map { |pow| (xi**pow).to_r } }

  mx = Matrix[*x_data]
  my = Matrix.column_vector(y)

  ((mx.t * mx).inv * mx.t * my).transpose.to_a[0].map(&:to_f)
end


with Interfaces;

package Population_Count is
   subtype Num is Interfaces.Unsigned_64;
   function Pop_Count(N: Num) return Natural;
end Population_Count;


# returns the population count (number of bits on) of the non-negative       #
# integer n                                                                  #
PROC population count = ( LONG INT n )INT:
     BEGIN
        LONG INT number := n;
        INT      result := 0;
        WHILE number > 0 DO
            IF ODD number THEN result +:= 1 FI;
            number OVERAB 2
        OD;
        result
     END # population # ;

# population count of 3^0, 3^1, 3*2, ..., 3^29                               #
LONG INT  power of three := 1;
print( ( "3^x pop counts:" ) );
FOR power FROM 0 TO 29 DO
    print( ( " ", whole( population count( power of three ), 0 ) ) );
    power of three *:= 3
OD;
print( ( newline ) );
# print the first thirty evil numbers (even population count)                #
INT evil count := 0;
print( ( "evil numbers  :" ) );
FOR n FROM 0 WHILE evil count < 30 DO
    IF NOT ODD population count( n ) THEN
        print( ( " ", whole( n, 0 ) ) );
        evil count +:= 1
    FI
OD;
print( ( newline ) );
# print the first thirty odious numbers (odd population count)               #
INT odious count := 0;
print( ( "odious numbers:" ) );
FOR n WHILE odious count < 30 DO
    IF ODD population count( n ) THEN
        print( ( " ", whole( n, 0 ) ) );
        odious count +:= 1
    FI
OD;
print( ( newline ) )


object PolynomialRegression extends App {
  private def xy = Seq(1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321).zipWithIndex.map(_.swap)

  private def polyRegression(xy: Seq[(Int, Int)]): Unit = {
    val r = xy.indices

    def average[U](ts: Iterable[U])(implicit num: Numeric[U]) = num.toDouble(ts.sum) / ts.size

    def x3m: Double = average(r.map(a => a * a * a))
    def x4m: Double = average(r.map(a => a * a * a * a))
    def x2ym = xy.reduce((a, x) => (a._1 + x._1 * x._1 * x._2, 0))._1.toDouble / xy.size
    def xym = xy.reduce((a, x) => (a._1 + x._1 * x._2, 0))._1.toDouble / xy.size

    val x2m: Double = average(r.map(a => a * a))
    val (xm, ym) = (average(xy.map(_._1)), average(xy.map(_._2)))
    val (sxx, sxy) = (x2m - xm * xm, xym - xm * ym)
    val sxx2: Double = x3m - xm * x2m
    val sx2x2: Double = x4m - x2m * x2m
    val sx2y: Double = x2ym - x2m * ym
    val c: Double = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    val b: Double = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    val a: Double = ym - b * xm - c * x2m

    def abc(xx: Int) = a + b * xx + c * xx * xx

    println(s"y = $a + ${b}x + ${c}x^2")
    println(" Input  Approximation")
    println(" x   y     y1")
    xy.foreach {el => println(f"${el._1}%2d ${el._2}%3d  ${abc(el._1)}%5.1f")}
  }

  polyRegression(xy)

}


begin
    % returns the population count (number of bits on) of the non-negative integer n %
    integer procedure populationCount( integer value n ) ;
            begin
                integer v, count;
                v     := n;
                count := 0;
                while v > 0 do begin
                    if odd( v ) then count := count + 1;
                    v     := v div 2
                end while_v_gt_0 ;
                count
            end populationCount ;
    % returns the sum of population counts of the elements of the array n            %
    %         the bounds of n must be 1 :: length                                    %
    integer procedure arrayPopulationCount( integer array n ( * ); integer value length ) ;
            begin
                integer count;
                count := 0;
                for i := 1 until length do count := count + populationCount( n( i ) );
                count
            end arrayPopulationCount ;
    begin %task requirements %
        integer array power( 1 :: 8 );
        integer n, count, carry;
        % population counts of the first 30 powers of three %
        % Algol W integers are 32-bit, so we simulate 64-bit with an array of integers %
        % the only operation we need is multiplication by 3                            %
        % we use 8 bits of each number                                                 %
        % start with 3^0, which is 1 %
        for i := 1 until 8 do power( i ) := 0;
        power( 1 ) := 1;
        write( i_w := 1, s_w := 0, "3^x  population: ", arrayPopulationCount( power, 8 ) );
        for p := 1 until 29 do begin
            carry := 0;
            for b := 1 until 8 do begin
                integer bValue;
                bValue     := ( power( b ) * 3 ) + carry;
                carry      := bValue div 256;
                power( b ) := bValue rem 256
            end for_b ;
            writeon( i_w := 1, s_w := 0, " ", arrayPopulationCount( power, 8 ) )
        end for_p ;

        % evil numbers (even population count) %
        write( "evil    numbers:" );
        n     := 0;
        count := 0;
        while count < 30 do begin
            if not odd( populationCount( n ) ) then begin
                writeon( i_w := 1, s_w := 0, " ", n );
                count := count + 1
            end if_not_odd_populationCount ;
            n := n + 1
        end evil_numbers_loop ;

        % odious numbers (odd population count %
        write( "odious  numbers:" );
        n     := 0;
        count := 0;
        while count < 30 do begin
            if odd( populationCount( n ) ) then begin
                writeon( i_w := 1, s_w := 0, " ", n );
                count := count + 1
            end if_odd_populationCount ;
            n := n + 1
        end odious_numbers_loop
   end
end.


 APL (DYALOG APL)
 popDemo←{⎕IO←0
     N←⍵
   ⍝ popCount: Does a popCount of integers (8-32 bits) or floats (64-bits) that can be represented as integers
     popCount←{
         i2bits←{∊+/2⊥⍣¯1⊣⍵}  ⍝ Use ⊥⍣¯1 (inverted decode) for ⊤ (encode) to automatically detect nubits needed
         +/i2bits ⍵           ⍝ Count the bits
     }¨

     act3←popCount 3*⍳N

     M←N×2
     actEvil←N↑{⍵/⍨0=2|popCount ⍵}⍳M
     actOdious←N↑{⍵/⍨1=2|popCount ⍵}⍳M

     ⎕←'powers 3'act3
     ⎕←'evil    'actEvil
     ⎕←'odious  'actOdious

   ⍝ Extra: Validate answers are correct
   ⍝    Actual answers
     ans3←1 2 2 4 3 6 6 5 6 8 9 13 10 11 14 15 11 14 14 17 17 20 19 22 16 18 24 30 25 25
     ansEvil←0 3 5 6 9 10 12 15 17 18 20 23 24 27 29 30 33 34 36 39 40 43 45 46 48 51 53 54 57 58
     ansOdious←1 2 4 7 8 11 13 14 16 19 21 22 25 26 28 31 32 35 37 38 41 42 44 47 49 50 52 55 56 59

     '***Passes' '***Fails'⊃⍨(ans3≢act3)∨(actEvil≢ansEvil)∨(actOdious≢ansOdious)
 }


func regress(x, y, degree) {
    var A = Matrix.build(x.len, degree+1, {|i,j|
        x[i]**j
    })

    var B = Matrix.column_vector(y...)
    ((A.transpose * A)**(-1) * A.transpose * B).transpose[0]
}

func poly(x) {
    3*x**2 + 2*x + 1
}

var coeff = regress(
    10.of { _ },
    10.of { poly(_) },
    2
)

say coeff


let x = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
let y = [1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321]

func average(_ input: [Int]) -> Int {
    return input.reduce(0, +) / input.count
}

func polyRegression(x: [Int], y: [Int]) {
    let xm = average(x)
    let ym = average(y)
    let x2m = average(x.map { $0 * $0 })
    let x3m = average(x.map { $0 * $0 * $0 })
    let x4m = average(x.map { $0 * $0 * $0 * $0 })
    let xym = average(zip(x,y).map { $0 * $1 })
    let x2ym = average(zip(x,y).map { $0 * $0 * $1 })

    let sxx = x2m - xm * xm
    let sxy = xym - xm * ym
    let sxx2 = x3m - xm * x2m
    let sx2x2 = x4m - x2m * x2m
    let sx2y = x2ym - x2m * ym

    let b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    let c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
    let a = ym - b * xm - c * x2m

    func abc(xx: Int) -> Int {
        return (a + b * xx) + (c * xx * xx)
    }

    print("y = \(a) + \(b)x + \(c)x^2\n")
    print(" Input  Approximation")
    print(" x   y     y1")

    for i in 0 ..< x.count {
        let result = Double(abc(xx: i))
        print(String(format: "%2d %3d  %5.1f", x[i], y[i], result))
    }
}

polyRegression(x: x, y: y)


--------------------- POPULATION COUNT ---------------------

-- populationCount :: Int -> Int
on populationCount(n)
    -- The number of non-zero bits in the binary
    -- representation of the integer n.

    script go
        on |λ|(x)
            if 0 < x then
                Just({x mod 2, x div 2})
            else
                Nothing()
            end if
        end |λ|
    end script

    integerSum(unfoldr(go, n))
end populationCount

--------------------------- TEST ---------------------------
on run
    set {evens, odds} to partition(compose(even, populationCount), ¬
        enumFromTo(0, 59))

    unlines({"Population counts of the first 30 powers of three:", ¬
        tab & showList(map(compose(populationCount, raise(3)), ¬
        enumFromTo(0, 29))), ¬
        "", ¬
        "First thirty 'evil' numbers:", ¬
        tab & showList(evens), ¬
        "", ¬
        "First thirty 'odious' numbers:", ¬
        tab & showList(odds)})
end run

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

-- Just :: a -> Maybe a
on Just(x)
    -- Constructor for an inhabited Maybe (option type) value.
    -- Wrapper containing the result of a computation.
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    -- Constructor for an empty Maybe (option type) value.
    -- Empty wrapper returned where a computation is not possible.
    {type:"Maybe", Nothing:true}
end Nothing

-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        lst
    else
        {}
    end if
end enumFromTo

-- even :: Int -> Bool
on even(x)
    0 = x mod 2
end even

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
    tell mReturn(f)
        set ys to {}
        set zs to {}
        repeat with x in xs
            set v to contents of x
            if |λ|(v) then
                set end of ys to v
            else
                set end of zs to v
            end if
        end repeat
    end tell
    {ys, zs}
end partition

-- raise :: Num -> Int -> Num
on raise(m)
    script
        on |λ|(n)
            m ^ n
        end |λ|
    end script
end raise

-- integerSum :: [Num] -> Num
on integerSum(xs)
    script addInt
        on |λ|(a, b)
            a + (b as integer)
        end |λ|
    end script

    foldl(addInt, 0, xs)
end integerSum

-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, delim}
    set s to xs as text
    set my text item delimiters to dlm
    s
end intercalate

-- showList :: [a] -> String
on showList(xs)
    "[" & intercalate(",", map(my str, xs)) & "]"
end showList

-- str :: a -> String
on str(x)
    x as string
end str

-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
    -- A list derived from a simple value.
    -- Dual to foldr.
    -- unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
    -- -> [10,9,8,7,6,5,4,3,2,1]
    set xr to {v, v} -- (value, remainder)
    set xs to {}
    tell mReturn(f)
        repeat -- Function applied to remainder.
            set mb to |λ|(item 2 of xr)
            if Nothing of mb then
                exit repeat
            else -- New (value, remainder) tuple,
                set xr to Just of mb
                -- and value appended to output list.
                set end of xs to item 1 of xr
            end if
        end repeat
    end tell
    return xs
end unfoldr

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines