import std.stdio, std.random, std.array, std.conv, std.traits,
       std.exception, std.range, std.algorithm;

const class SetDealer {
    protected {
        enum Color:  ubyte {green, purple, red}
        enum Number: ubyte {one, two, three}
        enum Symbol: ubyte {oval, diamond, squiggle}
        enum Fill:   ubyte {open, striped, solid}

        static struct Card {
            Color c;
            Number n;
            Symbol s;
            Fill f;
        }

        static immutable Card[81] deck;
    }

    static this() pure nothrow @safe {
        immutable colors = [EnumMembers!Color];
        immutable numbers = [EnumMembers!Number];
        immutable symbols = [EnumMembers!Symbol];
        immutable fill = [EnumMembers!Fill];

        deck = deck.length.iota.map!(i => Card(colors[i / 27],
                                               numbers[(i / 9) % 3],
                                               symbols[(i / 3) % 3],
                                               fill[i % 3])).array;
    }

    // randomSample produces a sorted output that's convenient in our
    // case because we're printing to stout. Normally you would want
    // to shuffle.
    immutable(Card)[] deal(in uint numCards) const {
        enforce(numCards < deck.length, "Number of cards too large");
        return deck[].randomSample(numCards).array;
    }

    // The summed enums of valid sets are always zero or a multiple
    // of 3.
    bool validSet(in ref Card c1, in ref Card c2, in ref Card c3)
    const pure nothrow @safe @nogc {
        return !((c1.c + c2.c + c3.c) % 3 ||
                 (c1.n + c2.n + c3.n) % 3 ||
                 (c1.s + c2.s + c3.s) % 3 ||
                 (c1.f + c2.f + c3.f) % 3);
    }

    immutable(Card)[3][] findSets(in Card[] cards, in uint target = 0)
    const pure nothrow @safe {
        immutable len = cards.length;
        if (len < 3)
            return null;

        typeof(return) sets;
        foreach (immutable i; 0 .. len - 2)
            foreach (immutable j; i + 1 .. len - 1)
                foreach (immutable k; j + 1 .. len)
                    if (validSet(cards[i], cards[j], cards[k])) {
                        sets ~= [cards[i], cards[j], cards[k]];
                        if (target != 0 && sets.length > target)
                            return null;
                    }
        return sets;
    }
}

const final class SetPuzzleDealer : SetDealer {
    enum {basic = 9, advanced = 12}

    override immutable(Card)[] deal(in uint numCards = basic) const {
        immutable numSets = numCards / 2;
        typeof(return) cards;

        do {
            cards = super.deal(numCards);
        } while (findSets(cards, numSets).length != numSets);

        return cards;
    }
}

void main() {
    const dealer = new SetPuzzleDealer;
    const cards = dealer.deal;

    writefln("DEALT %d CARDS:", cards.length);
    writefln("%(%s\n%)", cards);

    immutable sets = dealer.findSets(cards);
    immutable len = sets.length;
    writefln("\nFOUND %d SET%s:", len, len == 1 ? "" : "S");
    writefln("%(%(%s\n%)\n\n%)", sets);
}


