Matematické Fórum

30|1|2||4  **  40|31|2||  **  0|21||43|  **  0|41|32||
20|1||3|4  **  30|21|||4  **  40|31|2||  **  0|41|2|3|
10||42|3|  **  30|1|2||4  **  40|321|||  **  0|41|2|3|
410||32||  **  320|41|||  **  420|1||3|  **  0|21||43|
3210||||4  **  420|1||3|  **  30|41|2||  **  0|21||43|

open System

// Rozklad reprezentovany kybliky je mapa, ktera mapuje cislo kybliku na obsah kybliku.
// Pro neprazdne kybliky plati, ze nejmensi cislo v kybliku je rovno cislu kybliku
// a cisla v kyblicich jsou serazena od nejvetsiho po nejmensi.
type RozkladKyb = Map<int, list<int>>

let generujRozklady n =
    let rec umistiPrvek (skoroRozklady : ResizeArray<RozkladKyb>) i =
        if i < n then
            let skoroRozklady' = ResizeArray<RozkladKyb>()

            // Do kazdeho skoro rozkladu umistime i-ty prvek do kazde prihradky
            for rozklad in skoroRozklady do
                for kyblik = 0 to n-1 do
                    // Filtr symetrii
                    if not rozklad.[kyblik].IsEmpty || kyblik = i then
                        skoroRozklady'.Add(rozklad.Add(kyblik, i :: rozklad.[kyblik]))

            umistiPrvek skoroRozklady' (i+1)
        else
            skoroRozklady

    let skoroRozklady = ResizeArray<RozkladKyb>()
    skoroRozklady.Add([0..n-1] |> List.map (fun i -> i, []) |> Map.ofList)

    umistiPrvek skoroRozklady 0

// Rozklad reprezentovany jako mnozina dvojic.
type Rozklad = Set<int * int>

// Prevede rozklad na mnozinu dvojic.
let rozkladKybNaMnozinuDvojic (rozklad : RozkladKyb) : Rozklad =
    let kyblikNaMnozinu (obsahKybliku : list<int>) =
        seq { for a in obsahKybliku do
                  for b in obsahKybliku do
                      yield (a, b)
            } |> Set.ofSeq

    rozklad
    |> Map.toSeq
    |> Seq.map snd
    |> Seq.map kyblikNaMnozinu
    |> Seq.concat
    |> Set.ofSeq

let mnozinaDvojicNaRozkladKyb n (rozklad : Rozklad) : RozkladKyb =
    let rec umistiPrvek (umisteniZatim : RozkladKyb) i =
        if i < n then
            let kybl =
                rozklad
                |> Seq.filter (fun (x, _) -> x = i)
                |> Seq.map snd
                |> Seq.min
            let umisteniZatim' = umisteniZatim.Add(kybl, i :: umisteniZatim.[kybl])
            umistiPrvek umisteniZatim' (i+1)
        else
            umisteniZatim

    let prazdneUmisteni = [0..n-1] |> List.map (fun i -> i, []) |> Map.ofList
    umistiPrvek prazdneUmisteni 0


let sjednoceni (vsechnyRozklady : seq<Rozklad>) (a : Rozklad) (b : Rozklad) =
    let c = Set.union a b
    let rozkladyObsahujiciC = vsechnyRozklady |> Seq.filter (Set.isSubset c)
    rozkladyObsahujiciC |> Seq.reduce Set.intersect

let prunik = Set.intersect

// Spusti danou operaci na vsech rozkladech (vysledky musi byt take rozklady)
// a ulozi vysledky do mapy
//
// Indexy rozkladu jsou urceny polem vsechnyRozkladyArr. Je treba pracovat s indexy,
// jinak je program strasne pomaly.
let vysledkyOperace (vsechnyRozkladyArr : Rozklad[]) (operace : Rozklad -> Rozklad -> Rozklad) =
    let arr = vsechnyRozkladyArr
    let indexy = [0..arr.Length-1]
    let vysledky = Array2D.create arr.Length arr.Length 0

    for i in indexy do
        for j in indexy do
            let rozklad = operace arr.[i] arr.[j]
            let index = Array.findIndex (fun r -> r = rozklad) arr
            vysledky.[i, j] <- index

    vysledky

