let words = "aabbccdd"
let listChars = Seq.toList words

let rec cortMatch headCort tailCort el =
    match tailCort with
    |hd::tl ->
        let symb, counter = hd
        if symb = el
            then
                let counter' = counter + 1
                let newCort = (symb, counter')
                headCort @ [newCort] @ tl
            else
                let headCort' = headCort @ [hd]
                cortMatch headCort' tl el
    |_ -> headCort @ [(el, 1)]

let rec charsToCorts listCh listCort =
    match listCh with
    |hd::tl ->
        let listCort' = cortMatch [] listCort hd
        charsToCorts tl listCort'
    |_ -> listCort

let cortsList = charsToCorts listChars []

//Переводим список кортежей в деревья
type BinaryTree =
| Node of int * BinaryTree * BinaryTree
| Leaf of int * char
| Empty

let rec cortsToTrees cortsList treesList =
    match cortsList with
    |hd::tl ->
        let (symb, value) = hd
        let tree = Leaf (value, symb)
        cortsToTrees tl treesList @ [tree]
    |_ -> treesList

let treesList = cortsToTrees cortsList []

open System
printfn "Before sorting: "
treesList |> printfn "%A"
let sortFunction (t1:BinaryTree) (t2:BinaryTree) =
    let val1 =
        match t1 with
        |Node (value, _, _) -> value
        |Leaf (value, string) -> value
        |_ -> 0

    let val2 =
        match t2 with
        |Node (value, _, _) -> value
        |Leaf (value, string) -> value
        |_ -> 0

    if (val1 > val2) then
       1
    else -1
let sortedTreeList = List.sortWith sortFunction treesList
printfn "After sorting:\n%A" sortedTreeList

let combinateTrees tree1 tree2 =
    let val1 =
        match tree1 with
        |Node (value, _, _) -> value
        |Leaf (value, string) -> value
        |_ -> 0
    let val2 =
        match tree2 with
        |Node (value, _, _) -> value
        |Leaf (value, string) -> value
        |_ -> 0
    Node (val1 + val2, tree1, tree2)
//не проверено

let rec creatingMainTree list =
    match list with
    |fT::tailfT ->
        match tailfT with
        |sT::tailsT ->
            let tree = combinateTrees fT sT
            let sortedTreeList = List.sortWith sortFunction ([tree] @ tailsT)
            creatingMainTree sortedTreeList
        |_ -> fT
    |_ -> Node (0, Empty, Empty)

let mainTree = creatingMainTree sortedTreeList

printf "\n%A" mainTree
//самое ппечальное
let rec printInOrder tree key codeList =
    match tree with
    |Node (value, left, right) ->
        printInOrder left (key @ [1]) codeList
        printInOrder right (key @ [0]) codeList
    |Leaf (value, symb) ->
        printfn "Symbol '%c' %A" symb key
        let codeList' = codeList @ [(symb, key)]
        if treesList.Length = codeList'.Length then codeList'
    |Empty ->
        if treesList.Length = codeList.Length then codeList

printf "\n"
let a = printInOrder mainTree [] []

System.Console.ReadKey()