class RealSet{
   fcn init(fx){ var [const] contains=fx; }
   fcn holds(x){ contains(x) }
   fcn __opAdd(rs){ RealSet('wrap(x){ contains(x) or rs.contains(x) }) }
   fcn __opSub(rs){ RealSet('wrap(x){ contains(x) and not rs.contains(x) }) }
   fcn intersection(rs) { RealSet('wrap(x){ contains(x) and rs.contains(x) }) }
}


(require 'list)

;; a card is a vector  [id color number symb shading], 0 <= id < 81
(define (make-deck (id -1))
(for*/vector(
	[ color '(red green purple)]
	[ number '(one two three)]
	[ symb '( oval squiggle diamond)]
	[ shading '(solid open striped)]) (++ id) (vector id color number symb shading)))
(define DECK (make-deck))

;; pre-generate  531441 ordered triples, among which 6561 are winners
(define TRIPLES (make-vector (* 81 81 81)))
(define (make-triples )
   (for* ((i 81)(j 81)(k 81))
	(vector-set! TRIPLES (+ i (* 81 j) (* 6561 k))
		(check-set [DECK i] [DECK j] [DECK k]))))

;; a deal is a list of cards id's.
(define (show-deal deal)
   (for ((card deal)) (writeln [DECK card]))
   (for ((set (combinations deal 3)))
     (when
     (check-set [DECK (first set)] [DECK (second set)][DECK (third set)])
     (writeln 'winner set))))

;; rules of game here
(define (check-set cards: a b c)
	(for ((i (in-range 1 5))) ;; each feature
	#:continue (and (= [a i] [b i]) (= [a i] [c i]))
	#:continue (and (!= [a i] [b i]) (!= [a i] [c i]) (!= [b i][c i]))
	#:break  #t =>  #f ))

;; sets = list of triples (card-id card-id card-id)
(define (count-sets sets )
	(for/sum ((s sets))
    (if [TRIPLES ( + (first s) (* 81 (second s)) (* 6561 (third s)))]
    1 0)))

;; task
(make-triples)

(define (play (n 9) (cmax 4) (sets) (deal))
	(while #t
		(set! deal (take (shuffle (iota 81)) n))
		(set! sets (combinations deal 3))
		#:break (= (count-sets sets) cmax) => (show-deal deal)
		))


defmodule RC do
  def set_puzzle(deal, goal) do
    {puzzle, sets} = get_puzzle_and_answer(deal, goal, produce_deck)
    IO.puts "Dealt #{length(puzzle)} cards:"
    print_cards(puzzle)
    IO.puts "Containing #{length(sets)} sets:"
    Enum.each(sets, fn set -> print_cards(set) end)
  end

  defp get_puzzle_and_answer(hand_size, num_sets_goal, deck) do
    hand = Enum.take_random(deck, hand_size)
    sets = get_all_sets(hand)
    if length(sets) == num_sets_goal do
      {hand, sets}
    else
      get_puzzle_and_answer(hand_size, num_sets_goal, deck)
    end
  end

  defp get_all_sets(hand) do
    Enum.filter(comb(hand, 3), fn candidate ->
      List.flatten(candidate)
      |> Enum.group_by(&(&1))
      |> Map.values
      |> Enum.all?(fn v -> length(v) != 2 end)
    end)
  end

  defp print_cards(cards) do
    Enum.each(cards, fn card ->
      :io.format "  ~-8s  ~-8s  ~-8s  ~-8s~n", card
    end)
    IO.puts ""
  end

  @colors   ~w(red green purple)a
  @symbols  ~w(oval squiggle diamond)a
  @numbers  ~w(one two three)a
  @shadings ~w(solid open striped)a

  defp produce_deck do
    for color <- @colors, symbol <- @symbols, number <- @numbers, shading <- @shadings,
      do: [color, symbol, number, shading]
  end

  defp comb(_, 0), do: [[]]
  defp comb([], _), do: []
  defp comb([h|t], m) do
    (for l <- comb(t, m-1), do: [h|l]) ++ comb(t, m)
  end
end

RC.set_puzzle(9, 4)
RC.set_puzzle(12, 6)


-module( set ).

-export( [deck/0, is_set/3, shuffle_deck/1, task/0] ).

-record( card, {number, symbol, shading, colour} ).

deck() -> [#card{number=N, symbol=Sy, shading=Sh, colour=C} || N <- [1,2,3], Sy <- [diamond, squiggle, oval], Sh <- [solid, striped, open], C <- [red, green, purple]].

is_set( Card1, Card2, Card3 ) ->
        is_colour_correct( Card1, Card2, Card3 )
        andalso is_number_correct( Card1, Card2, Card3 )
        andalso is_shading_correct( Card1, Card2, Card3 )
        andalso is_symbol_correct( Card1, Card2, Card3 ).

shuffle_deck( Deck ) -> knuth_shuffle:list( Deck ).

task() ->
    basic(),
    advanced().

advanced() -> common( 6, 12 ).

basic() -> common( 4, 9 ).

common(	X, Y ) ->
    {Sets, Cards} = find_x_sets_in_y_cards( X, Y, deck() ),
    io:fwrite( "Cards ~p~n", [Cards] ),
    io:fwrite( "Gives sets:~n" ),
    [io:fwrite( "~p~n", [S] ) || S <- Sets].

find_x_sets_in_y_cards( X, Y, Deck ) ->
    {Cards, _T} = lists:split( Y, shuffle_deck(Deck) ),
    find_x_sets_in_y_cards( X, Y, Cards, make_sets1(Cards, []) ).

find_x_sets_in_y_cards( X, _Y, _Deck, Cards, Sets ) when erlang:length(Sets) =:= X -> {Sets, Cards};
find_x_sets_in_y_cards( X, Y, Deck, _Cards, _Sets ) -> find_x_sets_in_y_cards( X, Y, Deck ).

is_colour_correct( Card1, Card2, Card3 ) -> is_colour_different( Card1, Card2, Card3 ) orelse is_colour_same( Card1, Card2, Card3 ).

is_colour_different( #card{colour=C1}, #card{colour=C2}, #card{colour=C3} ) when C1 =/= C2, C1 =/= C3, C2 =/= C3 -> true;
is_colour_different( _Card1, _Card2, _Card3 ) -> false.

is_colour_same( #card{colour=C}, #card{colour=C}, #card{colour=C} ) -> true;
is_colour_same( _Card1, _Card2, _Card3 ) -> false.

is_number_correct( Card1, Card2, Card3 ) -> is_number_different( Card1, Card2, Card3 ) orelse is_number_same( Card1, Card2, Card3 ).

is_number_different( #card{number=N1}, #card{number=N2}, #card{number=N3} ) when N1 =/= N2, N1 =/= N3, N2 =/= N3 -> true;
is_number_different( _Card1, _Card2, _Card3 ) -> false.

is_number_same( #card{number=N}, #card{number=N}, #card{number=N} ) -> true;
is_number_same( _Card1, _Card2, _Card3 ) -> false.

is_shading_correct( Card1, Card2, Card3 ) -> is_shading_different( Card1, Card2, Card3 ) orelse is_shading_same( Card1, Card2, Card3 ).

is_shading_different( #card{shading=S1}, #card{shading=S2}, #card{shading=S3} ) when S1 =/= S2, S1 =/= S3, S2 =/= S3 -> true;
is_shading_different( _Card1, _Card2, _Card3 ) -> false.

is_shading_same( #card{shading=S}, #card{shading=S}, #card{shading=S} ) -> true;
is_shading_same( _Card1, _Card2, _Card3 ) -> false.

is_symbol_correct( Card1, Card2, Card3 ) -> is_symbol_different( Card1, Card2, Card3 ) orelse is_symbol_same( Card1, Card2, Card3 ).

is_symbol_different( #card{symbol=S1}, #card{symbol=S2}, #card{symbol=S3} ) when S1 =/= S2, S1 =/= S3, S2 =/= S3 -> true;
is_symbol_different( _Card1, _Card2, _Card3 ) -> false.

is_symbol_same( #card{symbol=S}, #card{symbol=S}, #card{symbol=S} ) -> true;
is_symbol_same( _Card1, _Card2, _Card3 ) -> false.
%% Nested loops 1, 2 and 3
make_sets1( [_Second_to_last, _Last], Sets ) -> Sets;
make_sets1( [Card | T], Sets ) -> make_sets1( T, make_sets2(Card, T, Sets) ).

make_sets2( _Card, [_Last], Sets ) -> Sets;
make_sets2( Card1, [Card2 | T], Sets ) -> make_sets2( Card1, T, make_sets3( Card1, Card2, T,  Sets) ).

make_sets3( _Card1, _Card2, [], Sets ) -> Sets;
make_sets3( Card1, Card2, [Card3 | T], Sets ) ->
        make_sets3( Card1, Card2, T, make_sets_acc(is_set(Card1, Card2, Card3), {Card1, Card2, Card3}, Sets) ).

make_sets_acc( true, Set, Sets ) -> [Set | Sets];
make_sets_acc( false, _Set, Sets ) -> Sets.


open System

type Number = One | Two | Three
type Color = Red | Green | Purple
type Fill = Solid | Open | Striped
type Symbol = Oval | Squiggle | Diamond

type Card = { Number: Number; Color: Color; Fill: Fill; Symbol: Symbol }

// A 'Set' is 3 cards in which each individual feature is either all the SAME on each card, OR all DIFFERENT on each card.
let SetSize = 3

type CardsGenerator() =
    let _rand = Random()

    let shuffleInPlace data =
        Array.sortInPlaceBy (fun _ -> (_rand.Next(0, Array.length data))) data

    let createCards() =
        [| for n in [One; Two; Three] do
                for c in [Red; Green; Purple] do
                    for f in [Solid; Open; Striped] do
                        for s in [Oval; Squiggle; Diamond] do
                            yield { Number = n; Color = c; Fill = f; Symbol = s } |]

    let _cards = createCards()

    member x.GetHand cardCount =
        shuffleInPlace _cards
        Seq.take cardCount _cards |> Seq.toList

// Find all the combinations of n elements
let rec combinations n items =
    match n, items with
    | 0, _  -> [[]]
    | _, [] -> []
    | k, (x::xs) -> List.map ((@) [x]) (combinations (k-1) xs) @ combinations k xs

let validCardSet (cards: Card list) =
    // Valid feature if all features are the same or different
    let validFeature = function
        | [a; b; c] -> (a = b && b = c) || (a <> b && a <> c && b <> c)
        | _ -> false

    // Build and validate the feature lists
    let isValid = cards |> List.fold (fun (ns, cs, fs, ss) c ->
                               (c.Number::ns, c.Color::cs, c.Fill::fs, c.Symbol::ss)) ([], [], [], [])
                        |> fun (ns, cs, fs, ss) ->
                               (validFeature ns) && (validFeature cs) && (validFeature fs) && (validFeature ss)

    if isValid then Some cards else None

let findSolution cardCount setCount =
    let cardsGen = CardsGenerator()

    let rec search () =
        let hand = cardsGen.GetHand cardCount
        let foundSets = combinations SetSize hand |> List.choose validCardSet

        if foundSets.Length = setCount then (hand, foundSets) else search()

    search()

let displaySolution (hand: Card list, sets: Card list list) =
    let printCardDetails (c: Card) =
        printfn "    %A %A %A %A" c.Number c.Color c.Symbol c.Fill

    printfn "Dealt %d cards:" hand.Length
    List.iter printCardDetails hand
    printf "\n"

    printfn "Found %d sets:" sets.Length
    sets |> List.iter (fun cards -> List.iter printCardDetails cards; printf "\n" )

let playGame() =
    let solve cardCount setCount =
        displaySolution (findSolution cardCount setCount)

    solve 9 4
    solve 12 6

playGame()


USING: arrays backtrack combinators.short-circuit formatting
fry grouping io kernel literals math.combinatorics math.matrices
prettyprint qw random sequences sets ;
IN: rosetta-code.set-puzzle

CONSTANT: deck $[
    [
        qw{ red green purple } amb-lazy
        qw{ one two three } amb-lazy
        qw{ oval squiggle diamond } amb-lazy
        qw{ solid open striped } amb-lazy 4array
    ] bag-of
]

: valid-category? ( seq -- ? )
    { [ all-equal? ] [ all-unique? ] } 1|| ;

: valid-set? ( seq -- ? )
    [ valid-category? ] column-map t [ and ] reduce ;

: find-sets ( seq -- seq )
    3 <combinations> [ valid-set? ] filter ;

: deal-hand ( m n -- seq valid? )
    [ deck swap sample ] dip over find-sets length = ;

: find-valid-hand ( m n -- seq )
    [ f ] 2dip '[ drop _ _ deal-hand not ] loop ;

: set-puzzle ( m n -- )
    [ find-valid-hand ] 2keep
    [ "Dealt %d cards:\n" printf simple-table. nl ]
    [
        "Containing %d sets:\n" printf find-sets
        { { " " " " " " " " } } join simple-table. nl
    ] bi-curry* bi ;

: main ( -- )
    9  4 set-puzzle
    12 6 set-puzzle ;

MAIN: main


package main

import (
    "fmt"
    "math/rand"
    "time"
)

const (
    number = [3]string{"1", "2", "3"}
    color  = [3]string{"red", "green", "purple"}
    shade  = [3]string{"solid", "open", "striped"}
    shape  = [3]string{"oval", "squiggle", "diamond"}
)

type card int

func (c card) String() string {
    return fmt.Sprintf("%s %s %s %s",
        number[c/27],
        color[c/9%3],
        shade[c/3%3],
        shape[c%3])
}

func main() {
    rand.Seed(time.Now().Unix())
    game("Basic", 9, 4)
    game("Advanced", 12, 6)
}

func game(level string, cards, sets int) {
    // create deck
    d := make([]card, 81)
    for i := range d {
        d[i] = card(i)
    }
    var found [][3]card
    for len(found) != sets {
        found = found[:0]
        // deal
        for i := 0; i < cards; i++ {
            j := rand.Intn(81 - i)
            d[i], d[j] = d[j], d[i]
        }
        //  consider all triplets
        for i := 2; i < cards; i++ {
            c1 := d[i]
            for j := 1; j < i; j++ {
                c2 := d[j]
            l3:
                for _, c3 := range d[:j] {
                    for f := card(1); f < 81; f *= 3 {
                        if (c1/f%3 + c2/f%3 + c3/f%3) % 3 != 0 {
                            continue l3 // not a set
                        }
                    }
                    // it's a set
                    found = append(found, [3]card{c1, c2, c3})
                }
            }
        }
    }
    // found the right number
    fmt.Printf("%s game.  %d cards, %d sets.\n", level, cards, sets)
    fmt.Println("Cards:")
    for _, c := range d[:cards] {
        fmt.Println("  ", c)
    }
    fmt.Println("Sets:")
    for _, s := range found {
        fmt.Printf("  %s\n  %s\n  %s\n",s[0],s[1],s[2])
    }
}


generic
   type Element is (<>);
   with function Image(E: Element) return String;
package Set_Cons is

   type Set is private;

   -- constructor and manipulation functions for type Set
   function "+"(E: Element) return Set;
   function "+"(Left, Right: Element) return Set;
   function "+"(Left: Set; Right: Element) return Set;
   function "-"(Left: Set; Right: Element) return Set;

   -- compare, unite or output a Set
   function Nonempty_Intersection(Left, Right: Set) return Boolean;
   function Union(Left, Right: Set) return Set;
   function Image(S: Set) return String;

   type Set_Vec is array(Positive range <>) of Set;

   -- output a Set_Vec
   function Image(V: Set_Vec) return String;

private
   type Set is array(Element) of Boolean;

end Set_Cons;


import Control.Monad.State
       (State, evalState, replicateM, runState, state)
import System.Random (StdGen, newStdGen, randomR)
import Data.List (find, nub, sort)

combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations _ [] = []
combinations k (y:ys) = map (y :) (combinations (k - 1) ys) ++ combinations k ys

data Color
  = Red
  | Green
  | Purple
  deriving (Show, Enum, Bounded, Ord, Eq)

data Symbol
  = Oval
  | Squiggle
  | Diamond
  deriving (Show, Enum, Bounded, Ord, Eq)

data Count
  = One
  | Two
  | Three
  deriving (Show, Enum, Bounded, Ord, Eq)

data Shading
  = Solid
  | Open
  | Striped
  deriving (Show, Enum, Bounded, Ord, Eq)

data Card = Card
  { color :: Color
  , symbol :: Symbol
  , count :: Count
  , shading :: Shading
  } deriving (Show)

-- Identify a set of three cards by counting all attribute types.
-- if each count is 3 or 1 ( not 2 ) the the cards compose a set.
isSet :: [Card] -> Bool
isSet cs =
  let total = length . nub . sort . flip map cs
  in notElem 2 [total color, total symbol, total count, total shading]

-- Get a random card from a deck. Returns the card and removes it from the deck.
getCard :: State (StdGen, [Card]) Card
getCard =
  state $
  \(gen, cs) ->
     let (i, newGen) = randomR (0, length cs - 1) gen
         (a, b) = splitAt i cs
     in (head b, (newGen, a ++ tail b))

-- Get a hand of cards.  Starts with new deck and then removes the
-- appropriate number of cards from that deck.
getHand :: Int -> State StdGen [Card]
getHand n =
  state $
  \gen ->
     let az = [minBound .. maxBound]
         deck =
           [ Card co sy ct sh
           | co <- az
           , sy <- az
           , ct <- az
           , sh <- az ]
         (a, (newGen, _)) = runState (replicateM n getCard) (gen, deck)
     in (a, newGen)

-- Get an unbounded number of hands of the appropriate number of cards.
getManyHands :: Int -> State StdGen [[Card]]
getManyHands n = (sequence . repeat) (getHand n)

-- Deal out hands of the appropriate size until one with the desired number
-- of sets is found.  then print the hand and the sets.
showSolutions :: Int -> Int -> IO ()
showSolutions cardCount solutionCount = do
  putStrLn $
    "Showing hand of " ++
    show cardCount ++ " cards with " ++ show solutionCount ++ " solutions."
  gen <- newStdGen
  let Just z =
        find ((solutionCount ==) . length . filter isSet . combinations 3) $
        evalState (getManyHands cardCount) gen
  mapM_ print z
  putStrLn ""
  putStrLn "Solutions:"
  mapM_ putSet $ filter isSet $ combinations 3 z
  where
    putSet st = do
      mapM_ print st
      putStrLn ""

-- Show a hand of 9 cards with 4 solutions
-- and a hand of 12 cards with 6 solutions.
main :: IO ()
main = do
  showSolutions 9 4
  showSolutions 12 6


display(list l)
{
    for (integer i, record r in l) {
        text u, v;

        o_text(i ? ", {" : "{");
        for (u in r) {
            o_(v, u);
            v = ", ";
        }
        o_text("}");
    }

    o_text("\n");
}

intersect(record r, record u)
{
    trap_q(r_vcall, r, r_put, 1, record().copy(u), 0);
}

consolidate(list l)
{
    for (integer i, record r in l) {
        integer j;

        j = i - ~l;
        while (j += 1) {
            if (intersect(r, l[j])) {
                r.wcall(r_add, 1, 2, l[j]);
                l.delete(i);
                i -= 1;
                break;
            }
        }
    }

    l;
}

R(...)
{
    ucall.2(r_put, 1, record(), 0);
}

main(void)
{
    display(consolidate(list(R("A", "B"), R("C", "D"))));
    display(consolidate(list(R("A", "B"), R("B", "D"))));
    display(consolidate(list(R("A", "B"), R("C", "D"), R("D", "B"))));
    display(consolidate(list(R("H", "I", "K"), R("A", "B"), R("C", "D"),
                             R("D", "B"), R("F", "G", "K"))));

    0;
}


SetConsolidation(sets){
	arr2 := [] , arr3 := [] , arr4 := [] , arr5 := [], result:=[]
	; sort each set individually
	for i, obj in sets
	{
		arr1 := []
		for j, v in obj
			arr1[v] := true
		arr2.push(arr1)
	}

	; sort by set's first item
	for i, obj in arr2
		for k, v in obj
		{
			arr3[k . i] := obj
			break
		}

	; use numerical index
	for k, obj in arr3
		arr4[A_Index] := obj

	j := 1
	for i, obj in arr4
	{
		common := false
		for k, v in obj
			if arr5[j-1].HasKey(k)
			{
				common := true
				break
			}

		if common
			for k, v in obj
				arr5[j-1, k] := true
		else
			arr5[j] := obj, j++
	}
	; clean up
	for i, obj in arr5
		for k , v in obj
			result[i, A_Index] := k
	return result
}


( ( consolidate
  =   a m z mm za zm zz
    .     ( removeNumFactors
          =   a m z
            .     !arg:?a+#%*?m+?z
                & !a+!m+removeNumFactors$!z
              | !arg
          )
        &   !arg
          :   ?a
              %?`m
              ( %?z
              &   !m
                :   ?
                  + ( %@?mm
                    & !z:?za (?+!mm+?:?zm) ?zz
                    )
                  + ?
              )
        & consolidate$(!a removeNumFactors$(!m+!zm) !za !zz)
      | !arg
  )
& (test=.out$(!arg "==>" consolidate$!arg))
& test$(A+B C+D)
& test$(A+B B+D)
& test$(A+B C+D D+B)
& test$(H+I+K A+B C+D D+B F+G+H)
);


require 'stats/base'

Number=: ;:'one two three'
Colour=: ;:'red green purple'
Fill=: ;:'solid open striped'
Symbol=: ;:'oval squiggle diamond'
Features=: Number ; Colour ; Fill ;< Symbol
Deck=: > ; <"1 { [email protected]#&.> Features
sayCards=: (', ' joinstring Features {&>~ ])"1
drawRandom=: ] {~ (? #)
isSet=: *./@:(1 3 e.~ [: #@~."1 |:)"2
getSets=: [: (] #~ isSet) ] {~ 3 comb #
countSets=: #@:getSets

set_puzzle=: verb define
 target=. <. -: y
 whilst. target ~: countSets Hand do.
   Hand=. y drawRandom Deck
 end.
 echo 'Dealt ',(": y),' Cards:'
 echo sayCards sort Hand
 echo LF,'Found ',(":target),' Sets:'
 echo sayCards sort"2 getSets Hand
)


import java.util.*;

public class SetPuzzle {

    enum Color {

        GREEN(0), PURPLE(1), RED(2);

        private Color(int v) {
            val = v;
        }
        public final int val;
    }

    enum Number {

        ONE(0), TWO(1), THREE(2);

        private Number(int v) {
            val = v;
        }
        public final int val;
    }

    enum Symbol {

        OVAL(0), DIAMOND(1), SQUIGGLE(2);

        private Symbol(int v) {
            val = v;
        }
        public final int val;
    }

    enum Fill {

        OPEN(0), STRIPED(1), SOLID(2);

        private Fill(int v) {
            val = v;
        }
        public final int val;
    }

    private static class Card implements Comparable<Card> {

        Color c;
        Number n;
        Symbol s;
        Fill f;

        @Override
        public String toString() {
            return String.format("[Card: %s, %s, %s, %s]", c, n, s, f);
        }

        @Override
        public int compareTo(Card o) {
            return (c.val - o.c.val) * 10 + (n.val - o.n.val);
        }
    }
    private static Card[] deck;

    public static void main(String[] args) {
        deck = new Card[81];
        Color[] colors = Color.values();
        Number[] numbers = Number.values();
        Symbol[] symbols = Symbol.values();
        Fill[] fillmodes = Fill.values();
        for (int i = 0; i < deck.length; i++) {
            deck[i] = new Card();
            deck[i].c = colors[i / 27];
            deck[i].n = numbers[(i / 9) % 3];
            deck[i].s = symbols[(i / 3) % 3];
            deck[i].f = fillmodes[i % 3];
        }
        findSets(12);
    }

    private static void findSets(int numCards) {
        int target = numCards / 2;
        Card[] cards;
        Card[][] sets = new Card[target][3];
        int cnt;
        do {
            Collections.shuffle(Arrays.asList(deck));
            cards = Arrays.copyOfRange(deck, 0, numCards);
            cnt = 0;

            outer:
            for (int i = 0; i < cards.length - 2; i++) {
                for (int j = i + 1; j < cards.length - 1; j++) {
                    for (int k = j + 1; k < cards.length; k++) {
                        if (validSet(cards[i], cards[j], cards[k])) {
                            if (cnt < target)
                                sets[cnt] = new Card[]{cards[i], cards[j], cards[k]};
                            if (++cnt > target) {
                                break outer;
                            }
                        }
                    }
                }
            }
        } while (cnt != target);

        Arrays.sort(cards);

        System.out.printf("GIVEN %d CARDS:\n\n", numCards);
        for (Card c : cards) {
            System.out.println(c);
        }
        System.out.println();

        System.out.println("FOUND " + target + " SETS:\n");
        for (Card[] set : sets) {
            for (Card c : set) {
                System.out.println(c);
            }
            System.out.println();
        }
    }

    private static boolean validSet(Card c1, Card c2, Card c3) {
        int tot = 0;
        tot += (c1.c.val + c2.c.val + c3.c.val) % 3;
        tot += (c1.n.val + c2.n.val + c3.n.val) % 3;
        tot += (c1.s.val + c2.s.val + c3.s.val) % 3;
        tot += (c1.f.val + c2.f.val + c3.f.val) % 3;
        return tot == 0;
    }
}


#include <stdio.h>

#define s(x) (1U << ((x) - 'A'))

typedef unsigned int bitset;

int consolidate(bitset *x, int len)
{
	int i, j;
	for (i = len - 2; i >= 0; i--)
		for (j = len - 1; j > i; j--)
			if (x[i] & x[j])
				x[i] |= x[j], x[j] = x[--len];
	return len;
}

void show_sets(bitset *x, int len)
{
	bitset b;
	while(len--) {
		for (b = 'A'; b <= 'Z'; b++)
			if (x[len] & s(b)) printf("%c ", b);
		putchar('\n');
	}
}

int main(void)
{
	bitset x[] = { s('A') | s('B'), s('C') | s('D'), s('B') | s('D'),
			s('F') | s('G') | s('H'), s('H') | s('I') | s('K') };

	int len = sizeof(x) / sizeof(x[0]);

	puts("Before:"); show_sets(x, len);
	puts("\nAfter:"); show_sets(x, consolidate(x, len));
	return 0;
}


using Random, IterTools, Combinatorics

function SetGameTM(basic = true)
    drawsize = basic ? 9 : 12
    setsneeded = div(drawsize, 2)
    setsof3 = Vector{Vector{NTuple{4, String}}}()
    draw = Vector{NTuple{4, String}}()
    deck = collect(Iterators.product(["red", "green", "purple"], ["one", "two", "three"],
        ["oval", "squiggle", "diamond"], ["solid", "open", "striped"]))

    while length(setsof3) != setsneeded
        empty!(draw)
        empty!(setsof3)
        map(x -> push!(draw, x), shuffle(deck)[1:drawsize])
        for threecards in combinations(draw, 3)
            canuse = true
            for i in 1:4
                u = length(unique(map(x->x[i], threecards)))
                if u != 3 && u != 1
                    canuse = false
                end
            end
            if canuse
                push!(setsof3, threecards)
            end
        end
    end

    println("Dealt $drawsize cards:")
    for card in draw
        println("    $card")
    end
    println("\nFormed these cards into $setsneeded sets:")
    for set in setsof3
        for card in set
            println("    $card")
        end
        println()
    end
end

SetGameTM()
SetGameTM(false)


// version 1.1.3

import java.util.Collections.shuffle

enum class Color   { RED, GREEN, PURPLE }
enum class Symbol  { OVAL, SQUIGGLE, DIAMOND }
enum class Number  { ONE, TWO, THREE }
enum class Shading { SOLID, OPEN, STRIPED }
enum class Degree  { BASIC, ADVANCED }

class Card(
    val color:   Color,
    val symbol:  Symbol,
    val number:  Number,
    val shading: Shading
) : Comparable<Card> {

    private val value =
        color.ordinal * 27 + symbol.ordinal * 9 + number.ordinal * 3  + shading.ordinal

    override fun compareTo(other: Card) = value.compareTo(other.value)

    override fun toString() = (
        color.name.padEnd(8)   +
        symbol.name.padEnd(10) +
        number.name.padEnd(7)  +
        shading.name.padEnd(7)
    ).toLowerCase()

    companion object {
        val zero = Card(Color.RED, Symbol.OVAL, Number.ONE, Shading.SOLID)
    }
}

fun createDeck() =
    List<Card>(81) {
        val col = Color.values()  [it / 27]
        val sym = Symbol.values() [it / 9 % 3]
        val num = Number.values() [it / 3 % 3]
        val shd = Shading.values()[it % 3]
        Card(col, sym, num, shd)
    }

fun playGame(degree: Degree) {
    val deck = createDeck()
    val nCards = if (degree == Degree.BASIC) 9 else 12
    val nSets = nCards / 2
    val sets = Array(nSets) { Array(3) { Card.zero } }
    var hand: Array<Card>
    outer@ while (true) {
        shuffle(deck)
        hand = deck.take(nCards).toTypedArray()
        var count = 0
        for (i in 0 until hand.size - 2) {
            for (j in i + 1 until hand.size - 1) {
                for (k in j + 1 until hand.size) {
                    val trio = arrayOf(hand[i], hand[j], hand[k])
                    if (isSet(trio)) {
                        sets[count++] = trio
                        if (count == nSets) break@outer
                    }
                }
            }
        }
    }
    hand.sort()
    println("DEALT $nCards CARDS:\n")
    println(hand.joinToString("\n"))
    println("\nCONTAINING $nSets SETS:\n")
    for (s in sets) {
        s.sort()
        println(s.joinToString("\n"))
        println()
    }
}

fun isSet(trio: Array<Card>): Boolean {
    val r1 = trio.sumBy { it.color.ordinal   } % 3
    val r2 = trio.sumBy { it.symbol.ordinal  } % 3
    val r3 = trio.sumBy { it.number.ordinal  } % 3
    val r4 = trio.sumBy { it.shading.ordinal } % 3
    return (r1 + r2 + r3 + r4) == 0
}

fun main(args: Array<String>) {
    playGame(Degree.BASIC)
    println()
    playGame(Degree.ADVANCED)
}


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

public class SetConsolidation
{
    public static void Main()
    {
        var setCollection1 = new[] {new[] {"A", "B"}, new[] {"C", "D"}};
        var setCollection2 = new[] {new[] {"A", "B"}, new[] {"B", "D"}};
        var setCollection3 = new[] {new[] {"A", "B"}, new[] {"C", "D"}, new[] {"B", "D"}};
        var setCollection4 = new[] {new[] {"H", "I", "K"}, new[] {"A", "B"}, new[] {"C", "D"},
            new[] {"D", "B"}, new[] {"F", "G", "H"}};
        var input = new[] {setCollection1, setCollection2, setCollection3, setCollection4};

        foreach (var sets in input) {
            Console.WriteLine("Start sets:");
            Console.WriteLine(string.Join(", ", sets.Select(s => "{" + string.Join(", ", s) + "}")));
            Console.WriteLine("Sets consolidated using Nodes:");
            Console.WriteLine(string.Join(", ", ConsolidateSets1(sets).Select(s => "{" + string.Join(", ", s) + "}")));
            Console.WriteLine("Sets consolidated using Set operations:");
            Console.WriteLine(string.Join(", ", ConsolidateSets2(sets).Select(s => "{" + string.Join(", ", s) + "}")));
            Console.WriteLine();
        }
    }

    /// <summary>
    /// Consolidates sets using a connected-component-finding-algorithm involving Nodes with parent pointers.
    /// The more efficient solution, but more elaborate code.
    /// </summary>
    private static IEnumerable<IEnumerable<T>> ConsolidateSets1<T>(IEnumerable<IEnumerable<T>> sets,
        IEqualityComparer<T> comparer = null)
    {
        if (comparer == null) comparer = EqualityComparer<T>.Default;
        var elements = new Dictionary<T, Node<T>>();
        foreach (var set in sets) {
            Node<T> top = null;
            foreach (T value in set) {
                Node<T> element;
                if (elements.TryGetValue(value, out element)) {
                    if (top != null) {
                        var newTop = element.FindTop();
                        top.Parent = newTop;
                        element.Parent = newTop;
                        top = newTop;
                    } else {
                        top = element.FindTop();
                    }
                } else {
                    elements.Add(value, element = new Node<T>(value));
                    if (top == null) top = element;
                    else element.Parent = top;
                }
            }
        }
        foreach (var g in elements.Values.GroupBy(element => element.FindTop().Value))
            yield return g.Select(e => e.Value);
    }

    private class Node<T>
    {
        public Node(T value, Node<T> parent = null) {
            Value = value;
            Parent = parent ?? this;
        }

        public T Value { get; }
        public Node<T> Parent { get; set; }

        public Node<T> FindTop() {
            var top = this;
            while (top != top.Parent) top = top.Parent;
            //Set all parents to the top element to prevent repeated iteration in the future
            var element = this;
            while (element.Parent != top) {
                var parent = element.Parent;
                element.Parent = top;
                element = parent;
            }
            return top;
        }
    }

    /// <summary>
    /// Consolidates sets using operations on the HashSet<T> class.
    /// Less efficient than the other method, but easier to write.
    /// </summary>
    private static IEnumerable<IEnumerable<T>> ConsolidateSets2<T>(IEnumerable<IEnumerable<T>> sets,
        IEqualityComparer<T> comparer = null)
    {
        if (comparer == null) comparer = EqualityComparer<T>.Default;
        var currentSets = sets.Select(s => new HashSet<T>(s)).ToList();
        int previousSize;
        do {
            previousSize = currentSets.Count;
            for (int i = 0; i < currentSets.Count - 1; i++) {
                for (int j = currentSets.Count - 1; j > i; j--) {
                    if (currentSets[i].Overlaps(currentSets[j])) {
                        currentSets[i].UnionWith(currentSets[j]);
                        currentSets.RemoveAt(j);
                    }
                }
            }
        } while (previousSize > currentSets.Count);
        foreach (var set in currentSets) yield return set.Select(value => value);
    }
}


colors = {Red, Green, Purple};
symbols = {"0", "\[TildeTilde]", "\[Diamond]"};
numbers = {1, 2, 3};
shadings = {"\[FilledSquare]", "\[Square]", "\[DoublePrime]"};

validTripleQ[l_List] := Entropy[l] != Entropy[{1, 1, 2}];
validSetQ[cards_List] := And @@ (validTripleQ /@ Transpose[cards]);

allCards = Tuples[{colors, symbols, numbers, shadings}];

deal[{numDeal_, setNum_}] := Module[{cards, count = 0},
   While[count != setNum,
    cards = RandomSample[allCards, numDeal];
    count = Count[Subsets[cards, {3}], _?validSetQ]];
   cards];
Row[{Style[#2, #1], #3, #4}] & @@@ deal[{9, 4}]


import algorithm, math, random, sequtils, strformat, strutils

type

  # Card features.
  Number {.pure.} = enum One, Two, Three
  Color {.pure.} = enum Red, Green, Purple
  Symbol {.pure.} = enum Oval, Squiggle, Diamond
  Shading {.pure.} = enum Solid, Open, Striped

  # Cards and list of cards.
  Card = tuple[number: Number; color: Color; symbol: Symbol; shading: Shading]
  Triplet = array[3, Card]
  Deck = array[81, Card]

  # Game level.
  Level {.pure.} = enum Basic = "basic", Advanced = "advanced"

proc `$`(card: Card): string =
  ## Return the string representation of a card.
  toLowerAscii(&"{card.number:<5}  {card.color:<6}  {card.symbol:<8}  {card.shading:<7}")

proc initDeck(): Deck =
  ## Create a new deck.
  var i = 0
  for num in Number.low..Number.high:
    for col in Color.low..Color.high:
      for sym in Symbol.low..Symbol.high:
        for sh in Shading.low..Shading.high:
          result[i] = (number: num, color: col, symbol: sym, shading: sh)
          inc i

proc isSet(triplet: Triplet): bool =
  ## Check if a triplets of cards is a set.
  sum(triplet.mapIt(ord(it.number))) mod 3 == 0 and
  sum(triplet.mapIt(ord(it.color))) mod 3 == 0 and
  sum(triplet.mapIt(ord(it.symbol))) mod 3 == 0 and
  sum(triplet.mapIt(ord(it.shading))) mod 3 == 0

proc playGame(level: Level) =
  ## Play the game at given level.

  var deck = initDeck()
  let (nCards, nSets) = if level == Basic: (9, 4) else: (12, 6)
  var sets: seq[Triplet]
  var hand: seq[Card]
  echo &"Playing {level} game: {nCards} cards, {nSets} sets."

  block searchHand:
    while true:
      sets.setLen(0)
      deck.shuffle()
      hand = deck[0..<nCards]
      block countSets:
        for i in 0..(nCards - 3):
          for j in (i + 1)..(nCards - 2):
            for k in (j + 1)..(nCards - 1):
              let triplet = [hand[i], hand[j], hand[k]]
              if triplet.isSet():
                sets.add triplet
                if sets.len > nSets:
                  break countSets   # Too much sets. Try with a new hand.
        if sets.len == nSets:
          break searchHand    # Found: terminate search.

  # Display the hand and the sets.
  echo "\nCards:"
  for card in sorted(hand): echo "    ", card
  echo "\nSets:"
  for s in sets:
    for card in sorted(s): echo "    ", card
    echo()

randomize()
playGame(Basic)
echo()
playGame(Advanced)


(defn consolidate-linked-sets [sets]
  (apply clojure.set/union sets))

(defn linked? [s1 s2]
  (not (empty? (clojure.set/intersection s1 s2))))

(defn consolidate [& sets]
  (loop [seeds sets
         sets  sets]
    (if (empty? seeds)
      sets
      (let [s0     (first seeds)
            linked (filter #(linked? s0 %) sets)
            remove-used (fn [sets used]
                          (remove #(contains? (set used) %) sets))]
        (recur (remove-used (rest seeds) linked)
               (conj (remove-used sets linked)
                     (consolidate-linked-sets linked)))))))


(defun consolidate (ss)
  (labels ((comb (cs s)
             (cond ((null s) cs)
                   ((null cs) (list s))
                   ((null (intersection s (first cs)))
                    (cons (first cs) (comb (rest cs) s)))
                   ((consolidate (cons (union s (first cs)) (rest cs)))))))
    (reduce #'comb ss :initial-value nil)))


import std.stdio, std.algorithm, std.array;

dchar[][] consolidate(dchar[][] sets) @safe {
    foreach (set; sets)
        set.sort();

    foreach (i, ref si; sets[0 .. $ - 1]) {
        if (si.empty)
            continue;
        foreach (ref sj; sets[i + 1 .. $])
            if (!sj.empty && !si.setIntersection(sj).empty) {
                sj = si.setUnion(sj).uniq.array;
                si = null;
            }
    }

    return sets.filter!"!a.empty".array;
}

void main() @safe {
    [['A', 'B'], ['C','D']].consolidate.writeln;

    [['A','B'], ['B','D']].consolidate.writeln;

    [['A','B'], ['C','D'], ['D','B']].consolidate.writeln;

    [['H','I','K'], ['A','B'], ['C','D'],
     ['D','B'], ['F','G','H']].consolidate.writeln;
}


dealraw(cards)=vector(cards,i,vector(4,j,1<<random(3)));
howmany(a,b,c)=hammingweight(bitor(a,bitor(b,c)));
name(v)=Str(["red","green",0,"purple"][v[1]],", ",["oval","squiggle",0,"diamond"][v[2]],", ",["one","two",0,"three"][v[3]],", ",["solid","open",0,"striped"][v[4]]);
check(D,sets)={
  my(S=List());
  for(i=1,#D-2,for(j=i+1,#D-1,for(k=j+1,#D,
    for(x=1,4,
      if(howmany(D[i][x],D[j][x],D[k][x])==2,next(2))
    );
    listput(S,[i,j,k]);
    if(#S>sets,return(0))
  )));
  if(#S==sets,Vec(S),0)
};
deal(cards,sets)={
  my(v,s);
  until(s,
    s=check(v=dealraw(cards),sets)
  );
  v=apply(name,v);
  for(i=1,cards,print(v[i]));
  for(i=1,sets,
    print("Set #"i);
    for(j=1,3,print("  "v[s[i][j]]))
  )
};
deal(9,4)
deal(12,6)


;; utility : make a set of sets from a list
(define (make-set* s)
		(or (when (list? s) (make-set (map make-set* s))) s))

;; union of all sets which intersect - O(n^2)
(define (make-big ss)
(make-set
	(for/list ((u ss))
	(for/fold (big u) ((v ss)) #:when (set-intersect? big v)  (set-union big v)))))

;; remove sets which are subset of another one - O(n^2)
(define (remove-small ss)
	(for/list ((keep ss))
	#:when (for/and ((v ss))  #:continue (set-equal? keep v) (not (set-subset? v keep)))
	keep))

(define (consolidate ss) (make-set (remove-small (make-big ss))))

(define S (make-set* ' ((h i k) ( a b) ( b c) (c d) ( f g h))))
    → { { a b } { b c } { c d } { f g h } { h i k } }

(consolidate S)
    → { { a b c d } { f g h i k } }


(define $consolidate
  (lambda [$xss]
    (match xss (multiset (set char))
      {[<cons <cons $m $xs>
              <cons <cons ,m $ys>
                    $rss>>
        (consolidate {(unique/m char {m @xs @ys}) @rss})]
       [_ xss]})))

(test (consolidate {{'H' 'I' 'K'} {'A' 'B'} {'C' 'D'} {'D' 'B'} {'F' 'G' 'H'}}))


#!perl
use strict;
use warnings;

# This code was adapted from the Raku solution for this task.

# Each element of the deck is an integer, which, when written
# in octal, has four digits, which are all either 1, 2, or 4.

my $fmt = '%4o';
my @deck = grep sprintf($fmt, $_) !~ tr/124//c, 01111 .. 04444;

# Given a feature digit (1, 2, or 4), produce the feature's name.
# Note that digits 0 and 3 are unused.
my @features = map [split ' '], split /\n/,<<'';
! red   green    ! purple
! one   two      ! three
! oval  squiggle ! diamond
! solid open     ! striped

81 == @deck or die "There are ".@deck." cards (should be 81)";

# By default, draw 9 cards, but if the user
# supplied a parameter, use that.
my $draw = shift(@ARGV) || 9;
my $goal = int($draw/2);

# Get the possible combinations of 3 indices into $draw elements.
my @combinations = combine(3, 0 .. $draw-1);

my @sets;

do {
	# Shuffle the first $draw elements of @deck.
	for my $i ( 0 .. $draw-1 ) {
		my $j = $i + int rand(@deck - $i);
		@deck[$i, $j] = @deck[$j, $i];
	}

	# Find all valid sets using the shuffled elements.
	@sets = grep {
		my $or = 0;
		$or |= $_ for @deck[@$_];
		# If all colors (or whatever) are the same, then
		# a 1, 2, or 4 will result when we OR them together.
		# If they're all different, then a 7 will result.
		# If any other digit occurs, the set is invalid.
		sprintf($fmt, $or) !~ tr/1247//c;
	} @combinations;

	# Continue until there are exactly $goal valid sets.
} until @sets == $goal;

print "Drew $draw cards:\n";
for my $i ( 0 .. $#sets ) {
	print "Set ", $i+1, ":\n";
	my @cards = @deck[ @{$sets[$i]} ];
	for my $card ( @cards ) {
		my @octal = split //, sprintf '%4o', $card;
		my @f = map $features[$_][$octal[$_]], 0 .. 3;
		printf "    %-6s %-5s %-8s %s\n", @f;
	}
}

exit;

# This function is adapted from the perl5i solution for the
# RosettaCode Combinations task.
sub combine {
	my $n = shift;
	return unless @_;
	return map [$_], @_ if $n == 1;
	my $head = shift;
	my @result = combine( $n-1, @_ );
	unshift @$_, $head for @result;
	@result, combine( $n, @_ );
}

__END__


F divisors(n)
   V divs = [1]
   L(ii) 2 .< Int(n ^ 0.5) + 3
      I n % ii == 0
         divs.append(ii)
         divs.append(Int(n / ii))
   divs.append(n)
   R Array(Set(divs))

F sequence(max_n)
   V previous = 0
   V n = 0
   [Int] r
   L
      n++
      V ii = previous
      I n > max_n
         L.break
      L
         ii++
         I divisors(ii).len == n
            r.append(ii)
            previous = ii
            L.break
   R r

L(item) sequence(15)
   print(item)


open list

merge [] ys = ys
merge (x::xs) ys | x `elem` ys = merge xs ys
                 | else = merge xs (x::ys)

consolidate (_::[])@xs = xs
consolidate (x::xs) = conso [x] (consolidate xs)
                where conso xs [] = xs
                      conso (x::xs)@r (y::ys) | intersect x y <> [] = conso ((merge x y)::xs) ys
                                              | else = conso (r ++ [y]) ys


defmodule RC do
  def set_consolidate(sets, result\\[])
  def set_consolidate([], result), do: result
  def set_consolidate([h|t], result) do
    case Enum.find(t, fn set -> not MapSet.disjoint?(h, set) end) do
      nil -> set_consolidate(t, [h | result])
      set -> set_consolidate([MapSet.union(h, set) | t -- [set]], result)
    end
  end
end

examples = [[[:A,:B], [:C,:D]],
            [[:A,:B], [:B,:D]],
            [[:A,:B], [:C,:D], [:D,:B]],
            [[:H,:I,:K], [:A,:B], [:C,:D], [:D,:B], [:F,:G,:H]]]
           |> Enum.map(fn sets ->
                Enum.map(sets, fn set -> MapSet.new(set) end)
              end)

Enum.each(examples, fn sets ->
  IO.write "#{inspect sets} =>\n\t"
  IO.inspect RC.set_consolidate(sets)
end)


let (|SeqNode|SeqEmpty|) s =
    if Seq.isEmpty s then SeqEmpty
    else SeqNode ((Seq.head s), Seq.skip 1 s)

let SetDisjunct x y = Set.isEmpty (Set.intersect x y)

let rec consolidate s = seq {
    match s with
    | SeqEmpty -> ()
    | SeqNode (this, rest) ->
        let consolidatedRest = consolidate rest
        for that in consolidatedRest do
            if (SetDisjunct this that) then yield that
        yield Seq.fold (fun x y -> if not (SetDisjunct x y) then Set.union x y else x) this consolidatedRest
}

[<EntryPoint>]
let main args =
    let makeSeqOfSet listOfList = List.map (fun x -> Set.ofList x) listOfList |> Seq.ofList
    List.iter (fun x -> printfn "%A" (consolidate (makeSeqOfSet x))) [
        [["A";"B"]; ["C";"D"]];
        [["A";"B"]; ["B";"C"]];
        [["A";"B"]; ["C";"D"]; ["D";"B"]];
        [["H";"I";"K"]; ["A";"B"]; ["C";"D"]; ["D";"B"]; ["F";"G";"H"]]
    ]
    0


F divisors(n)
   V divs = [1]
   L(ii) 2 .< Int(n ^ 0.5) + 3
      I n % ii == 0
         divs.append(ii)
         divs.append(Int(n / ii))
   divs.append(n)
   R Array(Set(divs))

F sequence(max_n)
   V n = 0
   [Int] r
   L
      n++
      V ii = 0
      I n > max_n
         L.break
      L
         ii++
         I divisors(ii).len == n
            r.append(ii)
            L.break
   R r

L(item) sequence(15)
   print(item)


with javascript_semantics
function comb(sequence pool, integer needed, sequence res={}, integer done=0, sequence chosen={})
    if needed=0 then    -- got a full set
        sequence {a,b,c} = chosen
        if not find_any({3,5,6},flatten(sq_or_bits(sq_or_bits(a,b),c))) then
            res = append(res,chosen)
        end if
    elsif done+needed<=length(pool) then
        -- get all combinations with and without the next item:
        done += 1
        res = comb(pool,needed-1,res,done,append(deep_copy(chosen),pool[done]))
        res = comb(pool,needed,res,done,chosen)
    end if
    return res
end function

constant m124 = {1,2,4}

function card(integer n)
--returns the nth card (n is 1..81, res is length 4 of 1/2/4)
    n -= 1
    sequence res = repeat(0,4)
    for i=1 to 4 do
        res[i] = m124[remainder(n,3)+1]
        n = floor(n/3)
    end for
    return res
end function

constant colours = {"red", "green", 0, "purple"},
         symbols = {"oval", "squiggle", 0, "diamond"},
         numbers = {"one", "two", 0, "three"},
         shades  = {"solid", "open", 0, "striped"}

procedure print_cards(sequence hand, sequence cards)
    for i=1 to length(cards) do
        integer {c,m,n,g} = cards[i],
                id = find(cards[i],hand)
        printf(1,"%3d: %-7s %-9s %-6s %s\n",{id,colours[c],symbols[m],numbers[n],shades[g]})
    end for
    printf(1,"\n")
end procedure

procedure play(integer cards=9, integer sets=4)
    integer deals = 1
    while 1 do
        sequence deck = shuffle(tagset(81))
        sequence hand = deck[1..cards]
        for i=1 to length(hand) do
            hand[i] = card(hand[i])
        end for
        sequence res = comb(hand,3)
        if length(res)=sets then
            printf(1,"dealt %d cards (%d deals)\n",{cards,deals})
            print_cards(hand,hand)
            printf(1,"with %d sets\n",{sets})
            for i=1 to sets do
                print_cards(hand,res[i])
            end for
            exit
        end if
        deals += 1
    end while
end procedure
play()
--play(12,6)
--play(9,6)


CARD FUNC CountDivisors(CARD a)
  CARD i,count

  i=1 count=0
  WHILE i*i<=a
  DO
    IF a MOD i=0 THEN
      IF i=a/i THEN
        count==+1
      ELSE
        count==+2
      FI
    FI
    i==+1
  OD
RETURN (count)

PROC Main()
  CARD a
  BYTE i

  a=1
  FOR i=1 TO 15
  DO
    WHILE CountDivisors(a)#i
    DO
      a==+1
    OD
    IF i>1 THEN
      Print(", ")
    FI
    PrintC(a)
  OD
RETURN


with Ada.Text_IO;

procedure Show_Sequence is

   function Count_Divisors (N : in Natural) return Natural is
      Count : Natural := 0;
      I     : Natural;
   begin
      I := 1;
      while I**2 <= N loop
         if N mod I = 0 then
            if I = N / I then
               Count := Count + 1;
            else
               Count := Count + 2;
            end if;
         end if;
         I := I + 1;
      end loop;

      return Count;
   end Count_Divisors;

   procedure Show (Max : in Natural) is
      use Ada.Text_IO;
      N : Natural := 1;
   Begin
      Put_Line ("The first" & Max'Image & "terms of the sequence are:");
      for Divisors in 1 .. Max loop
         while Count_Divisors (N) /= Divisors loop
            N := N + 1;
         end loop;
         Put (N'Image);
      end loop;
      New_Line;
   end Show;

begin
   Show (15);
end Show_Sequence;


BEGIN

    PROC count divisors = ( INT n )INT:
         BEGIN
            INT i2, count := 0;
            FOR i WHILE ( i2 := i * i ) < n DO
                IF n MOD i = 0 THEN count +:= 2 FI
            OD;
            IF i2 = n THEN count + 1 ELSE count FI
         END # count divisors # ;

    INT max = 15;

    print( ( "The first ", whole( max, 0 ), " terms of the sequence are:" ) );
    INT next := 1;
    FOR i WHILE next <= max DO
        IF next = count divisors( i ) THEN
            print( ( " ", whole( i, 0 ) ) );
            next +:= 1
        FI
    OD

END


USING: arrays kernel sequences sets ;

: comb ( x x -- x )
    over empty? [ nip 1array ] [
        dup pick first intersects?
        [ [ unclip ] dip union comb ]
        [ [ 1 cut ] dip comb append ] if
    ] if ;

: consolidate ( x -- x ) { } [ comb ] reduce ;


package main

import "fmt"

type set map[string]bool

var testCase = []set{
    set{"H": true, "I": true, "K": true},
    set{"A": true, "B": true},
    set{"C": true, "D": true},
    set{"D": true, "B": true},
    set{"F": true, "G": true, "H": true},
}

func main() {
    fmt.Println(consolidate(testCase))
}

func consolidate(sets []set) []set {
    setlist := []set{}
    for _, s := range sets {
        if s != nil && len(s) > 0 {
            setlist = append(setlist, s)
        }
    }
    for i, s1 := range setlist {
        if len(s1) > 0 {
            for _, s2 := range setlist[i+1:] {
                if s1.disjoint(s2) {
                    continue
                }
                for e := range s1 {
                    s2[e] = true
                    delete(s1, e)
                }
                s1 = s2
            }
        }
    }
    r := []set{}
    for _, s := range setlist {
        if len(s) > 0 {
            r = append(r, s)
        }
    }
    return r
}

func (s1 set) disjoint(s2 set) bool {
    for e := range s2 {
        if s1[e] {
            return false
        }
    }
    return true
}


CARD FUNC CountDivisors(CARD a)
  CARD i,count

  i=1 count=0
  WHILE i*i<=a
  DO
    IF a MOD i=0 THEN
      IF i=a/i THEN
        count==+1
      ELSE
        count==+2
      FI
    FI
    i==+1
  OD
RETURN (count)

PROC Main()
  DEFINE MAX="15"
  CARD a,count
  BYTE i
  CARD ARRAY seq(MAX)

  FOR i=0 TO MAX-1
  DO
    seq(i)=0
  OD

  i=0 a=1
  WHILE i<MAX
  DO
    count=CountDivisors(a)
    IF count<=MAX AND seq(count-1)=0 THEN
      seq(count-1)=a
      i==+1
    FI
    a==+1
  OD

  FOR i=0 TO MAX-1
  DO
    IF i>0 THEN
      Print(", ")
    FI
    PrintC(seq(i))
  OD
RETURN


BEGIN

    PROC count divisors = ( INT n )INT:
         BEGIN
            INT count := 0;
            FOR i WHILE i*i <= n DO
                IF n MOD i = 0 THEN
                    count +:= IF i = n OVER i THEN 1 ELSE 2 FI
                FI
            OD;
            count
         END # count divisors # ;

    INT max = 15;
    [ max ]INT seq;FOR i TO max DO seq[ i ] := 0 OD;
    INT found := 0;
    FOR i WHILE found < max DO
        IF INT divisors = count divisors( i );
           divisors <= max
        THEN
            # have an i with an appropriate number of divisors                 #
            IF seq[ divisors ] = 0 THEN
                # this is the first i with that many divisors                  #
                seq[ divisors ] := i;
                found          +:= 1
            FI
        FI
    OD;
    print( ( "The first ", whole( max, 0 ), " terms of the sequence are:", newline ) );
    FOR i TO max DO
        print( ( whole( seq( i ), 0 ), " " ) )
    OD;
    print( ( newline ) )

END


import util.
import cp.

%
% Solve the task in the description.
%
go ?=>
  sets(1,Sets,SetLen,NumSets),
  print_cards(Sets),
  set_puzzle(Sets,SetLen,NumSets,X),
  print_sol(Sets,X),
  nl,
  fail, % check for other solutions
  nl.
go => true.

%
% Generate and solve a random instance with NumCards cards,
% giving exactly NumSets sets.
%
go2 =>
  _ = random2(),
  NumCards = 9, NumSets = 4, SetLen = 3,
  generate_and_solve(NumCards,NumSets,SetLen),
  fail, % prove unicity
  nl.

go3 =>
  _ = random2(),
  NumCards = 12, NumSets = 6, SetLen = 3,
  generate_and_solve(NumCards,NumSets,SetLen),
  fail, % prove unicity)
  nl.

%
% Solve a Set Puzzle.
%
set_puzzle(Cards,SetLen,NumWanted, X) =>
  Len = Cards.length,
  NumFeatures = Cards[1].length,

  X = new_list(NumWanted),
  foreach(I in 1..NumWanted)
    Y = new_array(SetLen),
    foreach(J in 1..SetLen)
      member(Y[J], 1..Len)
    end,
    % unicity and symmetry breaking of Y
    increasing2(Y),
    % ensure unicity of the selected cards in X
    if I > 1 then
      foreach(J in 1..I-1) X[J] @< Y  end
    end,
    foreach(F in 1..NumFeatures)
       Z = [Cards[Y[J],F] : J in 1..SetLen],
       (allequal(Z) ; alldiff(Z))
    end,
    X[I] = Y
  end.

% (Strictly) increasing
increasing2(List) =>
  foreach(I in 1..List.length-1)
    List[I] @< List[I+1]
  end.

% All elements must be equal
allequal(List) =>
  foreach(I in 1..List.length-1)
    List[I] = List[I+1]
  end.

% All elements must be different
alldiff(List) =>
  Len = List.length,
  foreach(I in 1..Len, J in 1..I-1)
    List[I] != List[J]
  end.

% Print a solution
print_sol(Sets,X) =>
  println("Solution:"),
  println(x=X),
  foreach(R in X)
    println([Sets[R[I]] : I in 1..3])
  end,
  nl.

% Print the cards
print_cards(Cards) =>
  println("Cards:"),
  foreach({Card,I} in zip(Cards,1..Cards.len))
     println([I,Card])
  end,
  nl.

%
% Generate a problem instance with NumSets sets (a unique solution).
%
% Note: not all random combinations of cards give a unique solution so
%       it might generate a number of deals.
%
generate_instance(NumCards,NumSets,SetLen, Cards) =>
  println([numCards=NumCards,numWantedSets=NumSets,setLen=SetLen]),
  Found = false,
  % Check that this instance has a unique solution.
  while(Found = false)
    if Cards = random_deal(NumCards),
      count_all(set_puzzle(Cards,SetLen,NumSets,_X)) = 1
    then
      Found := true
    end
  end.

%
% Generate a random problem instance of N cards.
%
random_deal(N) = Deal.sort() =>
  all_combinations(Combinations),
  Deal = [],
  foreach(_I in 1..N)
    Len = Combinations.len,
    Rand = random(1,Len),
    Comb = Combinations[Rand],
    Deal := Deal ++ [Comb],
    Combinations := delete_all(Combinations, Comb)
  end.

%
% Generate a random instance and solve it.
%
generate_and_solve(NumCards,NumSets,SetLen) =>
  generate_instance(NumCards,NumSets,SetLen, Cards),
  print_cards(Cards),
  set_puzzle(Cards,SetLen,NumSets,X), % solve it
  print_sol(Cards,X),
  nl.

%
% All the 81 possible combinations (cards)
%
table
all_combinations(All) =>
   Colors = [red, green, purple],
   Symbols = [oval, squiggle, diamond],
   Numbers = [one, two, three],
   Shadings = [solid, open, striped],
   All = findall([Color,Symbol,Number,Shading],
                  (member(Color,Colors),
                   member(Symbol,Symbols),
                   member(Number,Numbers),
                   member(Shading,Shadings))).

%
% From the task description.
%
% Solution: [[1,6,9],[2,3,4],[2,6,8],[5,6,7]]
%
sets(1,Sets,SetLen,Wanted) =>
  Sets =
  [
    [green, one, oval, striped], % 1
    [green, one, diamond, open], % 2
    [green, one, diamond, striped], % 3
    [green, one, diamond, solid], % 4
    [purple, one, diamond, open], % 5
    [purple, two, squiggle, open], % 6
    [purple, three, oval, open], % 7
    [red, three, oval, open], % 8
    [red, three, diamond, solid] % 9
 ],
 SetLen = 3,
 Wanted = 4.


do_it(N) :-
	card_sets(N, Cards, Sets),
	!,
	format('Cards: ~n'),
	maplist(print_card, Cards),
	format('~nSets: ~n'),
	maplist(print_set, Sets).

print_card(Card) :- format('  ~p ~p ~p ~p~n', Card).
print_set(Set) :- maplist(print_card, Set), nl.

n(9,4).
n(12,6).

card_sets(N, Cards, Sets) :-
	n(N,L),
	repeat,
	random_deal(N, Cards),
	setof(Set, is_card_set(Cards, Set), Sets),
	length(Sets, L).

random_card([C,S,N,Sh]) :-
	random_member(C, [red, green, purple]),
	random_member(S, [oval, squiggle, diamond]),
	random_member(N, [one, two, three]),
	random_member(Sh, [solid, open, striped]).

random_deal(N, Cards) :-
	length(Cards, N),
	maplist(random_card, Cards).

is_card_set(Cards, Result) :-
	select(C1, Cards, Rest),
	select(C2, Rest, Rest2),
	select(C3, Rest2, _),

	match(C1, C2, C3),
	sort([C1,C2,C3], Result).

match([],[],[]).
match([A|T1],[A|T2],[A|T3]) :-
	match(T1,T2,T3).
match([A|T1],[B|T2],[C|T3]) :-
	dif(A,B), dif(B,C), dif(A,C),
	match(T1,T2,T3).


begin
    integer max, next, i;

    integer procedure countDivisors ( Integer value n ) ;
    begin
        integer count, i, i2;
        count := 0;
        i     := 1;
        while  begin i2 := i * i;
                     i2 < n
        end do begin
            if n rem i = 0 then count := count + 2;
            i := i + 1
        end;
        if i2 = n then count + 1 else count
    end countDivisors ;

    max := 15;
    write( i_w := 1, s_w := 0, "The first ", max, " terms of the sequence are: " );
    i := next := 1;
    while next <= max do begin
        if next = countDivisors( i ) then begin
            writeon( i_w := 1, s_w := 0, " ", i );
            next := next +  1
        end;
        i := i + 1
    end;
    write()
end.


i: new 0
next: new 1
MAX: 15
while [next =< MAX][
    if next = size factors i [
        prints ~"|i| "
        inc 'next
    ]
    inc 'i
]
print ""


MAX := 15
next := 1, i := 1
while (next <= MAX)
	if (next = countDivisors(A_Index))
		Res.= A_Index ", ", next++
MsgBox % "The first " MAX " terms of the sequence are:`n" Trim(res, ", ")
return

countDivisors(n){
	while (A_Index**2 <= n)
		if !Mod(n, A_Index)
			count += (A_Index = n/A_Index) ? 1 : 2
	return count
}


import Data.List (intersperse, intercalate)
import qualified Data.Set as S

consolidate
  :: Ord a
  => [S.Set a] -> [S.Set a]
consolidate = foldr comb []
  where
    comb s_ [] = [s_]
    comb s_ (s:ss)
      | S.null (s `S.intersection` s_) = s : comb s_ ss
      | otherwise = comb (s `S.union` s_) ss

-- TESTS -------------------------------------------------
main :: IO ()
main =
  (putStrLn . unlines)
    ((intercalate ", and " . fmap showSet . consolidate) . fmap S.fromList <$>
     [ ["ab", "cd"]
     , ["ab", "bd"]
     , ["ab", "cd", "db"]
     , ["hik", "ab", "cd", "db", "fgh"]
     ])

showSet :: S.Set Char -> String
showSet = flip intercalate ["{", "}"] . intersperse ',' . S.elems


consolidate=:4 :0/
  b=. y 1&[email protected]&> x
  (1,-.b)#(~.;x,b#y);y
)


firstNumWithDivisors: function [n][
    i: 0
    while ø [
        if n = size factors i -> return i
        i: i+1
    ]
]

print map 1..15 => firstNumWithDivisors


max := 15
seq := [], n := 0
while (n < max)
	if ((k := countDivisors(A_Index)) <= max) && !seq[k]
		seq[k] := A_Index, n++
for i, v in seq
	res .= v ", "
MsgBox % "The first " . max . " terms of the sequence are:`n" Trim(res, ", ")
return

countDivisors(n){
	while (A_Index**2 <= n)
		if !Mod(n, A_Index)
			count += A_Index = n/A_Index ? 1 : 2
	return count
}


# syntax: GAWK -f SEQUENCE_SMALLEST_NUMBER_WITH_EXACTLY_N_DIVISORS.AWK
# converted from Kotlin
BEGIN {
    limit = 15
    printf("first %d terms:",limit)
    i = 1
    n = 0
    while (n < limit) {
      k = count_divisors(i)
      if (k <= limit && seq[k-1]+0 == 0) {
        seq[k-1] = i
        n++
      }
      i++
    }
    for (i=0; i<limit; i++) {
      printf(" %d",seq[i])
    }
    printf("\n")
    exit(0)
}
function count_divisors(n,  count,i) {
    for (i=1; i*i<=n; i++) {
      if (n % i == 0) {
        count += (i == n / i) ? 1 : 2
      }
    }
    return(count)
}


#!/usr/bin/python

from itertools import product, combinations
from random import sample

## Major constants
features = [ 'green purple red'.split(),
             'one two three'.split(),
             'oval diamond squiggle'.split(),
             'open striped solid'.split() ]

deck = list(product(list(range(3)), repeat=4))

dealt = 9

## Functions
def printcard(card):
    print(' '.join('%8s' % f[i] for f,i in zip(features, card)))

def getdeal(dealt=dealt):
    deal = sample(deck, dealt)
    return deal

def getsets(deal):
    good_feature_count = set([1, 3])
    sets = [ comb for comb in combinations(deal, 3)
             if all( [(len(set(feature)) in good_feature_count)
                     for feature in zip(*comb)]
                   ) ]
    return sets

def printit(deal, sets):
    print('Dealt %i cards:' % len(deal))
    for card in deal: printcard(card)
    print('\nFound %i sets:' % len(sets))
    for s in sets:
        for card in s: printcard(card)
        print('')

if __name__ == '__main__':
    while True:
        deal = getdeal()
        sets = getsets(deal)
        if len(sets) == dealt / 2:
           break
    printit(deal, sets)


# syntax: GAWK -f SEQUENCE_SMALLEST_NUMBER_GREATER_THAN_PREVIOUS_TERM_WITH_EXACTLY_N_DIVISORS.AWK
# converted from Kotlin
BEGIN {
    limit = 15
    printf("first %d terms:",limit)
    n = 1
    while (n <= limit) {
      if (n == count_divisors(++i)) {
        printf(" %d",i)
        n++
      }
    }
    printf("\n")
    exit(0)
}
function count_divisors(n,  count,i) {
    for (i=1; i*i<=n; i++) {
      if (n % i == 0) {
        count += (i == n / i) ? 1 : 2
      }
    }
    return(count)
}


#include <stdio.h>

#define MAX 15

int count_divisors(int n) {
    int i, count = 0;
    for (i = 1; i * i <= n; ++i) {
        if (!(n % i)) {
            if (i == n / i)
                count++;
            else
                count += 2;
        }
    }
    return count;
}

int main() {
    int i, next = 1;
    printf("The first %d terms of the sequence are:\n", MAX);
    for (i = 1; next <= MAX; ++i) {
        if (next == count_divisors(i)) {
            printf("%d ", i);
            next++;
        }
    }
    printf("\n");
    return 0;
}


import java.util.*;

public class SetConsolidation {

    public static void main(String[] args) {
        List<Set<Character>> h1 = hashSetList("AB", "CD");
        System.out.println(consolidate(h1));

        List<Set<Character>> h2 = hashSetList("AB", "BD");
        System.out.println(consolidateR(h2));

        List<Set<Character>> h3 = hashSetList("AB", "CD", "DB");
        System.out.println(consolidate(h3));

        List<Set<Character>> h4 = hashSetList("HIK", "AB", "CD", "DB", "FGH");
        System.out.println(consolidateR(h4));
    }

    // iterative
    private static <E> List<Set<E>>
                consolidate(Collection<? extends Set<E>> sets) {
	List<Set<E>> r = new ArrayList<>();
	for (Set<E> s : sets) {
	    List<Set<E>> new_r = new ArrayList<>();
	    new_r.add(s);
	    for (Set<E> x : r) {
		if (!Collections.disjoint(s, x)) {
		    s.addAll(x);
		} else {
		    new_r.add(x);
		}
	    }
	    r = new_r;
	}
	return r;
    }

    // recursive
    private static <E> List<Set<E>> consolidateR(List<Set<E>> sets) {
        if (sets.size() < 2)
            return sets;
        List<Set<E>> r = new ArrayList<>();
        r.add(sets.get(0));
        for (Set<E> x : consolidateR(sets.subList(1, sets.size()))) {
            if (!Collections.disjoint(r.get(0), x)) {
                r.get(0).addAll(x);
            } else {
                r.add(x);
            }
        }
        return r;
    }

    private static List<Set<Character>> hashSetList(String... set) {
        List<Set<Character>> r = new ArrayList<>();
        for (int i = 0; i < set.length; i++) {
            r.add(new HashSet<Character>());
            for (int j = 0; j < set[i].length(); j++)
                r.get(i).add(set[i].charAt(j));
        }
        return r;
    }
}


get "libhdr"

manifest $( LENGTH = 15 $)

let divisors(n) = valof
$(  let count = 0 and i = 1
    while i*i <= n
    $(  if n rem i = 0 then
            count := count + (i = n/i -> 1, 2)
        i := i + 1
    $)
    resultis count
$)

let sequence(n, seq) be
$(  let found = 0 and i = 1
    for i=1 to n do seq!i := 0
    while found < n
    $(  let divs = divisors(i)
        if divs <= n & seq!divs = 0
        $(  found := found + 1
            seq!divs := i
        $)
        i := i + 1
    $)
$)

let start() be
$(  let seq = vec LENGTH
    sequence(LENGTH, seq)

    for i=1 to LENGTH do writef("%N ", seq!i)
    wrch('*N')
$)


#include <stdio.h>

#define MAX 15

int count_divisors(int n) {
    int i, count = 0;
    for (i = 1; i * i <= n; ++i) {
        if (!(n % i)) {
            if (i == n / i)
                count++;
            else
                count += 2;
        }
    }
    return count;
}

int main() {
    int i, k, n, seq[MAX];
    for (i = 0; i < MAX; ++i) seq[i] = 0;
    printf("The first %d terms of the sequence are:\n", MAX);
    for (i = 1, n = 0; n <  MAX; ++i) {
        k = count_divisors(i);
        if (k <= MAX && seq[k - 1] == 0) {
            seq[k - 1] = i;
            ++n;
        }
    }
    for (i = 0; i < MAX; ++i) printf("%d ", seq[i]);
    printf("\n");
    return 0;
}


#lang racket

(struct card [bits name])

(define cards
  (for/list ([C '(red   green    purple )] [Ci '(#o0001 #o0002 #o0004)]
             #:when #t
             [S '(oval  squiggle diamond)] [Si '(#o0010 #o0020 #o0040)]
             #:when #t
             [N '(one   two      three  )] [Ni '(#o0100 #o0200 #o0400)]
             #:when #t
             [D '(solid open     striped)] [Di '(#o1000 #o2000 #o4000)])
    (card (bitwise-ior Ci Si Ni Di) (format "~a, ~a, ~a, ~a" C S N D))))

(define (nsubsets l n)
  (cond [(zero? n) '(())] [(null? l) '()]
        [else (append (for/list ([l2 (nsubsets (cdr l) (- n 1))])
                        (cons (car l) l2))
                      (nsubsets (cdr l) n))]))
(define (set? cards)
  (regexp-match? #rx"^[1247]*$"
                 (number->string (apply bitwise-ior (map card-bits cards)) 8)))

(define (deal C S)
  (define hand  (take (shuffle cards) C))
  (define 3sets (filter set? (nsubsets hand 3)))
  (cond [(not (= S (length 3sets))) (deal C S)]
        [else (printf "Dealt ~a cards:\n" C)
              (for ([c hand]) (printf "  ~a\n" (card-name c)))
              (printf "\nContaining ~a sets:\n" S)
              (for ([set 3sets])
                (for ([c set]) (printf "  ~a\n" (card-name c)))
                (newline))]))

(deal 9 4)
(deal 12 6)


enum Color (red => 0o1000, green =>  0o2000, purple => 0o4000);
enum Count (one =>  0o100, two =>     0o200, three =>   0o400);
enum Shape (oval =>  0o10, squiggle => 0o20, diamond =>  0o40);
enum Style (solid =>  0o1, open =>      0o2, striped =>   0o4);

my @deck = Color.enums X Count.enums X Shape.enums X Style.enums;

sub MAIN($DRAW = 9, $GOAL = $DRAW div 2) {
    sub show-cards(@c) { { printf "%9s%7s%10s%9s\n", @c[$_;*]».key } for ^@c }

    my @combinations = [^$DRAW].combinations(3);

    my @draw;
    repeat until (my @sets) == $GOAL {
        @draw = @deck.pick($DRAW);
        my @bits = @draw.map: { [+] @^enums».value }
        @sets = gather for @combinations -> @c {
            take @draw[@c].item when /^ <[1247]>+ $/ given ( [+|] @bits[@c] ).base(8);
        }
    }

    say "Drew $DRAW cards:";
    show-cards @draw;
    for @sets.kv -> $i, @cards {
        say "\nSet {$i+1}:";
        show-cards @cards;
    }
}


#include <iostream>

#define MAX 15

using namespace std;

int count_divisors(int n) {
    int count = 0;
    for (int i = 1; i * i <= n; ++i) {
        if (!(n % i)) {
            if (i == n / i)
                count++;
            else
                count += 2;
        }
    }
    return count;
}

int main() {
    cout << "The first " << MAX << " terms of the sequence are:" << endl;
    for (int i = 1, next = 1; next <= MAX; ++i) {
        if (next == count_divisors(i)) {
            cout << i << " ";
            next++;
        }
    }
    cout << endl;
    return 0;
}


func countDivisors(n) {
    var count = 0
    var i = 1
    while i * i <= n {
        if n % i == 0 {
            if i == n / i {
                count += 1
            } else {
                count += 2
            }
        }
        i += 1
    }
    return count
}

let max = 15
print("The first \(max) terms of the sequence are:")
var (i, next) = (1, 1)
while next <= max {
    if next == countDivisors(i) {
        print("\(i) ", terminator: "")
        next += 1
    }
    i += 1
}

print()


// Nigel Galloway: November 19th., 2017
let fN g=[1..(float>>sqrt>>int)g]|>List.fold(fun Σ n->if g%n>0 then Σ else if g/n=n then Σ+1 else Σ+2) 0
let A069654=let rec fG n g=seq{match g-fN n with 0->yield n; yield! fG(n+1)(g+1) |_->yield! fG(n+1)g} in fG 1 1

A069654 |> Seq.take 28|>Seq.iter(printf "%d "); printfn ""


(() => {
    'use strict';

    // consolidated :: Ord a => [Set a] -> [Set a]
    const consolidated = xs => {
        const go = (s, xs) =>
            0 !== xs.length ? (() => {
                const h = xs[0];
                return 0 === intersection(h, s).size ? (
                    [h].concat(go(s, tail(xs)))
                ) : go(union(h, s), tail(xs));
            })() : [s];
        return foldr(go, [], xs);
    };

    // TESTS ----------------------------------------------
    const main = () =>
        map(xs => intercalate(
                ', and ',
                map(showSet, consolidated(xs))
            ),
            map(x => map(
                    s => new Set(chars(s)),
                    x
                ),
                [
                    ['ab', 'cd'],
                    ['ab', 'bd'],
                    ['ab', 'cd', 'db'],
                    ['hik', 'ab', 'cd', 'db', 'fgh']
                ]
            )
        ).join('\n');

    // GENERIC FUNCTIONS ----------------------------------

    // chars :: String -> [Char]
    const chars = s => s.split('');

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        0 < xs.length ? (() => {
            const unit = 'string' !== typeof xs[0] ? (
                []
            ) : '';
            return unit.concat.apply(unit, xs);
        })() : [];

    // elems :: Dict -> [a]
    // elems :: Set -> [a]
    const elems = x =>
        'Set' !== x.constructor.name ? (
            Object.values(x)
        ) : Array.from(x.values());

    // flip :: (a -> b -> c) -> b -> a -> c
    const flip = f =>
        1 < f.length ? (
            (a, b) => f(b, a)
        ) : (x => y => f(y)(x));

    // Note that that the Haskell signature of foldr differs from that of
    // foldl - the positions of accumulator and current value are reversed

    // foldr :: (a -> b -> b) -> b -> [a] -> b
    const foldr = (f, a, xs) => xs.reduceRight(flip(f), a);

    // intercalate :: [a] -> [[a]] -> [a]
    // intercalate :: String -> [String] -> String
    const intercalate = (sep, xs) =>
        0 < xs.length && 'string' === typeof sep &&
        'string' === typeof xs[0] ? (
            xs.join(sep)
        ) : concat(intersperse(sep, xs));

    // intersection :: Ord a => Set a -> Set a -> Set a
    const intersection = (s, s1) =>
        new Set([...s].filter(x => s1.has(x)));

    // intersperse :: a -> [a] -> [a]
    // intersperse :: Char -> String -> String
    const intersperse = (sep, xs) => {
        const bln = 'string' === typeof xs;
        return xs.length > 1 ? (
            (bln ? concat : x => x)(
                (bln ? (
                    xs.split('')
                ) : xs)
                .slice(1)
                .reduce((a, x) => a.concat([sep, x]), [xs[0]])
            )) : xs;
    };

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // showSet :: Set -> String
    const showSet = s =>
        intercalate(elems(s), ['{', '}']);

    // sort :: Ord a => [a] -> [a]
    const sort = xs => xs.slice()
        .sort((a, b) => a < b ? -1 : (a > b ? 1 : 0));

    // tail :: [a] -> [a]
    const tail = xs => 0 < xs.length ? xs.slice(1) : [];

    // union :: Ord a => Set a -> Set a -> Set a
    const union = (s, s1) =>
        Array.from(s1.values())
        .reduce(
            (a, x) => (a.add(x), a),
            new Set(s)
        );

    // MAIN ---
    return main();
})();


#include <iostream>

#define MAX 15

using namespace std;

int count_divisors(int n) {
    int count = 0;
    for (int i = 1; i * i <= n; ++i) {
        if (!(n % i)) {
            if (i == n / i)
                count++;
            else
                count += 2;
        }
    }
    return count;
}

int main() {
    int i, k, n, seq[MAX];
    for (i = 0; i < MAX; ++i) seq[i] = 0;
    cout << "The first " << MAX << " terms of the sequence are:" << endl;
    for (i = 1, n = 0; n <  MAX; ++i) {
        k = count_divisors(i);
        if (k <= MAX && seq[k - 1] == 0) {
            seq[k - 1] = i;
            ++n;
        }
    }
    for (i = 0; i < MAX; ++i) cout << seq[i] << " ";
    cout << endl;
    return 0;
}


include "cowgol.coh";

const AMOUNT := 15;
typedef I is uint16;

sub divisors(n: I): (count: I) is
    var i: I := 1;
    count := 0;

    while i*i <= n loop
        if n%i == 0 then
            if n/i == i then
                count := count + 1;
            else
                count := count + 2;
            end if;
        end if;
        i := i + 1;
    end loop;
end sub;

var seq: I[AMOUNT+1];
MemZero(&seq as [uint8], @bytesof seq);

var found: I := 0;
var i: I := 1;

while found < AMOUNT loop
    var divs := divisors(i) as @indexof seq;
    if divs <= AMOUNT and seq[divs] == 0 then
        found := found + 1;
        seq[divs] := i;
    end if;
    i := i + 1;
end loop;

var j: @indexof seq := 1;
while j <= AMOUNT loop
    print_i16(seq[j]);
    print_char(' ');
    j := j + 1;
end loop;
print_nl();


// Find Antı-Primes plus. Nigel Galloway: April 9th., 2019
// Increasing the value 14 will increase the number of anti-primes plus found
let fI=primes|>Seq.take 14|>Seq.map bigint|>List.ofSeq
let N=Seq.reduce(*) fI
let fG g=Seq.unfold(fun ((n,i,e) as z)->Some(z,(n+1,i+1,(e*g)))) (1,2,g)
let fE n i=n|>Seq.collect(fun(n,e,g)->Seq.map(fun(a,c,b)->(a,c*e,g*b)) (i|>Seq.takeWhile(fun(g,_,_)->g<=n))|> Seq.takeWhile(fun(_,_,n)->n<N))
let fL=let mutable g=0 in (fun n->g<-g+1; n=g)
let n=Seq.concat(Seq.scan(fun n g->fE n (fG g)) (seq[(2147483647,1,1I)]) fI)|>List.ofSeq|>List.groupBy(fun(_,n,_)->n)|>List.sortBy(fun(n,_)->n)|>List.takeWhile(fun(n,_)->fL n)
for n,g in n do printfn "%d->%A" n (g|>List.map(fun(_,_,n)->n)|>List.min)


/*REXX program  finds and displays  "sets" (solutions)  for the   SET  puzzle   (game). */
parse arg game seed .                            /*get optional # cards to deal and seed*/
if game=='' | game==","  then game=  9           /*Not specified?  Then use the default.*/
if seed=='' | seed==","  then seed= 77           /* "      "         "   "   "      "   */
call aGame 0                                     /*with tell=0:    suppress the output. */
call aGame 1                                     /*with tell=1:    display   "     "    */
exit sets                                        /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
aGame: parse arg tell;         good= game % 2    /*enable/disable the showing of output.*/
                                                 /* [↑]  the GOOD var is the right #sets*/
                 do seed=seed  until good==sets  /*generate deals until good  # of sets.*/
                 call random ,,seed              /*repeatability for the RANDOM invokes.*/
                 call genFeatures                /*generate various card game features. */
                 call genDeck                    /*    "    a deck  (with  81  "cards").*/
                 call dealer   game              /*deal a number of cards for the game. */
                 call findSets game%2            /*find # of sets from the dealt cards. */
                 end   /*until*/                 /* [↓]   when leaving, SETS is right #.*/
       return                                    /*return to invoker of this subroutine.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
dealer: call sey  'dealing'  game  "cards:", , . /*shuffle and deal the cards.          */

           do cards=1  until cards==game         /*keep dealing until finished.         */
           _= random(1, words(##) )              /*pick   a card.                       */
           ##= delword(##, _, 1)                 /*delete "   "                         */
           @.cards= deck._                       /*add the card to the tableau.         */
           call sey right('card' cards, 30) " " @.cards    /*display a card to terminal.*/

               do j=1  for words(@.cards)        /* [↓]  define cells for cards.        */
               @.cards.j= word(@.cards, j)       /*define  a  cell for  a card.         */
               end   /*j*/
           end       /*cards*/

        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
defFeatures: parse arg what,v;   _= words(v)     /*obtain what is to be defined.        */

             if _\==values  then do;  call sey 'error,'  what  "features ¬=" values, ., .
                                      exit -1
                                 end             /* [↑]  check for typos and/or errors. */

               do k=1  for words(values)         /*define all the possible values.      */
               call value what'.'k,  word(values, k)         /*define  a  card feature. */
               end   /*k*/

             return
/*──────────────────────────────────────────────────────────────────────────────────────*/
findSets: parse arg n;   call genPoss            /*N:  the number of sets to be found.  */
          call sey                               /*find any sets that were generated [↑]*/

              do         j=1  for p              /*P:  is the number of possible sets.  */
                  do     f=1  for features
                      do g=1  for groups;     !!.j.f.g= word(!.j.f, g)
                      end   /*g*/
                  end       /*f*/

              ok= 1                              /*everything is peachy─kean (OK) so far*/

                  do g=1  for groups
                  _= !!.j.1.g                    /*build strings to hold possibilities. */
                  equ= 1                         /* [↓]  handles all the equal features.*/

                         do f=2  to features  while equ;     equ= equ  &  _==!!.j.f.g
                         end   /*f*/

                  dif= 1
                  __= !!.j.1.g                   /* [↓]  handles all  unequal  features.*/
                                      do f=2  to  features  while  \equ
                                      dif= dif &  (wordpos(!!.j.f.g, __)==0)
                                      __= __  !!.j.f.g  /*append to string for next test*/
                                      end   /*f*/

                  ok=ok & (equ | dif)            /*now, see if all are equal or unequal.*/
                  end   /*g*/

              if \ok  then iterate               /*Is this set OK?   Nope, then skip it.*/
              sets= sets + 1                     /*bump the number of the sets found.   */
              call sey  right('set'  sets":  ", 15)    !.j.1    sep   !.j.2    sep   !.j.3
              end   /*j*/

          call sey  sets   'sets found.', .
          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
genDeck: #= 0;   ##=                             /*#:  cards in deck;  ##:  shuffle aid.*/

                       do         num=1  for values;         xnum = word(numbers,  num)
                          do      col=1  for values;         xcol = word(colors,   col)
                             do   sym=1  for values;         xsym = word(symbols,  sym)
                               do sha=1  for values;         xsha = word(shadings, sha)
                               #= # + 1;  ##= ## #;
                               deck.#= xnum  xcol  xsym  xsha          /*create a card. */
                               end   /*sha*/
                            end      /*num*/
                          end        /*sym*/
                       end           /*col*/

         return                                  /*#:  the number of cards in the deck. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
genFeatures: features= 3;  groups= 4;  values= 3 /*define # features, groups, values.   */
             numbers = 'one two three'           ;    call defFeatures 'number',  numbers
             colors  = 'red green purple'        ;    call defFeatures 'color',   colors
             symbols = 'oval squiggle diamond'   ;    call defFeatures 'symbol',  symbols
             shadings= 'solid open striped'      ;    call defFeatures 'shading', shadings
             return
/*──────────────────────────────────────────────────────────────────────────────────────*/
genPoss: p= 0;   sets= 0;   sep=' ───── '        /*define some REXX variables.          */
         !.=
                    do       i=1    for game     /* [↓]  the  IFs  eliminate duplicates.*/
                       do    j=i+1  to  game
                          do k=j+1  to  game
                          p= p + 1;          !.p.1= @.i;       !.p.2= @.j;      !.p.3= @.k
                          end   /*k*/
                       end      /*j*/
                    end         /*i*/            /* [↑]  generate the permutation list. */

         return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sey:  if \tell  then  return                     /*¬ tell?    Then suppress the output. */
      if arg(2)==.  then say;      say arg(1);      if arg(3)==.  then say;         return


USING: io kernel math math.primes.factors prettyprint sequences ;

: next ( n num -- n' num' )
    [ 2dup divisors length = ] [ 1 + ] do until [ 1 + ] dip ;

: A069654 ( n -- seq )
    [ 2 1 ] dip [ [ next ] keep ] replicate 2nip ;

"The first 15 terms of the sequence are:" print 15 A069654 .


#define UPTO 15

function divisors(byval n as ulongint) as uinteger
    'find the number of divisors of an integer
    dim as integer r = 2, i
    for i = 2 to n\2
        if n mod i = 0 then r += 1
    next i
    return r
end function

dim as ulongint i = 2
dim as integer n, nfound = 1

print 1;" ";    'special case

while nfound < UPTO
    n = divisors(i)
    if n = nfound + 1 then
        nfound += 1
        print i;" ";
    end if
    i+=1
wend
print
end


package main

import "fmt"

func countDivisors(n int) int {
    count := 0
    for i := 1; i*i <= n; i++ {
        if n%i == 0 {
            if i == n/i {
                count++
            } else {
                count += 2
            }
        }
    }
    return count
}

func main() {
    const max = 15
    fmt.Println("The first", max, "terms of the sequence are:")
    for i, next := 1, 1; next <= max; i++ {
        if next == countDivisors(i) {
            fmt.Printf("%d ", i)
            next++
        }
    }
    fmt.Println()
}


def to_set: unique;

def union(A; B): (A + B) | unique;

# boolean
def intersect(A;B):
  reduce A[] as $x (false; if . then . else (B|index($x)) end) | not | not;


function consolidate{T}(a::Array{Set{T},1})
    1 < length(a) || return a
    b = copy(a)
    c = Set{T}[]
    while 1 < length(b)
        x = shift!(b)
        cme = true
        for (i, y) in enumerate(b)
            !isempty(intersect(x, y)) || continue
            cme = false
            b[i] = union(x, y)
            break
        end
        !cme || push!(c, x)
    end
    push!(c, b[1])
    return c
end


// version 1.0.6

fun<T : Comparable<T>> consolidateSets(sets: Array<Set<T>>): Set<Set<T>> {
    val size = sets.size
    val consolidated = BooleanArray(size) // all false by default
    var i = 0
    while (i < size - 1) {
        if (!consolidated[i]) {
            while (true) {
                var intersects = 0
                for (j in (i + 1) until size) {
                    if (consolidated[j]) continue
                    if (sets[i].intersect(sets[j]).isNotEmpty()) {
                        sets[i] = sets[i].union(sets[j])
                        consolidated[j] = true
                        intersects++
                    }
                }
                if (intersects == 0) break
            }
        }
        i++
    }
    return (0 until size).filter { !consolidated[it] }.map { sets[it].toSortedSet() }.toSet()
}

fun main(args: Array<String>) {
    val unconsolidatedSets = arrayOf(
        arrayOf(setOf('A', 'B'), setOf('C', 'D')),
        arrayOf(setOf('A', 'B'), setOf('B', 'D')),
        arrayOf(setOf('A', 'B'), setOf('C', 'D'), setOf('D', 'B')),
        arrayOf(setOf('H', 'I', 'K'), setOf('A', 'B'), setOf('C', 'D'), setOf('D', 'B'), setOf('F', 'G', 'H'))
    )
    for (sets in unconsolidatedSets) println(consolidateSets(sets))
}


USING: fry kernel lists lists.lazy math math.primes.factors
prettyprint sequences ;

: A005179 ( -- list )
    1 lfrom [
        1 swap '[ dup divisors length _ = ] [ 1 + ] until
    ] lmap-lazy ;

15 A005179 ltake list>array .


#define UPTO 15

function divisors(byval n as ulongint) as uinteger
    'find the number of divisors of an integer
    dim as integer r = 2, i
    for i = 2 to n\2
        if n mod i = 0 then r += 1
    next i
    return r
end function

dim as ulongint i = 2
dim as integer n, nfound = 1, sfound(UPTO) = {1}

while nfound < UPTO
    n = divisors(i)
    if n<=UPTO andalso sfound(n)=0 then
        nfound += 1
        sfound(n) = i
    end if
    i+=1
wend

print 1;" ";    'special case
for i = 2 to UPTO
    print sfound(i);" ";
next i
print
end


package main

import "fmt"

func countDivisors(n int) int {
    count := 0
    for i := 1; i*i <= n; i++ {
        if n%i == 0 {
            if i == n/i {
                count++
            } else {
                count += 2
            }
        }
    }
    return count
}

func main() {
    const max = 15
    seq := make([]int, max)
    fmt.Println("The first", max, "terms of the sequence are:")
    for i, n := 1, 0; n < max; i++ {
        if k := countDivisors(i); k <= max && seq[k-1] == 0 {
            seq[k-1] = i
            n++
        }
    }
    fmt.Println(seq)
}


COLORS   = %i(red green purple) #use [:red, :green, :purple] in Ruby < 2.0
SYMBOLS  = %i(oval squiggle diamond)
NUMBERS  = %i(one two three)
SHADINGS = %i(solid open striped)
DECK = COLORS.product(SYMBOLS, NUMBERS, SHADINGS)

def get_all_sets(hand)
  hand.combination(3).select do |candidate|
    grouped_features = candidate.flatten.group_by{|f| f}
    grouped_features.values.none?{|v| v.size == 2}
  end
end

def get_puzzle_and_answer(hand_size, num_sets_goal)
  begin
    hand = DECK.sample(hand_size)
    sets = get_all_sets(hand)
  end until sets.size == num_sets_goal
  [hand, sets]
end

def print_cards(cards)
  puts cards.map{|card| "  %-8s" * 4 % card}
  puts
end

def set_puzzle(deal, goal=deal/2)
  puzzle, sets = get_puzzle_and_answer(deal, goal)
  puts "Dealt #{puzzle.size} cards:"
  print_cards(puzzle)
  puts "Containing #{sets.size} sets:"
  sets.each{|set| print_cards(set)}
end

set_puzzle(9)
set_puzzle(12)


use itertools::Itertools;
use rand::Rng;

const DECK_SIZE: usize = 81;
const NUM_ATTRIBUTES: usize = 4;
const ATTRIBUTES: [&[&str]; NUM_ATTRIBUTES] = [
    &["red", "green", "purple"],
    &["one", "two", "three"],
    &["oval", "squiggle", "diamond"],
    &["solid", "open", "striped"],
];

fn get_random_card_indexes(num_of_cards: usize) -> Vec<usize> {
    let mut selected_cards: Vec<usize> = Vec::with_capacity(num_of_cards);
    let mut rng = rand::thread_rng();
    loop {
        let idx = rng.gen_range(0..DECK_SIZE);
        if !selected_cards.contains(&idx) {
            selected_cards.push(idx);
        }
        if selected_cards.len() == num_of_cards {
            break;
        }
    }

    selected_cards
}

fn run_game(num_of_cards: usize, minimum_number_of_sets: usize) {
    println!(
        "\nGAME: # of cards: {} # of sets: {}",
        num_of_cards, minimum_number_of_sets
    );

    // generate the deck with 81 unique cards
    let deck = (0..NUM_ATTRIBUTES)
        .map(|_| (0..=2_usize))
        .multi_cartesian_product()
        .collect::<Vec<_>>();

    // closure to return true if the three attributes are the same, or each of them is different
    let valid_attribute =
        |a: usize, b: usize, c: usize| -> bool { a == b && b == c || (a != b && b != c && a != c) };

    // closure to test all attributes, each of them should be true to have a valid set
    let valid_set = |t: &Vec<&Vec<usize>>| -> bool {
        for attr in 0..NUM_ATTRIBUTES {
            if !valid_attribute(t[0][attr], t[1][attr], t[2][attr]) {
                return false;
            }
        }
        true
    };

    loop {
        // select the required # of cards from the deck randomly
        let selected_cards = get_random_card_indexes(num_of_cards)
            .iter()
            .map(|idx| deck[*idx].clone())
            .collect::<Vec<_>>();

        // generate all combinations, and filter/keep only which are valid sets
        let valid_sets = selected_cards
            .iter()
            .combinations(3)
            .filter(|triplet| valid_set(triplet))
            .collect::<Vec<_>>();

        // if the # of the sets is matching the requirement, print it and finish
        if valid_sets.len() == minimum_number_of_sets {
            print!("SELECTED CARDS:");
            for card in &selected_cards {
                print!("\ncard: ");
                for attr in 0..NUM_ATTRIBUTES {
                    print!("{}, ", ATTRIBUTES[attr][card[attr]]);
                }
            }

            print!("\nSets:");
            for triplet in &valid_sets {
                print!("\nSet: ");
                for card in triplet {
                    for attr in 0..NUM_ATTRIBUTES {
                        print!("{}, ", ATTRIBUTES[attr][card[attr]]);
                    }
                    print!(" | ");
                }
            }

            break;
        }

        //otherwise generate again
    }
}
fn main() {
    run_game(9, 4);
    run_game(12, 6);
}


import Text.Printf (printf)

sequence_A069654 :: [(Int,Int)]
sequence_A069654 = go 1 $ (,) <*> countDivisors <$> [1..]
 where go t ((n,c):xs) | c == t    = (t,n):go (succ t) xs
                       | otherwise = go t xs
       countDivisors n = foldr f 0 [1..floor $ sqrt $ realToFrac n]
        where f x r | n `mod` x == 0 = if n `div` x == x then r+1 else r+2
                    | otherwise      = r

main :: IO ()
main = mapM_ (uncurry $ printf "a(%2d)=%5d\n") $ take 15 sequence_A069654


sieve=: 3 :0
 NB. sieve y  returns a vector of y boxes.
 NB. In each box is an array of 2 columns.
 NB. The first column is the factor tally
 NB. and the second column is a number with
 NB. that many factors.
 NB. Rather than factoring, the algorithm
 NB. counts prime seive cell hits.
 NB. The boxes are not ordered by factor tally.
 range=. <. + [email protected]:|@:-
 tally=. y#0
 for_i.#\tally do.
  j=. }:^:(y<:{:)i * 1 range >: <. y % i
  tally=. j >:@:{`[`]} tally
 end.
 (</.~ {."1) (,. [email protected]:#)tally
)


public class AntiPrimesPlus {

    static int count_divisors(int n) {
        int count = 0;
        for (int i = 1; i * i <= n; ++i) {
            if (n % i == 0) {
                if (i == n / i)
                    count++;
                else
                    count += 2;
            }
        }
        return count;
    }

    public static void main(String[] args) {
        final int max = 15;
        System.out.printf("The first %d terms of the sequence are:\n", max);
        for (int i = 1, next = 1; next <= max; ++i) {
            if (next == count_divisors(i)) {
                System.out.printf("%d ", i);
                next++;
            }
        }
        System.out.println();
    }
}


-- SUPPORT:
function T(t) return setmetatable(t, {__index=table}) end
function S(t) local s=T{} for k,v in ipairs(t) do s[v]=v end return s end
table.each = function(t,f,...) for _,v in pairs(t) do f(v,...) end end
table.copy = function(t) local s=T{} for k,v in pairs(t) do s[k]=v end return s end
table.keys = function(t) local s=T{} for k,_ in pairs(t) do s[#s+1]=k end return s end
table.intersects = function(t1,t2) for k,_ in pairs(t1) do if t2[k] then return true end end return false end
table.union = function(t1,t2) local s=t1:copy() for k,_ in pairs(t2) do s[k]=k end return s end
table.dump = function(t) print('{ '..table.concat(t, ', ')..' }') end

-- TASK:
table.consolidate = function(t)
  for a = #t, 1, -1 do
    local seta = t[a]
    for b = #t, a+1, -1 do
      local setb = t[b]
      if setb and seta:intersects(setb) then
        t[a], t[b] = seta:union(setb), nil
      end
    end
  end
  return t
end

-- TESTING:
examples = {
  T{ S{"A","B"}, S{"C","D"} },
  T{ S{"A","B"}, S{"B","D"} },
  T{ S{"A","B"}, S{"C","D"}, S{"D","B"} },
  T{ S{"H","I","K"}, S{"A","B"}, S{"C","D"}, S{"D","B"}, S{"F","G","H"} },
}
for i,example in ipairs(examples) do
  print("Given input sets:")
  example:each(function(set) set:keys():dump() end)
  print("Consolidated output sets:")
  example:consolidate():each(function(set) set:keys():dump() end)
  print("")
end