<commit_before>﻿namespace FSharpx.Collections.Experimental

//TODO: This should be better documented

open FSharpx.Collections
open System.Collections.Generic

exception IncompatibleMerge of string

type private 'T SBHTree = Node of 'T * 'T list * 'T SBHTree list

type private 'T SBHTreeRoot = Root of int * 'T SBHTree

[<AutoOpen>]
module private Helper =
    let inline xor a b = (a && not b) || (not a && b)

module private SBHTree =
    let item (Node (x, _, _)) = x

    let link descending (Node (x, auxX, childrenX) as treeX) (Node (y, auxY, childrenY) as treeY) =
        if xor (x <= y) descending
            then Node (x, auxX, treeY::childrenX)
            else Node (y, auxY, treeX::childrenY)

    let skewLink descending v treeX treeY =
        let (Node (w, aux, children)) = link descending treeX treeY
        if xor (v <= w) descending
            then Node (v, w::aux, children)
            else Node (w, v::aux, children)

module private SBHTreeRoot =
    open SBHTree

    let inline getTree (Root (_, tree)) = tree

    let insert descending value = function
        | Root(rank1, tree1)::Root(rank2, tree2)::roots when rank1 = rank2 -> Root(rank1 + 1, skewLink descending value tree1 tree2)::roots
        | roots                                                            -> Root(0, Node (value, [], []))::roots

    let rec insRoot descending (Root(rank, tree) as root) roots =
        match roots with
        | []                                  -> [root]
        | Root(rank', _)::_ when rank < rank' -> root::roots
        | Root(_, tree')::roots'              -> insRoot descending (Root(rank + 1, link descending tree tree')) roots'

    let rec mergeRoots descending roots1 roots2 =
        match roots1, roots2 with
        | roots, [] | [], roots-> roots
        | Root(rankX, treeX)::roots1', Root(rankY, _)::_ when rankX < rankY -> Root(rankX, treeX)::mergeRoots descending roots1' roots2
        | Root(rankX, _)::_, Root(rankY, treeY)::roots2' when rankX > rankY -> Root(rankY, treeY)::mergeRoots descending roots1 roots2'
        | Root(rank, treeX)::roots1', Root(_, treeY)::roots2'               -> insRoot descending (Root(rank + 1, link descending treeX treeY)) (mergeRoots descending roots1' roots2')

    let normalize descending = function
        | [] -> []
        | root::roots -> insRoot descending root roots

    let rec extractMinRoot descending = function
        | [p] -> (p, [])
        | (Root(_, tree) as root)::roots ->
            let (Root(_, tree') as root', roots') = extractMinRoot descending roots
            if xor (SBHTree.item tree <= SBHTree.item tree') descending
                then root, roots
                else root', root::roots'
        | [] -> failwith "This should never happen"
        
    let rec findMinRootItem descending = function
        | [Root(_, node)]                       -> item node
        | Root(_, node)::roots'                 -> 
            let this = item node
            let other = findMinRootItem descending roots'
            if xor (this <= other) descending
                then this
                else other
        | []                                    -> failwith "This should never happen"

    let uncons descending roots =
        //find the root with the minimum value a return it along with the remaining roots
        let (Root(rank, Node(x, aux, children)), roots') = extractMinRoot descending roots
        //reverse the children and set their ranks based on the parent's rank<commit_msg>Removed the unnecessary xor function<commit_after>﻿namespace FSharpx.Collections.Experimental

//TODO: This should be better documented

open FSharpx.Collections
open System.Collections.Generic

exception IncompatibleMerge of string

type private 'T SBHTree = Node of 'T * 'T list * 'T SBHTree list

type private 'T SBHTreeRoot = Root of int * 'T SBHTree

module private SBHTree =
    let item (Node (x, _, _)) = x

    let link descending (Node (x, auxX, childrenX) as treeX) (Node (y, auxY, childrenY) as treeY) =
        if x <= y <> descending
            then Node (x, auxX, treeY::childrenX)
            else Node (y, auxY, treeX::childrenY)

    let skewLink descending v treeX treeY =
        let (Node (w, aux, children)) = link descending treeX treeY
        if v <= w <> descending
            then Node (v, w::aux, children)
            else Node (w, v::aux, children)

module private SBHTreeRoot =
    open SBHTree

    let inline getTree (Root (_, tree)) = tree

    let insert descending value = function
        | Root(rank1, tree1)::Root(rank2, tree2)::roots when rank1 = rank2 -> Root(rank1 + 1, skewLink descending value tree1 tree2)::roots
        | roots                                                            -> Root(0, Node (value, [], []))::roots

    let rec insRoot descending (Root(rank, tree) as root) roots =
        match roots with
        | []                                  -> [root]
        | Root(rank', _)::_ when rank < rank' -> root::roots
        | Root(_, tree')::roots'              -> insRoot descending (Root(rank + 1, link descending tree tree')) roots'

    let rec mergeRoots descending roots1 roots2 =
        match roots1, roots2 with
        | roots, [] | [], roots-> roots
        | Root(rankX, treeX)::roots1', Root(rankY, _)::_ when rankX < rankY -> Root(rankX, treeX)::mergeRoots descending roots1' roots2
        | Root(rankX, _)::_, Root(rankY, treeY)::roots2' when rankX > rankY -> Root(rankY, treeY)::mergeRoots descending roots1 roots2'
        | Root(rank, treeX)::roots1', Root(_, treeY)::roots2'               -> insRoot descending (Root(rank + 1, link descending treeX treeY)) (mergeRoots descending roots1' roots2')

    let normalize descending = function
        | [] -> []
        | root::roots -> insRoot descending root roots

    let rec extractMinRoot descending = function
        | [p] -> (p, [])
        | (Root(_, tree) as root)::roots ->
            let (Root(_, tree') as root', roots') = extractMinRoot descending roots
            if (SBHTree.item tree <= SBHTree.item tree') <> descending
                then root, roots
                else root', root::roots'
        | [] -> failwith "This should never happen"
        
    let rec findMinRootItem descending = function
        | [Root(_, node)]                       -> item node
        | Root(_, node)::roots'                 -> 
            let this = item node
            let other = findMinRootItem descending roots'
            if this <= other <> descending
                then this
                else other
        | []                                    -> failwith "This should never happen"

    let uncons descending roots =
        //find the root with the minimum value a return it along with the remaining roots
        let (Root(rank, Node(x, aux, children)), roots') = extractMinRoot descending roots
        //reverse the children and set their ranks based on the parent's rank
{'fraction_non_alphanumeric': 0.10838004887164007, 'fraction_numerical': 0.007761966364812419, 'mean_word_length': 2.14841628959276, 'pattern_counts': {'":': 0, '<': 20, '<?xml version=': 0, '>': 44, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '674273', 'n_tokens_mistral': 2014, 'n_tokens_neox': 1885, 'n_words': 694}