let uzaverNaIndexech
        mnozinaKUzavreni
        (vysledkySjednoceni : int[,])
        (vysledkyPruniku : int[,])
        (vsechnyRozklady : Rozklad[]) =
    let rec krok mnoz naposledyPridano =
        let pridat = ref Set.empty

        // Vyuzivame komutativity a idempotence obou operaci
        for a in mnoz do
            for b in naposledyPridano do

                let sjed = vysledkySjednoceni.[a, b]
                if not (Set.contains sjed mnoz) then
                  pridat := pridat.Value.Add(sjed)

                let prun = vysledkyPruniku.[a, b]
                if not (Set.contains prun mnoz) then
                  pridat := pridat.Value.Add(prun)

        if pridat.Value.IsEmpty then
            mnoz
        else
            let mnoz' = Set.union mnoz !pridat
            krok mnoz' !pridat

    krok mnozinaKUzavreni mnozinaKUzavreni

// Vsechny k-tice z mnoziny
let kombinace mnozina k =
    let rec komb acc zbyva mnoz =
        seq { match zbyva, mnoz with
              | n, x::xs ->
                  if n > 0 then yield! komb (x::acc) (n-1) xs
                  if n >= 0 then yield! komb acc n xs
              | 0, [] -> yield acc
              | _, [] -> ()
            }

    komb [] k mnozina

// Hleda generatory svazu rozkladu - prvni parametr je velikost rozkladane mnoziny,
// druhy parametr je pocet generatoru.
let najdiGeneratoryNaIndexech velikostMnoziny pocetGeneratoru =
    let vsechnyRozkladyArr =
        generujRozklady velikostMnoziny
        |> Seq.map rozkladKybNaMnozinuDvojic
        |> Seq.toArray
    let vsechnyRozklady = Set.ofArray vsechnyRozkladyArr

    // Predpocitame vysledky sjednoceni a pruniku
    let vysledkySjednoceni = vysledkyOperace vsechnyRozkladyArr (sjednoceni vsechnyRozkladyArr)
    let vysledkyPruniku = vysledkyOperace vsechnyRozkladyArr prunik

    let indexyGeneratoru = kombinace [0..vsechnyRozkladyArr.Length-1] pocetGeneratoru

    seq { for gen in indexyGeneratoru do

          let genRozklady = uzaverNaIndexech (Set.ofList gen) vysledkySjednoceni vysledkyPruniku vsechnyRozkladyArr

          if genRozklady.Count = vsechnyRozklady.Count then
              let vybraneRozklady =
                  gen
                  |> Seq.map (fun i -> vsechnyRozkladyArr.[i])
                  |> Set.ofSeq

              yield
                vybraneRozklady
                |> Set.toList
                |> List.map (mnozinaDvojicNaRozkladKyb velikostMnoziny)
        }

// Prevod rozkladu do citelneho retezce
let rozkladKybNaRetezec (rozklad : RozkladKyb) =
    let kyblikNaRetezec (obsah : seq<int>) = String.Join("", obsah)

    rozklad
    |> Map.toSeq
    |> Seq.map (snd >> kyblikNaRetezec)
    |> String.concat "|"

// Prevede sadu rozkladu do citelneho retezce - vhodne pro tisk generatoru
let sadaGeneratoruNaRetezec (sada : list<RozkladKyb>) =
    sada
    |> List.map rozkladKybNaRetezec
    |> String.concat "  **  "

let casovac = System.Diagnostics.Stopwatch()
casovac.Start()

let pocetSad = ref 0

// VSTUPNI PARAMETRY SE ZADAVAJI NASLEDOVNE
// najdiGeneratoryNaIndexech pocetPrvkuVMnozine velikostGeneratoru,
//
// Volani "najdiGeneratoryNaIndexech 5 4" hleda ctverice generatoru svazu rozkladu
// mnoziny s peti prvky
for sadaGeneratoru in najdiGeneratoryNaIndexech 5 4 do
    pocetSad := !pocetSad + 1
    sadaGeneratoru |> sadaGeneratoruNaRetezec |> printfn "%s"

casovac.Stop();
printfn "pocet sad generatoru %d" !pocetSad
printfn "milisekund: %d" casovac.ElapsedMilliseconds