some.fs

type Data = 
    { C : int[]
      P : float[]
      Values : int [][] }
      
module Tuple = 
    let mapPair f (x,y) = x |> f, y |> f
    let swap (x,y) = y, x
    let pairToArray (x,y) = [|x ; y |]

module Comb = 
    let combinations set size =    
        let rec combinations acc size set = seq {
            match size, set with
            | n, x::xs ->
                if n > 0 then yield! combinations (x::acc) (n - 1) xs
                if n >= 0 then yield! combinations acc n xs
            | 0, [] -> yield acc
            | _, [] -> () }
        combinations [] size set   

module Algorithm = 
    let private makePair = 
         Array.map
            (Array.indexed
             >> Array.partition(snd >> (=) 1)
             >> Tuple.mapPair (Array.map fst >> Set.ofArray)
             >> Tuple.pairToArray)

    let private gelAllCombinations size all = 
        List.collect (Comb.combinations all >> Seq.toList) [2..size]
        
    let rec private cinter fullSet =
        function
        | [] -> Seq.singleton fullSet
        | h::t -> seq {for x in h do for xs in cinter fullSet t -> Set.intersect x xs}

    let private allSet values = 
        let firstSets = values |> makePair 
        let count = firstSets |> Array.length
        let all = [0..count - 1]
        let fullSet = set all
        
        let interWithoutEmpty = 
            List.map (fun i -> firstSets.[i])
            >> cinter fullSet
            >> Seq.filter (Set.isEmpty >> not)
            >> Seq.toArray

        gelAllCombinations count all
        |> List.map interWithoutEmpty
        |> List.append [ [| fullSet |] ; firstSets |> Array.concat ]
        |> Seq.concat
        |> Seq.distinct
        |> Seq.sortBy Set.count
        |> Seq.toList
        |> List.groupBy (fun x -> x.Count)

    let private splitting (data : Data) group = 
        let getInd (vset : Set<_>) = 
            data.Values
            |> Array.map (Array.indexed >> Array.filter(fst >> vset.Contains))
            |> Array.indexed
            |> Array.filter (snd >> Array.distinctBy snd >> Array.length >> (<>) 1)
            |> Array.map (fun (i,v) -> i, v |> Array.partition(snd >> (=) 0) |> Tuple.mapPair(Array.map fst))

        let calculate groups = 
            let fbell (map : Map<int Set, float>) (i, (v1, v2)) = 
                let c = float data.C.[i]
                let d = Array.append v1 v2 |> Array.sumBy(fun pi -> data.P.[pi])
                let s = [| v1 ; v2 |] |> Array.sumBy(fun g -> map.[(g |> Set.ofArray)] * (Array.sumBy(fun pi -> data.P.[pi]) g) / d)
                c + s

            let rec calc xs acc = 
                match xs with
                |[] -> acc
                |(1, xs) :: t -> 
                    xs 
                    |> List.fold(fun iacc x -> Map.add x 0.0 iacc) acc
                    |> calc t
                |(_, xs)::t -> 
                    xs 
                    |> List.map (getInd >> Array.map (fbell acc) >> Array.min)
                    |> List.zip (xs |> List.map (Set.toArray))
                    |> List.fold(fun iacc (k,v) -> Map.add (k |> Set.ofArray) v iacc) acc
                    |> calc t
   
            calc groups Map.empty

        calculate group

    let algorithm data = 
        allSet data.Values
        |> splitting data
        |> Map.toSeq
        |> Seq.map snd
        |> Seq.max