largest = 0

function iscolorful(n, base=10)
    0 <= n < 10 && return true
    dig = digits(n, base=base)
    (1 in dig || 0 in dig || !allunique(dig)) && return false
    products = Set(dig)
    for i in 2:length(dig), j in 1:length(dig)-i+1
        p = prod(dig[j:j+i-1])
        p in products && return false
        push!(products, p)
    end
    if n > largest
        global largest = n
    end
    return true
end

function testcolorfuls()
    println("Colorful numbers for 1:25, 26:50, 51:75, and 76:100:")
    for i in 1:100
        iscolorful(i) && print(rpad(i, 5))
        i % 25 == 0 && println()
    end
    csum = 0
    for i in 0:7
        j, k = i == 0 ? 0 : 10^i, 10^(i+1) - 1
        n = count(i -> iscolorful(i), j:k)
        csum += n
        println("The count of colorful numbers between $j and $k is $n.")
    end
    println("The largest possible colorful number is $largest.")
    println("The total number of colorful numbers is $csum.")
end

testcolorfuls()


ClearAll[ColorfulNumberQ]
ColorfulNumberQ[n_Integer?NonNegative] := Module[{digs, parts},
  If[n > 98765432,
   False
   ,
   digs = IntegerDigits[n];
   parts = Partition[digs, #, 1] & /@ Range[1, Length[digs]];
   parts //= Catenate;
   parts = Times @@@ parts;
   DuplicateFreeQ[parts]
   ]
  ]
Multicolumn[Select[Range[99], ColorfulNumberQ], Appearance -> "Horizontal"]

sel = Union[FromDigits /@ Catenate[Permutations /@ Subsets[Range[2, 9], {1, \[Infinity]}]]];
sel = Join[sel, {0, 1}];
cns = Select[sel, ColorfulNumberQ];

Max[cns]

Tally[IntegerDigits/*Length /@ cns] // Grid

Length[cns]


use strict;
use warnings;
use feature 'say';
use enum qw(False True);
use List::Util <max uniqint product>;
use Algorithm::Combinatorics qw(combinations permutations);

sub table { my $t = shift() * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }

sub is_colorful {
    my($n) = @_;
    return True if 0 <= $n and $n <= 9;
    return False if $n =~ /0|1/ or $n < 0;
    my @digits = split '', $n;
    return False unless @digits == uniqint @digits;
    my @p;
    for my $w (0 .. @digits) {
        push @p, map { product @digits[$_ .. $_+$w] } 0 .. @digits-$w-1;
        return False unless @p == uniqint @p
    }
    True
}

say "Colorful numbers less than 100:\n" . table 10, grep { is_colorful $_ } 0..100;

my $largest = 98765432;
1 while not is_colorful --$largest;
say "Largest magnitude colorful number: $largest\n";

my $total= 10;
map { is_colorful(join '', @$_) and $total++ } map { permutations $_ } combinations [2..9], $_ for 2..8;
say "Total colorful numbers: $total";


with javascript_semantics
function colourful(integer n)
    if n<10 then return n>=0 end if
    sequence digits = sq_sub(sprintf("%d",n),'0'),
                 ud = unique(deep_copy(digits))
    integer ln = length(digits)
    if ud[1]<=1 or length(ud)!=ln then return false end if
    for i=1 to ln-1 do
        for j=i+1 to ln do
           atom prod = product(digits[i..j])
           if find(prod,ud) then return false end if
           ud &= prod
        end for
    end for
    return true
end function

atom t0 = time()
sequence cn = apply(true,sprintf,{{"%2d"},filter(tagset(100,0),colourful)})
printf(1,"The %d colourful numbers less than 100 are:\n%s\n",
         {length(cn),join_by(cn,1,10,"  ")})

sequence count = repeat(0,8),
         used = repeat(false,10)
integer largestcn = 0

procedure count_colourful(integer taken=0, string n="")
    if taken=0 then
        for digit='0' to '9' do
            integer dx = digit-'0'+1
            used[dx] = true
            count_colourful(iff(digit<'2'?9:1),""&digit)
            used[dx] = false
        end for
    else
        integer nn = to_integer(n)
        if colourful(nn) then
            integer ln = length(n)
            count[ln] += 1
            if nn>largestcn then largestcn = nn end if
        end if
        if taken<9 then
            for digit='2' to '9' do
                integer dx = digit-'0'+1
                if not used[dx] then
                    used[dx] = true
                    count_colourful(taken+1,n&digit)
                    used[dx] = false
                end if
            end for
        end if
    end if
end procedure
count_colourful()
printf(1,"The largest possible colourful number is: %,d\n\n",largestcn)
atom pow = 10
for dc=1 to length(count) do
    printf(1,"  %d digit colourful number count: %,6d - %7.3f%%\n",
               {dc, count[dc], 100*count[dc]/pow})
    pow = iff(pow=10?90:pow*10)
end for
printf(1,"\nTotal colourful numbers: %,d\n", sum(count))
?elapsed(time()-t0)


colorful_number(N) =>
  N < 10 ;
  (X = N.to_string,
   X.len <= 8,
   not membchk('0',X),
   not membchk('1',X),
   distinct(X),
   [prod(S.map(to_int)) : S in  findall(S,(append(_,S,_,X),S != [])) ].distinct).

distinct(L) =>
  L.len == L.remove_dups.len.


sub is-colorful (Int $n) {
    return True if 0 <= $n <= 9;
    return False if $n.contains(0) || $n.contains(1) || $n < 0;
    my @digits = $n.comb;
    my %sums = @digits.Bag;
    return False if %sums.values.max > 1;
    for 2..@digits -> $group {
        @digits.rotor($group => 1 - $group).map: { %sums{ [×] $_ }++ }
        return False if %sums.values.max > 1;
    }
    True
}

put "Colorful numbers less than 100:\n" ~ (^100).race.grep( &is-colorful).batch(10)».fmt("%2d").join: "\n";

my ($start, $total) = 23456789, 10;

print "\nLargest magnitude colorful number: ";
.put and last if .Int.&is-colorful for $start.flip … $start;

put "\nCount of colorful numbers for each order of magnitude:\n" ~
    "1 digit colorful number count: $total - 100%";

for 2..8 {
   put "$_ digit colorful number count: ",
   my $c = +(flat $start.comb.combinations($_).map: {.permutations».join».Int}).race.grep( &is-colorful ),
   " - {($c / (exp($_,10) - exp($_-1,10) ) * 100).round(.001)}%";
   $total += $c;
}

say "\nTotal colorful numbers: $total";


import "./math" for Int, Nums
import "./set" for Set
import "./seq" for Lst
import "./fmt" for Fmt

var isColorful = Fn.new { |n|
    if (n < 0) return false
    if (n < 10) return true
    var digits = Int.digits(n)
    if (digits.contains(0) || digits.contains(1)) return false
    var set = Set.new(digits)
    var dc = digits.count
    if (set.count < dc) return false
    for (k in 2..dc) {
        for (i in 0..dc-k) {
           var prod = 1
           for (j in i..i+k-1) prod = prod * digits[j]
           if (set.contains(prod)) return false
           set.add(prod)
        }
    }
    return true
}

var count = List.filled(9, 0)
var used  = List.filled(11, false)
var largest = 0

var countColorful // recursive
countColorful = Fn.new { |taken, n|
    if (taken == 0) {
        for (digit in 0..9) {
            var dx = digit + 1
            used[dx] = true
            countColorful.call((digit < 2) ? 9 : 1, String.fromByte(digit + 48))
            used[dx] = false
        }
    } else {
        var nn = Num.fromString(n)
        if (isColorful.call(nn)) {
            var ln = n.count
            count[ln] = count[ln] + 1
            if (nn > largest) largest = nn
        }
        if (taken < 9) {
            for (digit in 2..9) {
                var dx = digit + 1
                if (!used[dx]) {
                    used[dx] = true
                    countColorful.call(taken + 1, n + String.fromByte(digit + 48))
                    used[dx] = false
                }
            }
        }
    }
}

var cn = (0..99).where { |i| isColorful.call(i) }.toList
System.print("The %(cn.count) colorful numbers less than 100 are:")
for (chunk in Lst.chunks(cn, 10)) Fmt.print("$2d", chunk)

countColorful.call(0, "")
System.print("\nThe largest possible colorful number is:")
Fmt.print("$,d\n", largest)

System.print("Count of colorful numbers for each order of magnitude:")
var pow = 10
for (dc in 1...count.count) {
    Fmt.print("  $d digit colorful number count: $,6d - $7.3f\%", dc, count[dc], 100 * count[dc] / pow)
    pow = (pow == 10) ? 90 : pow * 10
}

Fmt.print("\nTotal colorful numbers: $,d", Nums.sum(count))


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

func Colorful(N);       \Return 'true' if N is a colorful number
int  N, Digits, R, I, J, Prod;
def  Size = 9*8*7*6*5*4*3*2 + 1;
char Used(Size), Num(10);
[if N < 10 then return true;    \single digit number is colorful
FillMem(Used, false, 10);       \digits must be unique
Digits:= 0;
repeat  N:= N/10;               \slice digits off N
        R:= rem(0);
        if N=1 or R=0 or R=1 then return false;
        if Used(R) then return false;
        Used(R):= true;         \digits must be unique
        Num(Digits):= R;
        Digits:= Digits+1;
until   N = 0;
FillMem(Used+10, false, Size-10); \products must be unique
for I:= 0 to Digits-2 do
    [Prod:= Num(I);
    for J:= I+1 to Digits-1 do
        [Prod:= Prod * Num(J);
        if Used(Prod) then return false;
        Used(Prod):= true;
        ];
    ];
return true;
];

int Count, N, Power, Total;
[Text(0, "Colorful numbers less than 100:
");
Count:= 0;
for N:= 0 to 99 do
    if Colorful(N) then
        [IntOut(0, N);
        Count:= Count+1;
        if rem(Count/10) then ChOut(0, 9\tab\) else CrLf(0);
        ];
Text(0, "

Largest magnitude colorful number: ");
N:= 98_765_432;
loop    [if Colorful(N) then quit;
        N:= N-1;
        ];
IntOut(0, N);
Text(0, "

Count of colorful numbers for each order of magnitude:
");
Total:= 0;
for Power:= 1 to 8 do
    [Count:= if Power=1 then 1 else 0;
    for N:= IPow(10, Power-1) to IPow(10, Power)-1 do
        if Colorful(N) then Count:= Count+1;
    IntOut(0, Power);
    Text(0, " digit colorful number count: ");
    IntOut(0, Count);
    CrLf(0);
    Total:= Total + Count;
    ];
Text(0, "
Total colorful numbers: ");
IntOut(0, Total);
CrLf(0);
]


F combsReps(lst, k)
   T Ty = T(lst[0])
   I k == 0
      R [[Ty]()]
   I lst.empty
      R [[Ty]]()
   R combsReps(lst, k - 1).map(x -> @lst[0] [+] x) [+] combsReps(lst[1..], k)

print(combsReps([‘iced’, ‘jam’, ‘plain’], 2))
print(combsReps(Array(1..10), 3).len)


*        Combinations with repetitions - 16/04/2019
COMBREP  CSECT
         USING  COMBREP,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
         MVC    FLAVORS(9),SET1    flavors=3,draws=2,tell=1
         BAL    R14,COMBINE        call combine
         MVC    FLAVORS(9),SET2    flavors=10,draws=3,tell=0
         BAL    R14,COMBINE        call combine
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
COMBINE  SR     R9,R9              n=0
         MVI    V,X'00'            ~
         MVC    V+1(NN*L'V-1),V    v=0
       IF   CLI,TELL,EQ,X'01' THEN if tell then
         XPRNT  =C'list:',5          print
       ENDIF    ,                  endif
LOOP     LA     R6,1               i=1
       DO WHILE=(C,R6,LE,DRAWS)    do i=1 to draws
         LR     R1,R6                i
         SLA    R1,2                 ~
         L      R2,V-4(R1)           v(i)
         L      R3,FLAVORS           flavors
         BCTR   R3,0                 flavors-1
       IF    CR,R2,GT,R3 THEN        if v(i)>flavors-1 then
         LR     R1,R6                  i
         SLA    R1,2                   ~
         LA     R1,V(R1)               @v(i+1)
         L      R2,0(R1)               v(i+1)
         LA     R2,1(R2)               v(i+1)+1
         ST     R2,0(R1)               v(i+1)=v(i+1)+1
         LR     R7,R6                  j=i
       DO WHILE=(C,R7,GE,=A(1))        do j=i to 1 by -1
         LR     R1,R6                    i
         SLA    R1,2                     ~
         L      R2,V(R1)                 v(i+1)
         LR     R1,R7                    j
         SLA    R1,2                     ~
         ST     R2,V-4(R1)               v(j)=v(i+1)
         BCTR   R7,0                     j--
       ENDDO    ,                      enddo j
       ENDIF    ,                    endif
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R1,DRAWS           draws
         LA     R1,1(R1)           draws+1
         SLA    R1,2               ~
         L      R2,V-4(R1)         v(draws+1)
         LTR    R2,R2              if v(draws+1)>0
         BP     EXITLOOP           then exit loop
         LA     R9,1(R9)           n=n+1
       IF   CLI,TELL,EQ,X'01' THEN if tell then
         MVC    BUF,=CL60' '         buf=' '
         LA     R10,1                ibuf=1
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,DRAWS)      do i=1 to draws
         LR     R1,R6                  i
         SLA    R1,2                   ~
         L      R1,V-4(R1)             v(i)
         MH     R1,=AL2(L'ITEMS)       ~
         LA     R4,ITEMS(R1)           @items(v(i)+1)
         LA     R5,BUF-1               @buf-1
         AR     R5,R10                 +ibuf
         MVC    0(6,R5),0(R4)          substr(buf,ibuf,6)=items(v(i)+1)
         LA     R10,L'ITEMS(R10)       ibuf=ibuf+length(items)
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         XPRNT  BUF,L'BUF            print buf
       ENDIF    ,                    endif
         L      R2,V                 v(1)
         LA     R2,1(R2)             v(1)+1
         ST     R2,V                 v(1)=v(1)+1
         B      LOOP               loop
EXITLOOP L      R1,FLAVORS           flavors
         XDECO  R1,XDEC              edit flavors
         MVC    PG+4(2),XDEC+10      output flavors
         L      R1,DRAWS             draws
         XDECO  R1,XDEC              edit draws
         MVC    PG+7(2),XDEC+10      output draws
         XDECO  R9,PG+11             edit & output n
         XPRNT  PG,L'PG              print buffer
         BR     R14                return
NN       EQU    16
ITEMS    DC     CL6'iced',CL6'jam',CL6'plain'
FLAVORS  DS     F
DRAWS    DS     F
TELL     DS     X
SET1     DC     F'3',F'2',X'01'    flavors=3,draws=2,tell=1
SET2     DC     F'10',F'3',X'00'   flavors=10,draws=3,tell=0
V        DS     (NN)F              v(nn)
BUF      DS     CL60               buf
PG       DC     CL40'cwr(..,..)=............'
XDEC     DS     CL12               temp for xdeco
         REGEQU
         END    COMBREP


PROC PrintComb(BYTE ARRAY c BYTE len)
  BYTE i,ind

  FOR i=0 TO len-1
  DO
    IF i>0 THEN Put('+) FI
    ind=c(i)
    IF ind=0 THEN
      Print("iced")
    ELSEIF ind=1 THEN
      Print("jam")
    ELSE
      Print("plain")
    FI
  OD
  PutE()
RETURN

BYTE FUNC NotDecreasing(BYTE ARRAY c BYTE len)
  BYTE i

  IF len<2 THEN RETURN (1) FI

  FOR i=0 TO len-2
  DO
    IF c(i)>c(i+1) THEN
      RETURN (0)
    FI
  OD
RETURN (1)

BYTE FUNC NextComb(BYTE ARRAY c BYTE n,k)
  INT pos,i

  DO
    pos=k-1
    DO
      c(pos)==+1
      IF c(pos)<n THEN
        EXIT
      ELSE
        pos==-1
        IF pos<0 THEN RETURN (0) FI
      FI
      FOR i=pos+1 TO k-1
      DO
        c(i)=c(pos)
      OD
    OD
  UNTIL NotDecreasing(c,k)
  OD
RETURN (1)

PROC Comb(BYTE n,k,show)
  BYTE ARRAY c(10)
  BYTE i,count

  IF k>n THEN
    Print("Error! k is greater than n.")
    Break()
  FI

  PrintF("Choices of %B from %B:%E",k,n)
  FOR i=0 TO k-1
  DO
    c(i)=0
  OD

  count=0
  DO
    count==+1
    IF show THEN
      PrintF(" %B. ",count)
      PrintComb(c,k)
    FI
  UNTIL NextComb(c,n,k)=0
  OD
  PrintF("Total choices %B%E%E",count)
RETURN

PROC Main()
  Comb(3,2,1)
  Comb(10,3,0)
RETURN


with Ada.Text_IO;
procedure Combinations is

   generic
      type Set is (<>);
   function Combinations
     (Count  : Positive;
      Output : Boolean := False)
      return   Natural;

   function Combinations
     (Count  : Positive;
      Output : Boolean := False)
      return   Natural
   is
      package Set_IO is new Ada.Text_IO.Enumeration_IO (Set);
      type Set_Array is array (Positive range <>) of Set;
      Empty_Array : Set_Array (1 .. 0);
      function Recurse_Combinations
        (Number : Positive;
         First  : Set;
         Prefix : Set_Array)
         return   Natural
      is
         Combination_Count : Natural := 0;
      begin
         for Next in First .. Set'Last loop
            if Number = 1 then
               Combination_Count := Combination_Count + 1;
               if Output then
                  for Element in Prefix'Range loop
                     Set_IO.Put (Prefix (Element));
                     Ada.Text_IO.Put ('+');
                  end loop;
                  Set_IO.Put (Next);
                  Ada.Text_IO.New_Line;
               end if;
            else
               Combination_Count := Combination_Count +
                                    Recurse_Combinations
                                       (Number - 1,
                                        Next,
                                        Prefix & (1 => Next));
            end if;
         end loop;
         return Combination_Count;
      end Recurse_Combinations;
   begin
      return Recurse_Combinations (Count, Set'First, Empty_Array);
   end Combinations;

   type Donuts is (Iced, Jam, Plain);
   function Donut_Combinations is new Combinations (Donuts);

   subtype Ten is Positive range 1 .. 10;
   function Ten_Combinations is new Combinations (Ten);

   Donut_Count : constant Natural :=
      Donut_Combinations (Count => 2, Output => True);
   Ten_Count   : constant Natural := Ten_Combinations (Count => 3);
begin
   Ada.Text_IO.Put_Line ("Total Donuts:" & Natural'Image (Donut_Count));
   Ada.Text_IO.Put_Line ("Total Tens:" & Natural'Image (Ten_Count));
end Combinations;


--------------- COMBINATIONS WITH REPETITION -------------

-- combinationsWithRepetition :: Int -> [a] -> [kTuple a]
on combinationsWithRepetition(k, xs)
    -- A list of lists, representing
    -- sets of cardinality k, with
    -- members drawn from xs.

    script combinationsBySize
        script f
            on |λ|(a, x)
                script prefix
                    on |λ|(z)
                        {x} & z
                    end |λ|
                end script

                script go
                    on |λ|(ys, xs)
                        xs & map(prefix, ys)
                    end |λ|
                end script

                scanl1(go, a)
            end |λ|
        end script

        on |λ|(xs)
            foldl(f, {{{}}} & take(k, |repeat|({})), xs)
        end |λ|
    end script

    |Just| of |index|(|λ|(xs) of combinationsBySize, 1 + k)
end combinationsWithRepetition

--------------------------- TEST -------------------------
on run
    {length of combinationsWithRepetition(3, enumFromTo(0, 9)), ¬
        combinationsWithRepetition(2, {"iced", "jam", "plain"})}
end run

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

-- Just :: a -> Maybe a
on Just(x)
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    {type:"Maybe", Nothing:true}
end Nothing

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

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

-- index (!!) :: [a] -> Int -> Maybe a
-- index (!!) :: Gen [a] -> Int -> Maybe a
-- index (!!) :: String -> Int -> Maybe Char
on |index|(xs, i)
    if script is class of xs then
        repeat with j from 1 to i
            set v to |λ|() of xs
        end repeat
        if missing value is not v then
            Just(v)
        else
            Nothing()
        end if
    else
        if length of xs < i then
            Nothing()
        else
            Just(item i of xs)
        end if
    end if
end |index|

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

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

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

-- repeat :: a -> Generator [a]
on |repeat|(x)
    script
        on |λ|()
            return x
        end |λ|
    end script
end |repeat|

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

-- scanl1 :: (a -> a -> a) -> [a] -> [a]
on scanl1(f, xs)
    if 0 < length of xs then
        scanl(f, item 1 of xs, rest of xs)
    else
        {}
    end if
end scanl1

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take


;===========================================================
; based on "https://www.geeksforgeeks.org/combinations-with-repetitions/"
;===========================================================
CombinationRepetition(arr, k:=0, Delim:="") {
	CombinationRepetitionUtil(arr, k?k:str.count(), Delim, [k+1], result:=[])
	return result
} ;===========================================================
CombinationRepetitionUtil(arr, k, Delim, chosen, result , index:=1, start:=1){
	line := [], i:=0, 	res := ""
	if (index = k+1){
		while (++i <= k)
			res .= arr[chosen[i]] Delim,	line.push(arr[chosen[i]])
		return result.Push(Trim(res, Delim))
	}
	i:=start
	while (i <= arr.count())
		chosen[Index]:=i, 	CombinationRepetitionUtil(arr, k, Delim, chosen, result, index+1, i++)
} ;===========================================================


# syntax: GAWK -f COMBINATIONS_WITH_REPETITIONS.AWK
BEGIN {
    n = split("iced,jam,plain",donuts,",")
    for (i=1; i<=n; i++) {
      for (j=1; j<=n; j++) {
        if (donuts[i] < donuts[j]) {
          key = sprintf("%s %s",donuts[i],donuts[j])
        }
        else {
          key = sprintf("%s %s",donuts[j],donuts[i])
        }
        arr[key]++
      }
    }
    cmd = "SORT"
    for (i in arr) {
      printf("%s\n",i) | cmd
      choices++
    }
    close(cmd)
    printf("choices = %d\n",choices)
    exit(0)
}


arraybase 0
print "Enter n comb m.  "
input integer "n:  ", n
input integer "m:  ", m
outstr$ = ""
dim names$(m)

for i = 0 to m - 1
	print "Name for item "; i; ":  ";
	input string names$[i]
next i
call iterate (outstr$, 0, m-1, n-1, names$)
end

subroutine iterate(curr$, start, stp, depth, names$)
	for i = start to stp
		if depth = 0 then
			print curr$; " "; names$[i]
		else
			call iterate (curr$ & " " & names$[i], i, stp, depth-1, names$)
		end if
	next i
	return
end subroutine


      DIM list$(2), chosen%(2)
      list$() = "iced", "jam", "plain"
      PRINT "Choices of 2 from 3:"
      choices% = FNchoose(0, 2, 0, 3, chosen%(), list$())
      PRINT "Total choices = " ; choices%

      PRINT '"Choices of 3 from 10:"
      choices% = FNchoose(0, 3, 0, 10, chosen%(), nul$())
      PRINT "Total choices = " ; choices%
      END

      DEF FNchoose(n%, l%, p%, m%, g%(), RETURN n$())
      LOCAL i%, c%
      IF n% = l% THEN
        IF !^n$() THEN
          FOR i% = 0 TO n%-1
            PRINT " " n$(g%(i%)) ;
          NEXT
          PRINT
        ENDIF
        = 1
      ENDIF
      FOR i% = p% TO m%-1
        g%(n%) = i%
        c% += FNchoose(n% + 1, l%, i%, m%, g%(), n$())
      NEXT
      = c%


( ( choices
  =   n things thing result
    .   !arg:(?n.?things)
      & ( !n:0&1
        |   0:?result
          & (   !things
              :   ?
                  ( %?`thing ?:?things
                  &   !thing*choices$(!n+-1.!things)+!result
                    : ?result
                  & ~
                  )
            | !result
            )
        )
  )
& out$(choices$(2.iced jam plain))
& out$(choices$(3.iced jam plain butter marmite tahin fish salad onion grass):?+[?N&!N)
);


#include <stdio.h>

const char *donuts[] = {"iced", "jam", "plain",
                        "something completely different"};
int pos[] = {0, 0, 0, 0};

void printDonuts(int k) {
  for (size_t i = 1; i < k + 1; i += 1) // offset: i:1..N, N=k+1
    printf("%s\t", donuts[pos[i]]);     // str:0..N-1
  printf("\n");
}

// idea: custom number system with 2s complement like 0b10...0==MIN stop case
void combination_with_repetiton(int n, int k) {
  while (1) {
    for (int i = k; i > 0; i -= 1) {
      if (pos[i] > n - 1) // if number spilled over: xx0(n-1)xx
      {
        pos[i - 1] += 1; // set xx1(n-1)xx
        for (int j = i; j <= k; j += 1)
          pos[j] = pos[j - 1]; // set xx11..1
      }
    }
    if (pos[0] > 0) // stop condition: 1xxxx
      break;
    printDonuts(k);
    pos[k] += 1; // xxxxN -> xxxxN+1
  }
}

int main() {
  combination_with_repetiton(3, 2);
  return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

public static class MultiCombinations
{
    private static void Main()
    {
        var set = new List<string> { "iced", "jam", "plain" };
        var combinations = GenerateCombinations(set, 2);

        foreach (var combination in combinations)
        {
            string combinationStr = string.Join(" ", combination);
            Console.WriteLine(combinationStr);
        }

        var donuts = Enumerable.Range(1, 10).ToList();

        int donutsCombinationsNumber = GenerateCombinations(donuts, 3).Count;

        Console.WriteLine("{0} ways to order 3 donuts given 10 types", donutsCombinationsNumber);
    }

    private static List<List<T>> GenerateCombinations<T>(List<T> combinationList, int k)
    {
        var combinations = new List<List<T>>();

        if (k == 0)
        {
            var emptyCombination = new List<T>();
            combinations.Add(emptyCombination);

            return combinations;
        }

        if (combinationList.Count == 0)
        {
            return combinations;
        }

        T head = combinationList[0];
        var copiedCombinationList = new List<T>(combinationList);

        List<List<T>> subcombinations = GenerateCombinations(copiedCombinationList, k - 1);

        foreach (var subcombination in subcombinations)
        {
            subcombination.Insert(0, head);
            combinations.Add(subcombination);
        }

        combinationList.RemoveAt(0);
        combinations.AddRange(GenerateCombinations(combinationList, k));

        return combinations;
    }
}


#include <iostream>
#include <string>
#include <vector>

void print_vector(const std::vector<int> &pos,
                  const std::vector<std::string> &str) {
  for (size_t i = 1; i < pos.size(); ++i) // offset: i:1..N
    printf("%s\t", str[pos[i]].c_str());  // str:      0..N-1
  printf("\n");
}

// idea: custom number system with 2s complement like 0b10...0==MIN stop case
void combination_with_repetiton(int n, int k,
                                const std::vector<std::string> &str) {
  std::vector<int> pos(k + 1, 0);
  while (true) {
    for (int i = k; i > 0; i -= 1) {
      if (pos[i] > n - 1) // if number spilled over: xx0(n-1)xx
      {
        pos[i - 1] += 1; // set xx1(n-1)xx
        for (int j = i; j <= k; j += 1)
          pos[j] = pos[j - 1]; // set xx11..1
      }
    }
    if (pos[0] > 0) // stop condition: 1xxxx
      break;
    print_vector(pos, str);
    pos[k] += 1; // xxxxN -> xxxxN+1
  }
}

int main() {
  std::vector<std::string> str{"iced", "jam", "plain"};
  combination_with_repetiton(3, 2, str);
  return 0;
}


(defn combinations [coll k]
  (when-let [[x & xs] coll]
    (if (= k 1)
      (map list coll)
      (concat (map (partial cons x) (combinations coll (dec k)))
              (combinations xs k)))))


combos = (arr, k) ->
  return [ [] ] if k == 0
  return [] if arr.length == 0

  combos_with_head = ([arr[0]].concat combo for combo in combos arr, k-1)
  combos_sans_head = combos arr[1...], k
  combos_with_head.concat combos_sans_head

arr = ['iced', 'jam', 'plain']
console.log "valid pairs from #{arr.join ','}:"
console.log combos arr, 2
console.log "#{combos([1..10], 3).length} ways to order 3 donuts given 10 types"


(defun combinations (xs k)
  (let ((x (car xs)))
    (cond
     ((null xs) nil)
     ((= k 1) (mapcar #'list xs))
     (t (append (mapcar (lambda (ys) (cons x ys))
			(combinations xs (1- k)))
		(combinations (cdr xs) k))))))


possible_doughnuts = ["iced", "jam", "plain"].repeated_combinations(2)
puts "There are #{possible_doughnuts.size} possible doughnuts:"
possible_doughnuts.each{|doughnut_combi| puts doughnut_combi.join(" and ")}

# Extra credit
possible_doughnuts = (1..10).to_a.repeated_combinations(3)
# size returns the size of the enumerator, or nil if it can’t be calculated lazily.
puts "", "#{possible_doughnuts.size} ways to order 3 donuts given 10 types."


import std.stdio, std.range;

const struct CombRep {
    immutable uint nt, nc;
    private const ulong[] combVal;

    this(in uint numType, in uint numChoice) pure nothrow @safe
    in {
        assert(0 < numType && numType + numChoice <= 64,
               "Valid only for nt + nc <= 64 (ulong bit size)");
    } body {
        nt = numType;
        nc = numChoice;
        if (nc == 0)
            return;
        ulong v  = (1UL << (nt - 1)) - 1;

        // Init to smallest number that has nt-1 bit set
        // a set bit is metaphored as a _type_ seperator.
        immutable limit = v << nc;

        ulong[] localCombVal;
        // Limit is the largest nt-1 bit set number that has nc
        // zero-bit a zero-bit means a _choice_ between _type_
        // seperators.
        while (v <= limit) {
            localCombVal ~= v;
            if (v == 0)
                break;
            // Get next nt-1 bit number.
            immutable t = (v | (v - 1)) + 1;
            v = t | ((((t & -t) / (v & -v)) >> 1) - 1);
        }
        this.combVal = localCombVal;
    }

    uint length() @property const pure nothrow @safe {
        return combVal.length;
    }

    uint[] opIndex(in uint idx) const pure nothrow @safe {
        return val2set(combVal[idx]);
    }

    int opApply(immutable int delegate(in ref uint[]) pure nothrow @safe dg)
    pure nothrow @safe {
        foreach (immutable v; combVal) {
            auto set = val2set(v);
            if (dg(set))
                break;
        }
        return 1;
    }

    private uint[] val2set(in ulong v) const pure nothrow @safe {
        // Convert bit pattern to selection set
        immutable uint bitLimit = nt + nc - 1;
        uint typeIdx = 0;
        uint[] set;
        foreach (immutable bitNum; 0 .. bitLimit)
            if (v & (1 << (bitLimit - bitNum - 1)))
                typeIdx++;
            else
                set ~= typeIdx;
        return set;
    }
}

// For finite Random Access Range.
auto combRep(R)(R types, in uint numChoice) /*pure*/ nothrow @safe
if (hasLength!R && isRandomAccessRange!R) {
    ElementType!R[][] result;

    foreach (const s; CombRep(types.length, numChoice)) {
        ElementType!R[] r;
        foreach (immutable i; s)
            r ~= types[i];
        result ~= r;
    }

    return result;
}

void main() @safe {
    foreach (const e; combRep(["iced", "jam", "plain"], 2))
        writefln("%-(%5s %)", e);
    writeln("Ways to select 3 from 10 types is ",
            CombRep(10, 3).length);
}


items$[] = [ "iced" "jam" "plain" ]
n = len items$[]
k = 2
len result[] k
n_results = 0
#
func output . .
  n_results += 1
  if len items$[] > 0
    for r in result[]
      write items$[r] & " "
    .
    print ""
  .
.
func combine pos val . .
  if pos = k
    call output
  else
    for i = val to n - 1
      result[pos] = i
      call combine pos + 1 i
    .
  .
.
call combine 0 0
#
n = 10
k = 3
len result[] k
items$[] = [ ]
n_results = 0
call combine 0 0
print ""
print n_results & " results with 10 donuts"


;;
;; native function : combinations/rep in list.lib
;;
(lib 'list)

(combinations/rep '(iced jam plain) 2)
   → ((iced iced) (iced jam) (iced plain) (jam jam) (jam plain) (plain plain))

;;
;; using a combinator iterator
;;
(lib 'sequences)

(take (combinator/rep '(iced jam plain) 2) 8)
    → ((iced iced) (iced jam) (iced plain) (jam jam) (jam plain) (plain plain))

;;
;; or, implementing the function
;;

(define (comb/rep nums k)
	(cond
	[(null? nums) null]
	[(<= k 0) null]
	[(= k 1) (map list nums)]
	[else
		(for/fold (acc null) ((anum nums))
		(append acc
	  		(for/list ((xs (comb/rep nums (1- k))))
	  		#:continue (< (first xs) anum)
	  		(cons anum xs))))]))

(map (curry list-permute '(iced jam plain)) (comb/rep (iota 3) 2))
    → ((iced iced) (iced jam) (iced plain) (jam jam) (jam plain) (plain plain))

;;
;; extra credit
;;

(length (combinator/rep (iota 10) 3))
    → 220


(define $comb/rep
  (lambda [$n $xs]
    (match-all xs (list something)
      [(loop $i [1 ,n] <join _ (& <cons $a_i _> ...)> _) a])))

(test (comb/rep 2 {"iced" "jam" "plain"}))


defmodule RC do
  def comb_rep(0, _), do: [[]]
  def comb_rep(_, []), do: []
  def comb_rep(n, [h|t]=s) do
    (for l <- comb_rep(n-1, s), do: [h|l]) ++ comb_rep(n, t)
  end
end

s = [:iced, :jam, :plain]
Enum.each(RC.comb_rep(2, s), fn x -> IO.inspect x end)

IO.puts  "\nExtra credit: #{length(RC.comb_rep(3, Enum.to_list(1..10)))}"


-module(comb).
-compile(export_all).

comb_rep(0,_) ->
    [[]];
comb_rep(_,[]) ->
    [];
comb_rep(N,[H|T]=S) ->
    [[H|L] || L <- comb_rep(N-1,S)]++comb_rep(N,T).


program main
	integer :: chosen(4)
	integer :: ssize

	character(len=50) :: donuts(4) = [ "iced", "jam", "plain", "something completely different" ]

	ssize = choose( chosen, 2, 3 )
	write(*,*) "Total = ", ssize

	contains

	recursive function choose( got, len, maxTypes, nChosen, at ) result ( output )
		integer :: got(:)
		integer :: len
		integer :: maxTypes
		integer :: output
		integer, optional :: nChosen
		integer, optional :: at

		integer :: effNChosen
		integer :: effAt

		integer :: i
		integer :: counter

		effNChosen = 1
		if( present(nChosen) ) effNChosen = nChosen

		effAt = 1
		if( present(at) ) effAt = at

		if ( effNChosen == len+1 ) then
			do i=1,len
				write(*,"(A10,5X)", advance='no') donuts( got(i)+1 )
			end do

			write(*,*) ""

			output = 1
			return
		end if

		counter = 0
		do i=effAt,maxTypes
			got(effNChosen) = i-1
			counter = counter + choose( got, len, maxTypes, effNChosen + 1, i )
		end do

		output = counter
		return
	end function choose

end program main


sub iterate( byval curr as string, byval start as uinteger,_
             byval stp as uinteger, byval depth as uinteger,_
             names() as string )
    dim as uinteger i
    for i = start to stp
        if depth = 0 then
            print curr + " " + names(i)
        else
            iterate  curr+" "+names(i), i, stp, depth-1, names()
        end if
    next i
    return
end sub

dim as uinteger m, n, o, i
input "Enter n comb m.  ", n, m
dim as string outstr = ""
dim as string names(0 to m-1)
for i = 0 to m - 1
    print "Name for item ",+i
    input names(i)
next i
iterate outstr, 0, m-1, n-1, names()


F comb(arr, k)
   I k == 0
      R [[Int]()]

   [[Int]] result
   L(x) arr
      V i = L.index
      L(suffix) comb(arr[i+1..], k-1)
         result [+]= x [+] suffix

   R result

print(comb([0, 1, 2, 3, 4], 3))


# Built-in
UnorderedTuples(["iced", "jam", "plain"], 2);


package main

import "fmt"

func combrep(n int, lst []string) [][]string {
    if n == 0 {
        return [][]string{nil}
    }
    if len(lst) == 0 {
        return nil
    }
    r := combrep(n, lst[1:])
    for _, x := range combrep(n-1, lst) {
        r = append(r, append(x, lst[0]))
    }
    return r
}

func main() {
    fmt.Println(combrep(2, []string{"iced", "jam", "plain"}))
    fmt.Println(len(combrep(3,
        []string{"1", "2", "3", "4", "5", "6", "7", "8", "9", "10"})))
}


*        Combinations              26/05/2016
COMBINE  CSECT
         USING  COMBINE,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         SR     R3,R3              clear
         LA     R7,C               @c(1)
         LH     R8,N               v=n
LOOPI1   STC    R8,0(R7)           do i=1 to n; c(i)=n-i+1
         LA     R7,1(R7)             @c(i)++
         BCT    R8,LOOPI1          next i
LOOPBIG  LA     R10,PG             big loop {------------------
         LH     R1,N               n
         LA     R7,C-1(R1)         @c(i)
         LH     R6,N               i=n
LOOPI2   IC     R3,0(R7)           do i=n to 1 by -1; r2=c(i)
         XDECO  R3,PG+80             edit c(i)
         MVC    0(2,R10),PG+90       output c(i)
         LA     R10,3(R10)           @[email protected]+3
         BCTR   R7,0                 @c(i)--
         BCT    R6,LOOPI2          next i
         XPRNT  PG,80              print buffer
         LA     R7,C               @c(1)
         LH     R8,M               v=m
         LA     R6,1               i=1
LOOPI3   LR     R1,R6              do i=1 by 1; r1=i
         IC     R3,0(R7)             c(i)
         CR     R3,R8                while c(i)>=m-i+1
         BL     ELOOPI3              leave i
         CH     R6,N                 if i>=n
         BNL    ELOOPBIG             exit loop
         BCTR   R8,0                 v=v-1
         LA     R7,1(R7)             @c(i)++
         LA     R6,1(R6)             i=i+1
         B      LOOPI3             next i
ELOOPI3  LR     R1,R6              i
         LA     R4,C-1(R1)         @c(i)
         IC     R3,0(R4)           c(i)
         LA     R3,1(R3)           c(i)+1
         STC    R3,0(R4)           c(i)=c(i)+1
         BCTR   R7,0               @c(i)--
LOOPI4   CH     R6,=H'2'           do i=i to 2 by -1
         BL     ELOOPI4            leave i
         IC     R3,1(R7)             c(i)
         LA     R3,1(R3)             c(i)+1
         STC    R3,0(R7)             c(i-1)=c(i)+1
         BCTR   R7,0                 @c(i)--
         BCTR   R6,0                 i=i-1
         B      LOOPI4             next i
ELOOPI4  B      LOOPBIG            big loop }------------------
ELOOPBIG L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
M        DC     H'5'               <=input
N        DC     H'3'               <=input
C        DS     64X                array of 8 bit integers
PG       DC     CL92' '            buffer
         YREGS
         END    COMBINE


PROC PrintComb(BYTE ARRAY c BYTE len)
  BYTE i

  Put('()
  FOR i=0 TO len-1
  DO
    IF i>0 THEN Put(',) FI
    PrintB(c(i))
  OD
  Put(')) PutE()
RETURN

BYTE FUNC Increasing(BYTE ARRAY c BYTE len)
  BYTE i

  IF len<2 THEN RETURN (1) FI

  FOR i=0 TO len-2
  DO
    IF c(i)>=c(i+1) THEN
      RETURN (0)
    FI
  OD
RETURN (1)

BYTE FUNC NextComb(BYTE ARRAY c BYTE n,k)
  INT pos,i

  DO
    pos=k-1
    DO
      c(pos)==+1
      IF c(pos)<n THEN
        EXIT
      ELSE
        pos==-1
        IF pos<0 THEN RETURN (0) FI
      FI
      FOR i=pos+1 TO k-1
      DO
        c(i)=c(pos)
      OD
    OD
  UNTIL Increasing(c,k)
  OD
RETURN (1)

PROC Comb(BYTE n,k)
  BYTE ARRAY c(10)
  BYTE i

  IF k>n THEN
    Print("Error! k is greater than n.")
    Break()
  FI

  FOR i=0 TO k-1
  DO
    c(i)=i
  OD

  DO
    PrintComb(c,k)
  UNTIL NextComb(c,n,k)=0
  OD
RETURN

PROC Main()
  Comb(5,3)
RETURN


-- Return the combinations, with replacement, of k items from the
-- list.  We ignore the case where k is greater than the length of
-- the list.
combsWithRep :: Int -> [a] -> [[a]]
combsWithRep 0 _ = [[]]
combsWithRep _ [] = []
combsWithRep k xxs@(x:xs) =
  (x :) <$> combsWithRep (k - 1) xxs ++ combsWithRep k xs

binomial n m = f n `div` f (n - m) `div` f m
  where
    f n =
      if n == 0
        then 1
        else n * f (n - 1)

countCombsWithRep :: Int -> [a] -> Int
countCombsWithRep k lst = binomial (k - 1 + length lst) k

-- countCombsWithRep k = length . combsWithRep k
main :: IO ()
main = do
  print $ combsWithRep 2 ["iced", "jam", "plain"]
  print $ countCombsWithRep 3 [1 .. 10]


# generate all combinations of length n from list L,
# including repetitions
procedure combinations_repetitions (L, n)
  if n = 0
    then suspend [] # if reach 0, then return an empty list
    else if *L > 0
      then {
        # keep the first element
        item := L[1]
        # get all of length n in remaining list
        every suspend (combinations_repetitions (L[2:0], n))
        # get all of length n-1 in remaining list
        # and add kept element to make list of size n
        every i := combinations_repetitions (L, n-1) do
          suspend [item] ||| i
      }
end


with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Combinations is
   generic
      type Integers is range <>;
   package Combinations is
      type Combination is array (Positive range <>) of Integers;
      procedure First (X : in out Combination);
      procedure Next (X : in out Combination);
      procedure Put (X : Combination);
   end Combinations;

   package body Combinations is
      procedure First (X : in out Combination) is
      begin
         X (1) := Integers'First;
         for I in 2..X'Last loop
            X (I) := X (I - 1) + 1;
         end loop;
      end First;
      procedure Next (X : in out Combination) is
      begin
         for I in reverse X'Range loop
            if X (I) < Integers'Val (Integers'Pos (Integers'Last) - X'Last + I) then
               X (I) := X (I) + 1;
               for J in I + 1..X'Last loop
                  X (J) := X (J - 1) + 1;
               end loop;
               return;
            end if;
         end loop;
         raise Constraint_Error;
      end Next;
      procedure Put (X : Combination) is
      begin
         for I in X'Range loop
            Put (Integers'Image (X (I)));
         end loop;
      end Put;
   end Combinations;

   type Five is range 0..4;
   package Fives is new Combinations (Five);
   use Fives;

   X : Combination (1..3);
begin
   First (X);
   loop
      Put (X); New_Line;
      Next (X);
   end loop;
exception
   when Constraint_Error =>
      null;
end Test_Combinations;


100 PROGRAM "Combinat.bas"
110 READ N
120 STRING D$(1 TO N)*5
130 FOR I=1 TO N
140   READ D$(I)
150 NEXT
160 FOR I=1 TO N
170   FOR J=I TO N
180     PRINT D$(I);" ";D$(J)
190   NEXT
200 NEXT
210 DATA 3,iced,jam,plain


import com.objectwave.utility.*;

public class MultiCombinationsTester {

    public MultiCombinationsTester() throws CombinatoricException {
        Object[] objects = {"iced", "jam", "plain"};
        //Object[] objects = {"abba", "baba", "ab"};
        //Object[] objects = {"aaa", "aa", "a"};
        //Object[] objects = {(Integer)1, (Integer)2, (Integer)3, (Integer)4};
        MultiCombinations mc = new MultiCombinations(objects, 2);
        while (mc.hasMoreElements()) {
            for (int i = 0; i < mc.nextElement().length; i++) {
                System.out.print(mc.nextElement()[i].toString() + " ");
            }
            System.out.println();
        }

        // Extra credit:
        System.out.println("----------");
        System.out.println("The ways to choose 3 items from 10 with replacement = " + MultiCombinations.c(10, 3));
    } // constructor

    public static void main(String[] args) throws CombinatoricException {
        new MultiCombinationsTester();
    }
} // class


// colorwheelwidget.cpp
#include "colorwheelwidget.h"
#include <QPainter>
#include <QPaintEvent>
#include <cmath>

namespace {

QColor hsvToRgb(int h, double s, double v) {
    double hp = h/60.0;
    double c = s * v;
    double x = c * (1 - std::abs(std::fmod(hp, 2) - 1));
    double m = v - c;
    double r = 0, g = 0, b = 0;
    if (hp <= 1) {
        r = c;
        g = x;
    } else if (hp <= 2) {
        r = x;
        g = c;
    } else if (hp <= 3) {
        g = c;
        b = x;
    } else if (hp <= 4) {
        g = x;
        b = c;
    } else if (hp <= 5) {
        r = x;
        b = c;
    } else {
        r = c;
        b = x;
    }
    r += m;
    g += m;
    b += m;
    return QColor(r * 255, g * 255, b * 255);
}

}

ColorWheelWidget::ColorWheelWidget(QWidget *parent)
    : QWidget(parent) {
    setWindowTitle(tr("Color Wheel"));
    resize(400, 400);
}

void ColorWheelWidget::paintEvent(QPaintEvent *event) {
    QPainter painter(this);
    painter.setRenderHint(QPainter::Antialiasing);
    const QColor backgroundColor(0, 0, 0);
    const QColor white(255, 255, 255);
    painter.fillRect(event->rect(), backgroundColor);
    const int margin = 10;
    const double diameter = std::min(width(), height()) - 2*margin;
    QPointF center(width()/2.0, height()/2.0);
    QRectF rect(center.x() - diameter/2.0, center.y() - diameter/2.0,
                diameter, diameter);
    for (int angle = 0; angle < 360; ++angle) {
        QColor color(hsvToRgb(angle, 1.0, 1.0));
        QRadialGradient gradient(center, diameter/2.0);
        gradient.setColorAt(0, white);
        gradient.setColorAt(1, color);
        QBrush brush(gradient);
        QPen pen(brush, 1.0);
        painter.setPen(pen);
        painter.setBrush(brush);
        painter.drawPie(rect, angle * 16, 16);
    }
}


# -*- coding: utf-8 -*- #

COMMENT REQUIRED BY "prelude_combinations_generative.a68"
  MODE COMBDATA = ~;
PROVIDES:
# COMBDATA*=~* #
# comb*=~ list* #
END COMMENT

MODE COMBDATALIST = REF[]COMBDATA;
MODE COMBDATALISTYIELD = PROC(COMBDATALIST)VOID;

PROC comb gen combinations = (INT m, COMBDATALIST list, COMBDATALISTYIELD yield)VOID:(
  CASE m IN
  # case 1: transpose list #
    FOR i TO UPB list DO yield(list[i]) OD
  OUT
    [m + LWB list - 1]COMBDATA out;
    INT index out := 1;
    FOR i TO UPB list DO
      COMBDATA first = list[i];
    # FOR COMBDATALIST sub recombination IN # comb gen combinations(m - 1, list[i+1:] #) DO (#,
    ##   (COMBDATALIST sub recombination)VOID:(
        out[LWB list   ] := first;
        out[LWB list+1:] := sub recombination;
        yield(out)
    # OD #))
    OD
  ESAC
);

SKIP


on comb(n, k)
    set c to {}
    repeat with i from 1 to k
        set end of c to i's contents
    end repeat
    set r to {c's contents}
    repeat while my next_comb(c, k, n)
        set end of r to c's contents
    end repeat
    return r
end comb

on next_comb(c, k, n)
    set i to k
    set c's item i to (c's item i) + 1
    repeat while (i > 1 and c's item i ≥ n - k + 1 + i)
        set i to i - 1
        set c's item i to (c's item i) + 1
    end repeat
    if (c's item 1 > n - k + 1) then return false
    repeat with i from i + 1 to k
        set c's item i to (c's item (i - 1)) + 1
    end repeat
    return true
end next_comb

return comb(5, 3)


program Color_wheel;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils,
  Vcl.Graphics,
  System.Math,
  Vcl.Imaging.pngimage;

const
  TAU = 2 * PI;

function HSBtoColor(hue, sat, bri: Double): TColor;
var
  f, h: Double;
  u, p, q, t: Byte;
begin
  u := Trunc(bri * 255 + 0.5);
  if sat = 0 then
    Exit(rgb(u, u, u));

  h := (hue - Floor(hue)) * 6;
  f := h - Floor(h);
  p := Trunc(bri * (1 - sat) * 255 + 0.5);
  q := Trunc(bri * (1 - sat * f) * 255 + 0.5);
  t := Trunc(bri * (1 - sat * (1 - f)) * 255 + 0.5);

  case Trunc(h) of
    0:
      result := rgb(u, t, p);
    1:
      result := rgb(q, u, p);
    2:
      result := rgb(p, u, t);
    3:
      result := rgb(p, q, u);
    4:
      result := rgb(t, p, u);
    5:
      result := rgb(u, p, q);
  else
    result := clwhite;
  end;

end;

function ColorWheel(Width, Height: Integer): TPngImage;
var
  Center: TPoint;
  Radius: Integer;
  x, y: Integer;
  Hue, dy, dx, dist, theta: Double;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.SetSize(Width, Height);
  with Bmp.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(ClipRect);
    Center := ClipRect.CenterPoint;
    Radius := Center.X;
    if Center.Y < Radius then
      Radius := Center.Y;
    for y := 0 to Height - 1 do
    begin
      dy := y - Center.y;
      for x := 0 to Width - 1 do
      begin
        dx := x - Center.x;
        dist := Sqrt(Sqr(dx) + Sqr(dy));
        if dist <= Radius then
        begin
          theta := ArcTan2(dy, dx);
          Hue := (theta + PI) / TAU;
          Pixels[x, y] := HSBtoColor(Hue, 1, 1);
        end;
      end;
    end;
  end;

  Result := TPngImage.Create;
  Result.Assign(Bmp);
  Bmp.Free;
end;

begin
  with ColorWheel(500, 500) do
  begin
    SaveToFile('ColorWheel.png');
    Free;
  end;
end.


MsgBox % Comb(1,1)
MsgBox % Comb(3,3)
MsgBox % Comb(3,2)
MsgBox % Comb(2,3)
MsgBox % Comb(5,3)

Comb(n,t) { ; Generate all n choose t combinations of 1..n, lexicographically
   IfLess n,%t%, Return
   Loop %t%
      c%A_Index% := A_Index
   i := t+1, c%i% := n+1

   Loop {
      Loop %t%
         i := t+1-A_Index, c .= c%i% " "
      c .= "`n"     ; combinations in new lines
      j := 1, i := 2
      Loop
         If (c%j%+1 = c%i%)
             c%j% := j, ++j, ++i
         Else Break
      If (j > t)
         Return c
      c%j% += 1
   }
}


BEGIN {
	## Default values for r and n (Choose 3 from pool of 5).  Can
	## alternatively be set on the command line:-
	## awk -v r=<number of items being chosen> -v n=<how many to choose from> -f <scriptname>
	if (length(r) == 0) r = 3
	if (length(n) == 0) n = 5

	for (i=1; i <= r; i++) { ## First combination of items:
		A[i] = i
		if (i < r ) printf i OFS
		else print i}

	## While 1st item is less than its maximum permitted value...
	while (A[1] < n - r + 1) {
		## loop backwards through all items in the previous
		## combination of items until an item is found that is
		## less than its maximum permitted value:
		for (i = r; i >= 1; i--) {
			## If the equivalently positioned item in the
			## previous combination of items is less than its
			## maximum permitted value...
			if (A[i] < n - r + i) {
				## increment the current item by 1:
				A[i]++
				## Save the current position-index for use
				## outside this "for" loop:
				p = i
				break}}
		## Put consecutive numbers in the remainder of the array,
		## counting up from position-index p.
		for (i = p + 1; i <= r; i++) A[i] = A[i - 1] + 1

		## Print the current combination of items:
		for (i=1; i <= r; i++) {
			if (i < r) printf A[i] OFS
			else print A[i]}}
	exit}


def pick(n):
  def pick(n; m):  # pick n, from m onwards
    if n == 0 then []
    elif m == length then empty
    elif n == 1 then (.[m:][] | [.])
    else ([.[m]] + pick(n-1; m)), pick(n; m+1)
    end;
  pick(n;0) ;


using Combinatorics

l = ["iced", "jam", "plain"]
println("List: ", l, "\nCombinations:")
for c in with_replacement_combinations(l, 2)
    println(c)
end

@show length(with_replacement_combinations(1:10, 3))


#include "fbgfx.bi"

Sub HSVtoRGB(h As Single, s As Integer, v As Integer, Byref r As Integer, Byref g As Integer, Byref b As Integer)
    If s = 0 Then
        r = v
        g = v
        b = v
        Return
    End If

    h = h Mod 360
    Dim As Single hue = h

    Select Case h
    Case 0f To 51.5f
        hue = ((hue         ) * (30f / (51.5f          )))
    Case 51.5f To 122f
        hue = ((hue -  51.5f) * (30f / (122f   -  51.5f))) + 30
    Case 122f To 142.5f
        hue = ((hue -   122f) * (30f / (142.5f -   122f))) + 60
    Case 142.5f To 165.5f
        hue = ((hue - 142.5f) * (30f / (165.5f - 142.5f))) + 90
    Case 165.5f To 192f
        hue = ((hue - 165.5f) * (30f / (192f   - 165.5f))) + 120
    Case 192f To 218.5f
        hue = ((hue -   192f) * (30f / (218.5f -   192f))) + 150
    Case 218.5f To 247f
        hue = ((hue - 218.5f) * (30f / (247f   - 218.5f))) + 180
    Case 247f To 275.5f
        hue = ((hue -   247f) * (30f / (275.5f -   247f))) + 210
    Case 275.5f To 302.5f
        hue = ((hue - 275.5f) * (30f / (302.5f - 275.5f))) + 240
    Case 302.5f To 330f
        hue = ((hue - 302.5f) * (30f / (330f   - 302.5f))) + 270
    Case 330f To 344.5f
        hue = ((hue -   330f) * (30f / (344.5f -   330f))) + 300
    Case 344.5f To 360f
        hue = ((hue - 344.5f) * (30f / (360f   - 344.5f))) + 330
    End Select
    h = hue

    h = h Mod 360

    Dim As Single h1 = h / 60
    Dim As Integer i = Int(h1)
    Dim As Single f = h1 - i
    Dim As Integer p = v * (255 - s) / 256
    Dim As Integer q = v * (255 - f * s) / 256
    Dim As Integer t = v * (255 - (1 - f) * s) / 256

    Select Case As Const i
    Case 0
        r = v
        g = t
        b = p
        Return
    Case 1
        r = q
        g = v
        b = p
        Return
    Case 2
        r = p
        g = v
        b = t
        Return
    Case 3
        r = p
        g = q
        b = v
        Return
    Case 4
        r = t
        g = p
        b = v
        Return
    Case 5
        r = v
        g = p
        b = q
        Return
    End Select
End Sub

Const pi As Single = 4 * Atn(1)
Const radius = 160
Const xres = (radius * 2) + 1, yres = xres

Screenres xres, yres, 32
Windowtitle "Color wheel"

Dim As Integer r,g,b
Dim As Single dx, dy, dist, angle

Do
    Screenlock
    Cls
    For x As Integer = 0 To (radius * 2) - 1
        For y As Integer = 0 To (radius * 2) - 1
            dx = x - radius
            dy = radius - y
            dist = Sqr(dx * dx + dy * dy)
            If dist < radius Then
                angle = Atan2(dy, dx) * (180/pi)
                If angle <   0 Then angle += 360
                If angle > 360 Then angle -= 360
                HSVtoRGB(angle, (dist / radius) * 255, 255, r, g, b)
                Pset(x, y), Rgb(r, g, b)
            End If
        Next y
    Next x

    Screenunlock
Loop Until Inkey = Chr(27)


      INSTALL @lib$+"SORTLIB"
      sort% = FN_sortinit(0,0)

      M% = 3
      N% = 5

      C% = FNfact(N%)/(FNfact(M%)*FNfact(N%-M%))
      DIM s$(C%)
      PROCcomb(M%, N%, s$())

      CALL sort%, s$(0)
      FOR I% = 0 TO C%-1
        PRINT s$(I%)
      NEXT
      END

      DEF PROCcomb(C%, N%, s$())
      LOCAL I%, U%
      FOR U% = 0 TO 2^N%-1
        IF FNbits(U%) = C% THEN
          s$(I%) = FNlist(U%)
          I% += 1
        ENDIF
      NEXT
      ENDPROC

      DEF FNbits(U%)
      LOCAL N%
      WHILE U%
        N% += 1
        U% = U% AND (U%-1)
      ENDWHILE
      = N%

      DEF FNlist(U%)
      LOCAL N%, s$
      WHILE U%
        IF U% AND 1 s$ += STR$(N%) + " "
        N% += 1
        U% = U% >> 1
      ENDWHILE
      = s$

      DEF FNfact(N%)
      IF N%<=1 THEN = 1 ELSE = N%*FNfact(N%-1)


(comb=
  bvar combination combinations list m n pat pvar var
.     !arg:(?m.?n)
    & ( pat
      =   ?
        & !combinations (.!combination):?combinations
        & ~
      )
    & :?list:?combination:?combinations
    &   whl
      ' ( !m+-1:~<0:?m
        & chu$(utf$a+!m):?var
        & glf$('(%@?.$var)):(=?pvar)
        & '(? ()$pvar ()$pat):(=?pat)
        & glf$('(!.$var)):(=?bvar)
        & (   '$combination:(=)
            & '$bvar:(=?combination)
          | '($bvar ()$combination):(=?combination)
          )
        )
    &   whl
      ' (!n+-1:~<0:?n&!n !list:?list)
    & !list:!pat
  | !combinations);


#include <stdio.h>

/* Type marker stick: using bits to indicate what's chosen.  The stick can't
 * handle more than 32 items, but the idea is there; at worst, use array instead */
typedef unsigned long marker;
marker one = 1;

void comb(int pool, int need, marker chosen, int at)
{
	if (pool < need + at) return; /* not enough bits left */

	if (!need) {
		/* got all we needed; print the thing.  if other actions are
		 * desired, we could have passed in a callback function. */
		for (at = 0; at < pool; at++)
			if (chosen & (one << at)) printf("%d ", at);
		printf("\n");
		return;
	}
	/* if we choose the current item, "or" (|) the bit to mark it so. */
	comb(pool, need - 1, chosen | (one << at), at + 1);
	comb(pool, need, chosen, at + 1);  /* or don't choose it, go to next */
}

int main()
{
	comb(5, 3, 0, 0);
	return 0;
}


// version 1.0.6

class CombsWithReps<T>(val m: Int, val n: Int, val items: List<T>, val countOnly: Boolean = false) {
    private val combination = IntArray(m)
    private var count = 0

    init {
        generate(0)
        if (!countOnly) println()
        println("There are $count combinations of $n things taken $m at a time, with repetitions")
    }

    private fun generate(k: Int) {
        if (k >= m) {
            if (!countOnly) {
                for (i in 0 until m) print("${items[combination[i]]}\t")
                println()
            }
            count++
        }
        else {
            for (j in 0 until n)
                if (k == 0 || j >= combination[k - 1]) {
                    combination[k] = j
                    generate(k + 1)
                }
        }
    }
}

fun main(args: Array<String>) {
    val doughnuts = listOf("iced", "jam", "plain")
    CombsWithReps(2, 3, doughnuts)
    println()
    val generic10 = "0123456789".chunked(1)
    CombsWithReps(3, 10, generic10, true)
}


lda #0
tax
tay        ;clear regs

;video ram on Easy6502 is four pages ranging from $0200-$0500

loop:
sta $0200,x
sta $0220,x
sta $0240,x
sta $0260,x
sta $0280,x
sta $02A0,x
sta $02C0,x
sta $02E0,x

sta $0300,x
sta $0320,x
sta $0340,x
sta $0360,x
sta $0380,x
sta $03A0,x
sta $03C0,x
sta $03E0,x

sta $0400,x
sta $0420,x
sta $0440,x
sta $0460,x
sta $0480,x
sta $04A0,x
sta $04C0,x
sta $04E0,x

sta $0500,x
sta $0520,x
sta $0540,x
sta $0560,x
sta $0580,x
sta $05A0,x
sta $05C0,x
sta $05E0,x

inx
txa      ;effectively increment A
cpx #$20 ;32 columns of video memory
beq exit
jmp loop
exit:
brk       ;on easy6502 this terminates a program.


using System;
using System.Collections.Generic;

public class Program
{
    public static IEnumerable<int[]> Combinations(int m, int n)
    {
            int[] result = new int[m];
            Stack<int> stack = new Stack<int>();
            stack.Push(0);

            while (stack.Count > 0)
           {
                int index = stack.Count - 1;
                int value = stack.Pop();

                while (value < n)
               {
                    result[index++] = ++value;
                    stack.Push(value);

                    if (index == m)
                    {
                        yield return result;
                        break;
                    }
                }
            }
    }

    static void Main()
    {
        foreach (int[] c in Combinations(3, 5))
        {
            Console.WriteLine(string.Join(",", c));
            Console.WriteLine();
        }
    }
}


#include <algorithm>
#include <iostream>
#include <string>

void comb(int N, int K)
{
    std::string bitmask(K, 1); // K leading 1's
    bitmask.resize(N, 0); // N-K trailing 0's

    // print integers and permute bitmask
    do {
        for (int i = 0; i < N; ++i) // [0..N-1] integers
        {
            if (bitmask[i]) std::cout << " " << i;
        }
        std::cout << std::endl;
    } while (std::prev_permutation(bitmask.begin(), bitmask.end()));
}

int main()
{
    comb(5, 3);
}


(defun combinations
 (('() _)
    '())
  ((coll 1)
    (lists:map #'list/1 coll))
   (((= (cons head tail) coll) n)
    (++ (lc ((<- subcoll (combinations coll (- n 1))))
            (cons head subcoll))
        (combinations tail n))))


import std

// set S of length n, choose k

def choose(s, k, f):
    let got = map(k): s[0]
    let n = s.length

    def choosi(n_chosen, at):
        var count = 0
        if n_chosen == k:
            f(got)
            return 1
        var i = at
        while i < n:
            got[n_chosen] = s[i]
            count += choosi(n_chosen + 1, i)
            i += 1
        return count
    return choosi(0, 0)

let count = choose(["iced", "jam", "plain"], 2): print(_)
print count
let extra = choose(map(10):_, 3): _
print extra


PROC Main()
  BYTE
    i,
    CH=$02FC, ;Internal hardware value for last key pressed
    PALNTSC=$D014, ;To check if PAL or NTSC system is used
    PCOLR0=$02C0,PCOLR1=$02C1,
    PCOLR2=$02C2,PCOLR3=$02C3,
    COLOR0=$02C4,COLOR1=$02C5,
    COLOR2=$02C6,COLOR3=$02C7,
    COLOR4=$02C8

  Graphics(10)
  PCOLR0=$04 ;gray
  PCOLR1=$00 ;black
  IF PALNTSC=15 THEN
    PCOLR2=$42 ;red for NTSC
    PCOLR3=$C6 ;green for NTSC
    COLOR0=$84 ;blue for NTSC
    COLOR1=$66 ;magenta for NTSC
    COLOR2=$A6 ;cyan for NTSC
    COLOR3=$FC ;yellow for NTSC
  ELSE
    PCOLR2=$22 ;red for PAL
    PCOLR3=$B6 ;green for PAL
    COLOR0=$74 ;blue for PAL
    COLOR1=$48 ;magenta for PAL
    COLOR2=$96 ;cyan for PAL
    COLOR3=$EC ;yellow for PAL
  FI
  COLOR4=$0F ;white

  FOR i=0 TO 79
  DO
    Color=i/10+1
    Plot(i,0)
    DrawTo(i,191)
  OD

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


package {

    import flash.display.Sprite;
    import flash.events.Event;

    public class ColourBars extends Sprite {

        public function ColourBars():void {
            if (stage) init();
            else addEventListener(Event.ADDED_TO_STAGE, init);
        }

        private function init(e:Event = null):void {

            var colours:Array = [ 0x000000, 0xFF0000, 0x00FF00, 0x0000FF, 0xFF00FF, 0x00FFFF, 0xFFFF00, 0xFFFFFF ];
            var w:Number = stage.stageWidth / 8, h:Number = stage.stageHeight;
            var x:Number = 0, i:uint, c:uint;

            for ( i = 0; i < 8; i++ ) {
                c = colours[i];
                graphics.beginFill(c);
                graphics.drawRect(w * i, 0, w, h);
            }

        }

    }

}


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

procedure Colour_Bars_Display is
   use type SDL.Events.Event_Types;
   use SDL.C;

   Colours : constant array (0 .. 7) of SDL.Video.Palettes.Colour :=
     ((0, 0, 0, 255),     (255, 0, 0, 255),
      (0, 255, 0, 255),   (0, 0, 255, 255),
      (255, 0, 255, 255), (0, 255, 255, 255),
      (255, 255, 0, 255), (255, 255, 255, 255));
   Window    : SDL.Video.Windows.Window;
   Renderer  : SDL.Video.Renderers.Renderer;
   Event     : SDL.Events.Events.Events;
   Bar_Width : int;
begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "",
                                    Position => SDL.Natural_Coordinates'(0, 0),
                                    Size     => SDL.Positive_Sizes'(0, 0),
                                    Flags    => SDL.Video.Windows.Full_Screen_Desktop);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);

   Bar_Width := Window.Get_Size.Width / 8;
   for A in Colours'Range loop
      Renderer.Set_Draw_Colour (Colour => Colours (A));
      Renderer.Fill (Rectangle => (X => SDL.C.int (A) * Bar_Width, Y => 0,
                                   Width  => Bar_Width,
                                   Height => Window.Get_Size.Height));
   end loop;
   Window.Update_Surface;

   Wait_Loop : loop
      while SDL.Events.Events.Poll (Event) loop
         exit Wait_Loop when Event.Common.Event_Type = SDL.Events.Keyboards.Key_Down;
      end loop;
      delay 0.050;
   end loop Wait_Loop;
   Window.Finalize;
   SDL.Finalise;
end Colour_Bars_Display;


for (var i = 1; i <= 360; i++) {
    for (var j = 0; j < 255; j++) {

        var hue = 255*(i/360);
        var saturation = j;
        var value = 255;

        var c = make_colour_hsv(hue,saturation,value);

        //size of circle determined by how far from the center it is
        //if you just draw them too small the circle won't be full.
        //it will have patches inside it that didn't get filled in with color
        var r = max(1,3*(j/255));

        //Math for built-in GMS functions
        //lengthdir_x(len,dir) = +cos(degtorad(direction))*length;
        //lengthdir_y(len,dir) = -sin(degtorad(direction))*length;
        draw_circle_colour(x+lengthdir_x(m_radius*(j/255),i),y+lengthdir_y(m_radius*(j/255),i),r,c,c,false);
    }
}


package main

import (
    "github.com/fogleman/gg"
    "math"
)

const tau = 2 * math.Pi

func hsb2rgb(hue, sat, bri float64) (r, g, b int) {
    u := int(bri*255 + 0.5)
    if sat == 0 {
        r, g, b = u, u, u
    } else {
        h := (hue - math.Floor(hue)) * 6
        f := h - math.Floor(h)
        p := int(bri*(1-sat)*255 + 0.5)
        q := int(bri*(1-sat*f)*255 + 0.5)
        t := int(bri*(1-sat*(1-f))*255 + 0.5)
        switch int(h) {
        case 0:
            r, g, b = u, t, p
        case 1:
            r, g, b = q, u, p
        case 2:
            r, g, b = p, u, t
        case 3:
            r, g, b = p, q, u
        case 4:
            r, g, b = t, p, u
        case 5:
            r, g, b = u, p, q
        }
    }
    return
}

func colorWheel(dc *gg.Context) {
    width, height := dc.Width(), dc.Height()
    centerX, centerY := width/2, height/2
    radius := centerX
    if centerY < radius {
        radius = centerY
    }
    for y := 0; y < height; y++ {
        dy := float64(y - centerY)
        for x := 0; x < width; x++ {
            dx := float64(x - centerX)
            dist := math.Sqrt(dx*dx + dy*dy)
            if dist <= float64(radius) {
                theta := math.Atan2(dy, dx)
                hue := (theta + math.Pi) / tau
                r, g, b := hsb2rgb(hue, 1, 1)
                dc.SetRGB255(r, g, b)
                dc.SetPixel(x, y)
            }
        }
    }
}

func main() {
    const width, height = 480, 480
    dc := gg.NewContext(width, height)
    dc.SetRGB(1, 1, 1) // set background color to white
    dc.Clear()
    colorWheel(dc)
    dc.SavePNG("color_wheel.png")
}


(defn combinations
  "If m=1, generate a nested list of numbers [0,n)
   If m>1, for each x in [0,n), and for each list in the recursion on [x+1,n), cons the two"
  [m n]
  (letfn [(comb-aux
	   [m start]
	   (if (= 1 m)
	     (for [x (range start n)]
	       (list x))
	     (for [x (range start n)
		   xs (comb-aux (dec m) (inc x))]
	       (cons x xs))))]
    (comb-aux m 0)))

(defn print-combinations
  [m n]
  (doseq [line (combinations m n)]
    (doseq [n line]
      (printf "%s " n))
    (printf "%n")))


% generate the size-M combinations from 0 to n-1
combinations = iter (m, n: int) yields (sequence[int])
    if m<=n then
        state: array[int] := array[int]$predict(1, m)
        for i: int in int$from_to(0, m-1) do
            array[int]$addh(state, i)
        end

        i: int := m
        while i>0 do
            yield (sequence[int]$a2s(state))
            i := m
            while i>0 do
                state[i] := state[i] + 1
                for j: int in int$from_to(i,m-1) do
                    state[j+1] := state[j] + 1
                end
                if state[i] < n-(m-i) then break end
                i := i - 1
            end
        end
    end
end combinations

% print a combination
print_comb = proc (s: stream, comb: sequence[int])
    for i: int in sequence[int]$elements(comb) do
        stream$puts(s, int$unparse(i) || " ")
    end
end print_comb

start_up = proc ()
    po: stream := stream$primary_output()
    for comb: sequence[int] in combinations(3, 5) do
        print_comb(po, comb)
        stream$putl(po, "")
    end
end start_up


function GenerateCombinations(tList, nMaxElements, tOutput, nStartIndex, nChosen, tCurrentCombination)
	if not nStartIndex then
		nStartIndex = 1
	end
	if not nChosen then
		nChosen = 0
	end
	if not tOutput then
		tOutput = {}
	end
	if not tCurrentCombination then
		tCurrentCombination = {}
	end

	if nChosen == nMaxElements then
		-- Must copy the table to avoid all elements referring to a single reference
		local tCombination = {}
		for k,v in pairs(tCurrentCombination) do
			tCombination[k] = v
		end

		table.insert(tOutput, tCombination)
		return
	end

 	local nIndex = 1
	for k,v in pairs(tList) do
		if nIndex >= nStartIndex then
			tCurrentCombination[nChosen + 1] = tList[nIndex]
			GenerateCombinations(tList, nMaxElements, tOutput, nIndex, nChosen + 1, tCurrentCombination)
		end

		nIndex = nIndex + 1
	end

	return tOutput
end

tDonuts = {"iced", "jam", "plain"}
tCombinations = GenerateCombinations(tDonuts, #tDonuts)
for nCombination,tCombination in ipairs(tCombinations) do
	print("Combination " .. tostring(nCombination))
	for nIndex,strFlavor in ipairs(tCombination) do
		print("+" .. strFlavor)
	end
end


with(combinat):
chooserep:=(s,k)->choose([seq(op(s),i=1..k)],k):
chooserep({iced,jam,plain},2);
# [[iced, iced], [iced, jam], [iced, plain], [jam, jam], [jam, plain], [plain, plain]]
numbchooserep:=(s,k)->binomial(nops(s)+k-1,k);
numbchooserep({iced,jam,plain},2);
# 6


#SingleInstance, Force
#NoEnv
SetBatchLines, -1

; Uncomment if Gdip.ahk is not in your standard library
;#Include, Gdip.ahk

; Start gdi+
If !pToken := Gdip_Startup()
{
   message =
   ( LTrim
      gdiplus error!, Gdiplus failed to start.
      Please ensure you have gdiplus on your system.
   )
   MsgBox, 48, %message%
   ExitApp
}
OnExit, Exit

; Set the width and height we want as our drawing area, to draw everything in.
; This will be the dimensions of our bitmap
Width := A_ScreenWidth, Height := A_ScreenHeight

; Create a layered window
; (+E0x80000 : must be used for UpdateLayeredWindow to work!)
; that is always on top (+AlwaysOnTop), has no taskbar entry or caption
Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop

; Show the window
Gui, 1: Show, NA

; Get a handle to this window we have created in order to update it later
hwnd1 := WinExist()

; Create a gdi bitmap with width and height of what we are going to
; draw into it. This is the entire drawing area for everything
hbm := CreateDIBSection(Width, Height)

; Get a device context compatible with the screen
hdc := CreateCompatibleDC()

; Select the bitmap into the device context
obm := SelectObject(hdc, hbm)

; Get a pointer to the graphics of the bitmap, for use with drawing functions
G := Gdip_GraphicsFromHDC(hdc)

; ARGB = Transparency, Red, Green, Blue
Colors := "0xFF000000,0xFFFF0000,0xFF00FF00,0xFF0000FF"
Colors .= ",0xFFFF00FF,0xFF00FFFF,0xFFFFFF00,0xFFFFFFFF"
; This list ^ is Black, Red, Green, Blue, Magenta, Cyan, Yellow, White
StringSplit Colors, Colors, `,
w := Width // Colors0
Loop % Colors0
{
   ; Create a brush to draw a rectangle
   pBrush := Gdip_BrushCreateSolid(Colors%A_Index%)

   ; Fill the graphics of the bitmap with a rectangle using the brush created
   Gdip_FillRectangle(G, pBrush, w*(A_Index-1), 0, w, height)

   ; Delete the brush as it is no longer needed and wastes memory
   Gdip_DeleteBrush(pBrush)
}
; Update the specified window we have created (hwnd1) with a handle to our
; bitmap (hdc), specifying the x,y,w,h we want it positioned on our screen
; So this will position our gui at (0,0) with the Width and
; Height specified earlier
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)

; Select the object back into the hdc
SelectObject(hdc, obm)

; Now the bitmap may be deleted
DeleteObject(hbm)

; Also the device context related to the bitmap may be deleted
DeleteDC(hdc)

; The graphics may now be deleted
Gdip_DeleteGraphics(G)
Return

;#######################################################################

GuiEscape:
Exit:
; gdi+ may now be shutdown on exiting the program
Gdip_Shutdown(pToken)
ExitApp
Return


BEGIN {
  nrcolors = 8

  for (height=0; height<20; height++) {
    for (width=0; width<nrcolors; width++) {
      # print (ANSI) basic color and amount of spaces
      printf("\033[%dm%*s", width + 40, 64 / nrcolors, " ")
    }

    # reset color and print newline
    printf("\033[0m\n")
  }
}


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

public class ColorWheel {
    public static void main(String[] args) {
        SwingUtilities.invokeLater(new Runnable() {
            public void run() {
                ColorWheelFrame frame = new ColorWheelFrame();
                frame.setVisible(true);
            }
        });
    }

    private static class ColorWheelFrame extends JFrame {
        private ColorWheelFrame() {
            super("Color Wheel");
            setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            getContentPane().add(new ColorWheelPanel());
            pack();
        }
    }

    private static class ColorWheelPanel extends JComponent {
        private ColorWheelPanel() {
            setPreferredSize(new Dimension(400, 400));
        }
        public void paint(Graphics g) {
            Graphics2D g2 = (Graphics2D)g;
            int w = getWidth();
            int h = getHeight();
            int margin = 10;
            int radius = (Math.min(w, h) - 2 * margin)/2;
            int cx = w/2;
            int cy = h/2;
            float[] dist = {0.F, 1.0F};
            g2.setColor(Color.BLACK);
            g2.fillRect(0, 0, w, h);
            for (int angle = 0; angle < 360; ++angle) {
                Color color = hsvToRgb(angle, 1.0, 1.0);
                Color[] colors = {Color.WHITE, color};
                RadialGradientPaint paint = new RadialGradientPaint(cx, cy,
                        radius, dist, colors);
                g2.setPaint(paint);
                g2.fillArc(cx - radius, cy - radius, radius*2, radius*2,
                        angle, 1);
            }
        }
    }

    private static Color hsvToRgb(int h, double s, double v) {
        double hp = h/60.0;
        double c = s * v;
        double x = c * (1 - Math.abs(hp % 2.0 - 1));
        double m = v - c;
        double r = 0, g = 0, b = 0;
        if (hp <= 1) {
            r = c;
            g = x;
        } else if (hp <= 2) {
            r = x;
            g = c;
        } else if (hp <= 3) {
            g = c;
            b = x;
        } else if (hp <= 4) {
            g = x;
            b = c;
        } else if (hp <= 5) {
            r = x;
            b = c;
        } else {
            r = c;
            b = x;
        }
        r += m;
        g += m;
        b += m;
        return new Color((int)(r * 255), (int)(g * 255), (int)(b * 255));
    }
}


combinations = (n, p) ->
  return [ [] ] if p == 0
  i = 0
  combos = []
  combo = []
  while combo.length < p
    if i < n
      combo.push i
      i += 1
    else
      break if combo.length == 0
      i = combo.pop() + 1

    if combo.length == p
      combos.push clone combo
      i = combo.pop() + 1
  combos

clone = (arr) -> (n for n in arr)

N = 5
for i in [0..N]
  console.log "------ #{N} #{i}"
  for combo in combinations N, i
    console.log combo


(defun map-combinations (m n fn)
  "Call fn with each m combination of the integers from 0 to n-1 as a list. The list may be destroyed after fn returns."
  (let ((combination (make-list m)))
    (labels ((up-from (low)
               (let ((start (1- low)))
                 (lambda () (incf start))))
             (mc (curr left needed comb-tail)
               (cond
                ((zerop needed)
                 (funcall fn combination))
                ((= left needed)
                 (map-into comb-tail (up-from curr))
                 (funcall fn combination))
                (t
                 (setf (first comb-tail) curr)
                 (mc (1+ curr) (1- left) (1- needed) (rest comb-tail))
                 (mc (1+ curr) (1- left) needed comb-tail)))))
      (mc 0 n m combination))))


DeleteDuplicates[Tuples[{"iced", "jam", "plain"}, 2],Sort[#1] == Sort[#2] &]
->{{"iced", "iced"}, {"iced", "jam"}, {"iced", "plain"}, {"jam", "jam"}, {"jam", "plain"}, {"plain", "plain"}}

Combi[x_, y_] := Binomial[(x + y) - 1, y]
Combi[3, 2]
-> 6
Combi[10, 3]
->220


:- module comb.
:- interface.
:- import_module list, int, bag.

:- pred choose(list(T)::in, int::in, bag(T)::out) is nondet.
:- pred choose_all(list(T)::in, int::in, list(list(T))::out) is det.
:- pred count_choices(list(T)::in, int::in, int::out) is det.

:- implementation.
:- import_module solutions.

choose(L, N, R) :- choose(L, N, bag.init, R).

:- pred choose(list(T)::in, int::in, bag(T)::in, bag(T)::out) is nondet.
choose(L, N, !R) :-
        ( N = 0 ->
                true
        ;
                member(X, L),
                bag.insert(!.R, X, !:R),
                choose(L, N - 1, !R)
        ).

choose_all(L, N, R) :-
        solutions(choose(L, N), R0),
        list.map(bag.to_list, R0, R).

count_choices(L, N, Count) :-
        aggregate(choose(L, N), count, 0, Count).

:- pred count(T::in, int::in, int::out) is det.
count(_, N0, N) :- N0 + 1 = N.


import sugar, sequtils

proc combsReps[T](lst: seq[T], k: int): seq[seq[T]] =
  if k == 0:
    @[newSeq[T]()]
  elif lst.len == 0:
    @[]
  else:
    lst.combsReps(k - 1).map((x: seq[T]) => lst[0] & x) &
      lst[1 .. ^1].combsReps(k)

echo(@["iced", "jam", "plain"].combsReps(2))
echo toSeq(1..10).combsReps(3).len


#include<conio.h>

#define COLOURS 8

int main()
{
	int colour=0,i,j,MAXROW,MAXCOL;
	struct text_info tInfo;
	gettextinfo(&tInfo);
	MAXROW = tInfo.screenheight;
	MAXCOL = tInfo.screenwidth;
	textbackground(BLACK);     //8 colour constants are defined
	clrscr();

	for(colour=0;colour<COLOURS;colour++)
	{
		getch();                              //waits for a key hit
		gotoxy(1+colour*MAXCOL/COLOURS,1);
		textbackground(colour);
		for(j=0;j<MAXROW;j++){
			for(i=0;i<MAXCOL/COLOURS;i++){
				cprintf(" ");
			}
		gotoxy(1+colour*MAXCOL/COLOURS,1+j);
		}
	}

	getch();
	textbackground(BLACK);

	return 0;
}


#ifndef MYWIDGET_H
#define MYWIDGET_H
#include <QWidget>

class QPaintEvent ;

class MyWidget : public QWidget {
public :
   MyWidget( ) ;

protected :
   void paintEvent( QPaintEvent * ) ;
private :
   int width ;
   int height ;
   const int colornumber ;
} ;
#endif


using Gtk, Graphics, Colors

const win = GtkWindow("Color Wheel", 450, 450) |> (const can = @GtkCanvas())
set_gtk_property!(can, :expand, true)

@guarded draw(can) do widget
    ctx = getgc(can)
    h = height(can)
    w = width(can)
    center = (x = w / 2, y = h / 2)
    anglestep = 1/w
    for θ in 0:0.1:360
        rgb = RGB(HSV(θ, 1, 1))
        set_source_rgb(ctx, rgb.r, rgb.g, rgb.b)
        line_to(ctx, center...)
        arc(ctx, center.x, center.y, w/2.2, 2π * θ / 360, anglestep)
        line_to(ctx, center...)
        stroke(ctx)
    end
end

show(can)
const condition = Condition()
endit(w) = notify(condition)
signal_connect(endit, win, :destroy)
wait(condition)


// Version 1.2.41

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import java.io.File
import javax.imageio.ImageIO
import kotlin.math.*

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))

    fun colorWheel() {
        val centerX = image.width / 2
        val centerY = image.height / 2
        val radius = minOf(centerX, centerY)
        for (y in 0 until image.height) {
            val dy = (y - centerY).toDouble()
            for (x in 0 until image.width) {
                val dx = (x - centerX).toDouble()
                val dist = sqrt(dx * dx + dy * dy)
                if (dist <= radius) {
                    val theta = atan2(dy, dx)
                    val hue = (theta + PI) / (2.0 * PI)
                    val rgb = Color.HSBtoRGB(hue.toFloat(), 1.0f, 1.0f)
                    setPixel(x, y, Color(rgb))
                }
            }
        }
    }
}

fun main(args: Array<String>) {
    val bbs = BasicBitmapStorage(480, 480)
    with (bbs) {
        fill(Color.white)
        colorWheel()
        val cwFile = File("Color_wheel.png")
        ImageIO.write(image, "png", cwFile)
    }
}


local function hsv_to_rgb (h, s, v)  -- values in ranges: [0, 360], [0, 1], [0, 1]
	local r = math.min (math.max (3*math.abs (((h	    )/180)%2-1)-1, 0), 1)
	local g = math.min (math.max (3*math.abs (((h	-120)/180)%2-1)-1, 0), 1)
	local b = math.min (math.max (3*math.abs (((h	+120)/180)%2-1)-1, 0), 1)
	local k1 = v*(1-s)
	local k2 = v - k1
	return k1+k2*r, k1+k2*g, k1+k2*b -- values in ranges: [0, 1], [0, 1], [0, 1]
end

function love.load()
	local w, h, r = 256, 256, 128-0.5
	local cx, cy = w/2, h/2
	canvas = love.graphics.newCanvas ()
	love.graphics.setCanvas(canvas)
		for x = 0, w do
			for y = 0, h do
				local dx, dy = x-cx, y-cy
				if dx*dx + dy*dy <= r*r then
					local h = math.deg(math.atan2(dy, dx))
					local s = (dx*dx + dy*dy)^0.5/r
					local v = 1
					love.graphics.setColor (hsv_to_rgb (h, s, v))
					love.graphics.points (x, y)
				end
			end
		end
	love.graphics.setCanvas()
end

function love.draw()
	love.graphics.setColor (1,1,1)
	love.graphics.draw (canvas)
end


def comb(m, n)
    (0...n).to_a.each_combination(m) { |p| puts(p) }
end


T[][] comb(T)(in T[] arr, in int k) pure nothrow {
    if (k == 0) return [[]];
    typeof(return) result;
    foreach (immutable i, immutable x; arr)
        foreach (suffix; arr[i + 1 .. $].comb(k - 1))
            result ~= x ~ suffix;
    return result;
}

void main() {
    import std.stdio;
    [0, 1, 2, 3].comb(2).writeln;
}


let rec combs_with_rep k xxs =
  match k, xxs with
  | 0,  _ -> [[]]
  | _, [] -> []
  | k, x::xs ->
      List.map (fun ys -> x::ys) (combs_with_rep (k-1) xxs)
      @ combs_with_rep k xs


ways(k,v,s=[])={
	if(k==0,return([]));
	if(k==1,return(vector(#v,i,concat(s,[v[i]]))));
	if(#v==1,return(ways(k-1,v,concat(s,v))));
	my(u=vecextract(v,2^#v-2));
	concat(ways(k-1,v,concat(s,[v[1]])),ways(k,u,s))
};
xc(k,v)=binomial(#v+k-1,k);
ways(2, ["iced","jam","plain"])


       IDENTIFICATION DIVISION.
       PROGRAM-ID. terminal-colour-bars.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  width           PIC 9(3).
       01  height          PIC 9(3).

       01  interval        PIC 9(3).

       01  colours-area.
           03  colour-values.
               05  FILLER  PIC 9 VALUE 0. *> Black
               05  FILLER  PIC 9 VALUE 4. *> Red
               05  FILLER  PIC 9 VALUE 2. *> Green
               05  FILLER  PIC 9 VALUE 1. *> Blue
               05  FILLER  PIC 9 VALUE 5. *> Magneta
               05  FILLER  PIC 9 VALUE 3. *> Cyan
               05  FILLER  PIC 9 VALUE 6. *> Yellow
               05  FILLER  PIC 9 VALUE 7. *> White

           03  colour-table REDEFINES colour-values.
               05  colours PIC 9 OCCURS 8 TIMES INDEXED BY colour-index.

       01  i               PIC 9(3).
       01  j               PIC 9(3).

       PROCEDURE DIVISION.
           ACCEPT width FROM COLUMNS
           ACCEPT height FROM LINES
           DIVIDE width BY 8 GIVING interval

           PERFORM VARYING i FROM 1 BY 1 UNTIL height < i
               PERFORM VARYING j FROM 1 BY 1 UNTIL width < j
                  COMPUTE colour-index = (j / interval) + 1

                  IF 8 < colour-index
                      SET colour-index TO 8
                  END-IF

                  *> Some colours come a bit darker than they
                  *> should, with the yellow being orange and the white
                  *> being light-grey.
                  DISPLAY SPACE AT LINE i COLUMN j
                      WITH BACKGROUND-COLOR colours (colour-index)
               END-PERFORM
           END-PERFORM

           ACCEPT i *> Prevent ncurses returning to console immediately.

           GOBACK
           .


(defun color-bars ()
  (with-screen (scr :input-blocking t :input-echoing nil :cursor-visible nil)
    (dotimes (i (height scr))
      (move scr i 0)
      (dolist (color '(:red :green :yellow :blue :magenta :cyan :white :black))
        (add-char scr #\space :bgcolor color :n (floor (/ (width scr) 8)))))
    (refresh scr)
    ;; wait for keypress
    (get-char scr)))


Module Check {
      \\ we use an internal object for Math functions (here for Atan2)
      Declare Math Math
      Const tau=2*Pi, Center=2
      \\ change console size,  and center it ( using ;) to current monitor
      Window 12, 800*twipsX,600*twipsY;
      \\ actual size maybe less (so can fit text exactly)
      Double  ' Double height characters
      Report Center, "Color wheel"
      Normal  ' restore to normal
      Atan2=Lambda Math (a, b) ->{
            Method Math, "Atan2", a, b As ret
            =ret
      }
      \\ brightness=1 for this program
      hsb2rgb=Lambda (hue, sat) ->{
            If sat == 0 Then {
                = 255, 255, 255
           } Else {
                  h=frac(hue+1)*6
                  f = frac(h)
                  p = Int((1-sat)*255 + 0.5)
                  q = Int((1-sat*f)*255 + 0.5)
                  t = Int((1-sat*(1-f))*255 + 0.5)
                  Select Case Int(h)
                  Case 1
                      = q, 255, p
                  Case 2
                      = p, 255, t
                  Case 3
                     = p, q, 255
                  Case 4
                      = t, p, 255
                  Case 5
                      = 255, p, q
                  Else Case
                      = 255, t, p
                  End Select
          }
      }
      Let OffsetX=X.twips/2-128*TwipsX, OffsetY=Y.twips/2-128*TwipsY
      \\ a pixel has a size of TwipsX x TwipsY
      OffsetX=(OffsetX div TwipsX)*TwipsX
      OffsetY=(OffsetY div TwipsY)*TwipsY
      \\ We set hsb2rgb, OffsetX, OffsetY as closures to PrintPixel
      \\ We send to stack the R G B values using Stack ! array
      \\ hsb2rgb() return an array of values
      \\ we pop these values using Number
      PrintPixel = Lambda  hsb2rgb, OffsetX, OffsetY (x,y, theta, sat)  -> {
            Stack ! hsb2rgb(theta,sat)
            PSet Color(number, number, number), x*TwipsX+offsetX, y*TwipsY+offsetY
      }
      \\ set Atan2, tau as closures to HueCircle
      \\ we can rotate/flip the wheel by changing signs in Atan2() and
      \\ by changing order of arguments (dx,dy) or (dy,dx). 8 combinations
      HueCircle= Lambda Atan2, tau (PrintPixel) -> {
            Let  c_width=256, c_height=256
            Let  cx=c_width/2, cy=c_height/2
            Let  radius=If(cx<=cy->cx, cy)
            c_width--
            c_height--
            dy=-cy
            For y=0 To c_height {
                  dy++ : dy2=dy*dy : dx=-cx
                  For x=0 To c_width {
                        dx++ : dist=Sqrt(dx^2+dy2)
                        If dist>radius Then continue
                        Call PrintPixel(x,y, Atan2(dx, -dy)/tau, dist/radius)
                  }
            }
      }
      Call HueCircle(PrintPixel)
      Scr$=""  ' we use this string  to load an image
      Move 0,0
      \\ scale.x, scale.y are twips height and width, of current layer
      Copy scale.x, scale.y to Scr$
      Clipboard Scr$  ' save window to clipboard
}
Check


r = 100;
Image[Table[
  If[x^2 + y^2 <= r^2,
   angle = Mod[ArcTan[[email protected], y]/(2 Pi), 1];
   List @@ RGBColor[Hue[angle, Sqrt[x^2 + y^2]/N[r], 1.0]]
   ,
   {1, 1, 1}
   ], {x, -r, r}, {y, -r, r}]
 ]


import math

import imageman

#---------------------------------------------------------------------------------------------------

func hsvToRgb(h, s, v: float): ColorRGBU =
  ## Convert HSV values to RGB values.

  let hp = h / 60
  let c = s * v
  let x = c * (1 - abs(hp mod 2 - 1))
  let m = v - c
  var r, g, b = 0.0
  if hp <= 1:
    r = c
    g = x
  elif hp <= 2:
    r = x
    g = c
  elif hp <= 3:
    g = c
    b = x
  elif hp <= 4:
    g = x
    b= c
  elif hp <= 5:
    r = x
    b = c
  else:
    r = c
    b = x
  r += m
  g += m
  b += m
  result = ColorRGBU [byte(r * 255), byte(g * 255), byte(b * 255)]

#---------------------------------------------------------------------------------------------------

func buildColorWheel(image: var Image) =
  ## Build a color wheel into the image.

  const Margin = 10
  let diameter = min(image.w, image.h) - 2 * Margin
  let xOffset = (image.w - diameter) div 2
  let yOffset = (image.h - diameter) div 2
  let radius = diameter / 2

  for x in 0..diameter:
    let rx = x.toFloat - radius
    for y in 0..diameter:
      let ry = y.toFloat - radius
      let r = hypot(rx, ry) / radius
      if r > 1: continue
      let a = 180 + arctan2(ry, -rx).radToDeg()
      image[x + xOffset, y + yOffset] = hsvToRgb(a, r, 1)

#———————————————————————————————————————————————————————————————————————————————————————————————————

const
  Side = 400
  Output = "color_wheel.png"

var image = initImage[ColorRGBU](Side, Side)
image.buildColorWheel()

image.savePNG(Output, compression = 9)


use Imager;
use Math::Complex qw(cplx i pi);

my ($width, $height) = (300, 300);
my $center = cplx($width/2, $height/2);

my $img = Imager->new(xsize => $width,
                      ysize => $height);

foreach my $y (0 .. $height - 1) {
    foreach my $x (0 .. $width - 1) {

        my $vec = $center - $x - $y * i;
        my $mag = 2 * abs($vec) / $width;
        my $dir = (pi + atan2($vec->Re, $vec->Im)) / (2 * pi);

        $img->setpixel(x => $x, y => $y,
            color => {hsv => [360 * $dir, $mag, $mag < 1 ? 1 : 0]});
    }
}

$img->write(file => 'color_wheel.png');


def combinations(m, range) {
  return if (m <=> 0) { [[]] } else {
    def combGenerator {
      to iterate(f) {
        for i in range {
          for suffix in combinations(m.previous(), range & (int > i)) {
            f(null, [i] + suffix)
          }
        }
      }
    }
  }
}


program CombWithRep;
//combinations with repetitions
//Limit = count of elements
//Maxval = value of top , lowest is always 0
//so 0..Maxvalue => maxValue+1 elements
{$IFDEF FPC}
//  {$R+,O+}
  {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$COPERATORS ON}
{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
  SysUtils;//GetTickCount64

var
  CombIdx: array of byte;

  function InitCombIdx(ElemCount: Int32): pbyte;
  begin
    setlength(CombIdx, ElemCount + 1);
    Fillchar(CombIdx[0], sizeOf(CombIdx[0]) * (ElemCount + 1), #0);
    Result := @CombIdx[0];
  end;

  function NextCombWithRep(pComb: pByte; MaxVal, ElemCount: UInt32): boolean;
  var
    i, dgt: NativeInt;
  begin
    i := -1;
    repeat
      i += 1;
      dgt := pComb[i];
      if dgt < MaxVal then
        break;
    until i > ElemCount;
    Result := i >= ElemCount;
    dgt +=1;
    repeat
      pComb[i] := dgt;
      i -= 1;
    until i < 0;
  end;

  procedure GetDoughnuts(ElemCount: NativeInt);
  const
    doughnuts: array[0..2] of string = ('iced', 'jam', 'plain');
  var
    pComb: pByte;
    MaxVal, i: Uint32;
  begin
    if ElemCount < 1 then
      EXIT;
    MaxVal := High(doughnuts);
    writeln('Getting ', ElemCount, ' elements of ', MaxVal + 1, ' different');
    pComb := InitCombIdx(ElemCount);
    repeat
      Write('[');
      for i := 0 to ElemCount - 2 do
        Write(pComb[i], ',');
      Write(pComb[ElemCount - 1], ']');
      Write('{');
      for i := 0 to ElemCount - 2 do
        Write(doughnuts[pComb[i]], ',');
      Write(doughnuts[pComb[ElemCount - 1]], '}');
    until NextCombWithRep(pComb, MaxVal, ElemCount);
    writeln(#10);
  end;

  procedure Check(ElemCount: Int32; ElemRange: Uint32);
  var
    pComb: pByte;
    T0: int64;
    rec_cnt: NativeInt;
  begin
    T0 := GetTickCount64;
    rec_cnt := 0;
    ElemRange -= 1;
    pComb := InitCombIdx(ElemCount);
    repeat
      Inc(rec_cnt);
    until NextCombWithRep(pComb, ElemRange, ElemCount);
    T0 := GetTickCount64 - T0;
    writeln('Getting ', ElemCount, ' elements of ', ElemRange + 1, ' different');
    writeln(rec_cnt: 10, t0: 10,' ms');
  end;

begin
  GetDoughnuts(2);
  GetDoughnuts(3);
  Check(3, 10);
  Check(9, 10);
  Check(15, 16);
  {$IFDEF WINDOWS}
  readln;
  {$ENDIF}
end.


unit Colour_barsDisplay;

interface

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

type
  TfmColourBar = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmColourBar: TfmColourBar;
  Colors: array of TColor = [clblack, clred, clgreen, clblue, clFuchsia, clAqua,
    clyellow, clwhite];

implementation

{$R *.dfm}

procedure TfmColourBar.FormPaint(Sender: TObject);
var
  w, h, i: Integer;
  r: TRect;
begin
  w := ClientWidth div length(Colors);
  h := ClientHeight;
  r := Rect(0, 0, w, h);

  with Canvas do
    for i := 0 to High(Colors) do
    begin
      Brush.Color := Colors[i];
      FillRect(r);
      r.Offset(w, 0);
    end;
end;

procedure TfmColourBar.FormResize(Sender: TObject);
begin
 Invalidate;
end;
end.


col[] = [ 000 900 090 909 099 990 999 ]
w = 100.0 / len col[]
for i range len col[]
  color col[i]
  move w * i 0
  rect w 100
.


USING: accessors colors.constants kernel math sequences ui
ui.gadgets ui.gadgets.tracks ui.pens.solid ;
IN: rosetta-code.colour-bars-display

: colors ( -- ) [
horizontal <track>
{
 COLOR: black
 COLOR: red
 COLOR: green
 COLOR: blue
 COLOR: magenta
 COLOR: cyan
 COLOR: yellow
 COLOR: white
}
[ <solid> gadget new swap >>interior ] map
dup length recip
[ track-add ] curry each
{ 640 480 } >>pref-dim
"bars" open-window
] with-ui ;
MAIN: colors


\ Color Bars for TI-99 CAMEL99 Forth

NEEDS HCHAR   FROM DSK1.GRAFIX    \ TMS9918 control lexicon
NEEDS CHARSET FROM DSK1.CHARSET   \ restores default character data
NEEDS ENUM    FROM DSK1.ENUM      \ add simple enumerator to Forth

\ Name TI-99 colors
1 ENUM CLR     ENUM BLK    ENUM MGRN   ENUM LGRN
  ENUM BLU     ENUM LBLU   ENUM RED    ENUM CYAN
  ENUM MRED    ENUM LRED   ENUM YEL    ENUM LYEL
  ENUM GRN     ENUM MAG    ENUM GRY    ENUM WHT
DROP

\ square character data
HEX
CREATE SQUARE  FFFF , FFFF , FFFF , FFFF ,

DECIMAL
: COLOR-BARS ( -- )
   24 0 DO
\   col row char wid
\   --- --- ---- ---
      2  I   88   4 HCHAR
      6  I   96   4 HCHAR
     10  I  104   4 HCHAR
     14  I  112   4 HCHAR
     18  I  120   4 HCHAR
     22  I  128   4 HCHAR
     26  I  136   4 HCHAR
   LOOP ;

DECIMAL
: DEFCHARS ( pattern first last -- )
        1+ SWAP ?DO   DUP I CHARDEF  8 +LOOP DROP ;

: SET-COLORS ( -- )
\   charset  fg   bg
\   -------  --   --
    88 SET#  GRY  CLR COLOR
    96 SET#  YEL  CLR COLOR
   104 SET#  CYAN CLR COLOR
   112 SET#  GRN  CLR COLOR
   120 SET#  MAG  CLR COLOR
   128 SET#  RED  CLR COLOR
   136 SET#  BLU  CLR COLOR
   144 SET#  BLK  CLR COLOR ;

\ restore characters and colors
: DEFAULTS
   8 SCREEN
   4 19 BLK CLR COLORS
   CLEAR
   CHARSET ;

: BARS
   CLEAR  BLK SCREEN
   SET-COLORS
   SQUARE 88 152 DEFCHARS
   COLOR-BARS
   BEGIN ?TERMINAL  UNTIL
   DEFAULTS
;

CR .( Done. Type BARS to run)


--
-- demo\rosetta\Colour_wheel.exw
-- =============================
--
--  Note: Made non-resizeable since maximising this is far too slow.
--
with javascript_semantics
include pGUI.e

constant title = "Colour wheel"
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    integer radius = floor(min(w,h)/2)
    integer cx = floor(w/2),
            cy = floor(h/2)

    for x=1 to w do
        for y=1 to h do
            integer rx = x - cx,
                    ry = y - cy
            atom s = sqrt(rx*rx+ry*ry) / radius
            if s <= 1.0 then
                atom hue = ((atan2(ry, rx) / PI) + 1.0) / 2.0
                cdCanvasPixel(cddbuffer, x, h-y, hsv_to_rgb(hue, s, 1))
            end if
        end for
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_WHITE)
    cdCanvasSetForeground(cddbuffer, CD_MAGENTA)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()
    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "300x300")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    dlg = IupDialog(canvas,`TITLE="%s",RESIZE=NO`,{title})
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
    IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


size(300, 300);
background(0);
float radius = min(width, height) / 2.0;
float cx = width / 2;
float cy = width / 2;
for (int x = 0; x < width; x++) {
  for (int y = 0; y < width; y++) {
    float rx = x - cx;
    float ry = y - cy;
    float s = sqrt(sq(rx) + sq(ry)) / radius;
    if (s <= 1.0) {
      float h = ((atan2(ry, rx) / PI) + 1.0) / 2.0;
      colorMode(HSB);
      color c = color(int(h * 255), int(s * 255), 255);
      set(x, y, c);
    }
  }
}


n = 5
m = 3
len result[] m
#
func combinations pos val . .
  if pos < m
    for i = val to n - m
      result[pos] = pos + i
      call combinations pos + 1 i
    .
  else
    print result[]
  .
.
call combinations 0 0


;;
;; using the native (combinations) function
(lib 'list)
(combinations (iota 5) 3)
→ ((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4))
;;
;; using an iterator
;;
(lib 'sequences)
(take (combinator (iota 5) 3) #:all)
→ ((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4))
;;
;; defining a function
;;
(define (combine lst p) (cond
    [(null? lst) null]
    [(< (length lst) p) null]
    [(= (length lst) p) (list lst)]
    [(= p 1) (map list lst)]
    [else (append
        (map cons (circular-list (first lst)) (combine (rest lst) (1- p)))
        (combine (rest lst) p))]))

(combine (iota 5) 3)
    → ((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4))


with javascript_semantics
procedure show_choices(sequence set, integer n, at=1, sequence res={})
    if length(res)=n then
        ?res
    else
        for i=at to length(set) do
            show_choices(set,n,i,append(deep_copy(res),set[i]))
        end for
    end if
end procedure

show_choices({"iced","jam","plain"},2)