<commit_before>﻿(*

Copyright 2010 <NAME>, <NAME>
Copyright 2012-2013 <NAME>

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

*)

namespace FSharpLex.SpecializedCollections

open System
open System.Collections.Generic
open System.CodeDom.Compiler
open System.Diagnostics
open System.Diagnostics.Contracts
open OptimizedClosures
open ExtCore
open ExtCore.Printf
open ExtCore.Collections
open ExtCore.Control


[<AutoOpen>]
module internal Constants =
    //
    let [<Literal>] defaultStackCapacity = 16
    //
    let [<Literal>] balanceTolerance = 2u   //1u


(*  NOTE :  The core functions implementing the AVL tree algorithm were extracted into OCaml
            from the "AVL Trees" theory in the Archive of Formal Proofs:
                http://afp.sourceforge.net/entries/AVL-Trees.shtml
            using Isabelle/HOL 2012. The extracted code was adapted to F# (e.g., by adjusting
            the formatting, fixing incomplete pattern-matches), then the supporting functions
            (e.g., 'fold', 'iter') were implemented.
            
            The DIET code was ported from Friedmann and Lange's 'camldiets' code, which is
            based on their paper "More on Balanced Diets". Their code was adapted to F# and
            the AVL tree extracted from Isabelle/HOL, then specialized for the 'char' type. *)

/// AVL Tree.
#if DEBUG
[<StructuredFormatDisplay("{DisplayFormatted}")>]
#else
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
#endif
[<NoEquality; NoComparison>]
[<DebuggerTypeProxy(typedefof<AvlTreeDebuggerProxy<int>>)>]
type internal AvlTree<'T when 'T : comparison> =
    /// Empty tree.
    | Empty
    /// Node.
    // Left-Child, Right-Child, Value, Height
    | Node of AvlTree<'T> * AvlTree<'T> * 'T * uint32

    //
    static member private CompareStacks (comparer : IComparer<'T>, l1 : AvlTree<'T> list, l2 : AvlTree<'T> list) : int =
        match l1, l2 with
        | [], [] -> 0
        | [], _ -> -1
        | _, [] -> 1

        | Empty :: t1, Empty :: t2 ->
            AvlTree.CompareStacks (comparer, t1, t2)

        | Node (Empty, Empty, n1k, _) :: t1, Node (Empty, Empty, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, t1, t2)
            | c -> c

        | Node (Empty, Empty, n1k, _) :: t1, Node (Empty, n2r, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, Empty :: t1, n2r :: t2)
            | c -> c

        | Node (Empty, n1r, n1k, _) :: t1, Node (Empty, Empty, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, n1r :: t1, Empty :: t2)
            | c -> c

        | Node (Empty, n1r, n1k, _) :: t1, Node (Empty, n2r, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, n1r :: t1, n2r :: t2)
            | c -> c

        | Node (Empty, Empty, _, _) :: _, _ ->
            AvlTree.CompareStacks (comparer, Empty :: l1, l2)
        
        | Node (n1l, n1r, n1k, _) :: t1, _ ->
            AvlTree.CompareStacks (comparer, n1l :: Node (Empty, n1r, n1k, 0u) :: t1, l2)
        
        | _, Node (Empty, Empty, _, _) :: _ ->
            AvlTree.CompareStacks (comparer, l1, Empty :: l2)
        
        | _, Node (n2l, n2r, n2k, _) :: t2 ->
            AvlTree.CompareStacks (comparer, l1, n2l :: Node (Empty, n2r, n2k, 0u) :: t2)
                
    //
    static member Compare (comparer : IComparer<'T>, s1 : AvlTree<'T>, s2 : AvlTree<'T>) : int =
        match s1, s2 with
        | Empty, Empty -> 0
        | Empty, _ -> -1
        | _, Empty -> 1
        | _ ->
            AvlTree<'T>.CompareStacks (comparer, [s1], [s2])

    /// Computes the height of a AvlTree (rather than returning the height value stored in it's root).
    [<Pure>]
    static member private ComputeHeight (tree : AvlTree<'T>) =
        match tree with
        | Empty -> 0u
        | Node (l, r, _, _) ->
            1u + max (AvlTree.ComputeHeight l) (AvlTree.ComputeHeight r)
        
    /// Determines if a AvlTree is correctly formed.
    [<Pure>]
    static member internal AvlInvariant (tree : AvlTree<'T>) =
        match tree with
        | Empty -> true
        | Node (l, r, _, h) ->
            let height_l = AvlTree.ComputeHeight l
            let height_r = AvlTree.ComputeHeight r
            let height_diff = (max height_l height_r) - (min height_l height_r)
            
            height_diff <= balanceTolerance
            && h = ((max height_l height_r) + 1u)
            && AvlTree.AvlInvariant l
            && AvlTree.AvlInvariant r

    /// Returns the height of a AvlTree.
    [<Pure>]
    static member inline Height (tree : AvlTree<'T>) =
        match tree with
        | Empty -> 0u
        | Node (_,_,_,h) -> h<commit_msg>Implemented a MAJOR optimization in the comparison function for AvlTree/CharDiet (which underlies CharSet); simply checking for object identity has removed nearly *all* of the execution time required for comparison.<commit_after>﻿(*

Copyright 2010 <NAME>, <NAME>
Copyright 2012-2013 <NAME>

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

*)

namespace FSharpLex.SpecializedCollections

open System
open System.Collections.Generic
open System.CodeDom.Compiler
open System.Diagnostics
open System.Diagnostics.Contracts
open OptimizedClosures
open ExtCore
open ExtCore.Printf
open ExtCore.Collections
open ExtCore.Control


[<AutoOpen>]
module internal Constants =
    //
    let [<Literal>] defaultStackCapacity = 16
    //
    let [<Literal>] balanceTolerance = 2u   //1u


(*  NOTE :  The core functions implementing the AVL tree algorithm were extracted into OCaml
            from the "AVL Trees" theory in the Archive of Formal Proofs:
                http://afp.sourceforge.net/entries/AVL-Trees.shtml
            using Isabelle/HOL 2012. The extracted code was adapted to F# (e.g., by adjusting
            the formatting, fixing incomplete pattern-matches), then the supporting functions
            (e.g., 'fold', 'iter') were implemented.
            
            The DIET code was ported from Friedmann and Lange's 'camldiets' code, which is
            based on their paper "More on Balanced Diets". Their code was adapted to F# and
            the AVL tree extracted from Isabelle/HOL, then specialized for the 'char' type. *)

/// AVL Tree.
#if DEBUG
[<StructuredFormatDisplay("{DisplayFormatted}")>]
#else
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
#endif
[<NoEquality; NoComparison>]
[<DebuggerTypeProxy(typedefof<AvlTreeDebuggerProxy<int>>)>]
type internal AvlTree<'T when 'T : comparison> =
    /// Empty tree.
    | Empty
    /// Node.
    // Left-Child, Right-Child, Value, Height
    | Node of AvlTree<'T> * AvlTree<'T> * 'T * uint32

    //
    static member private CompareStacks (comparer : IComparer<'T>, l1 : AvlTree<'T> list, l2 : AvlTree<'T> list) : int =
        match l1, l2 with
        | [], [] -> 0
        | [], _ -> -1
        | _, [] -> 1

        // OPTIMIZATION : If the trees are identical, there's no need to compare them.
        | t1 :: l1, t2 :: l2
            when t1 === t2 ->
            AvlTree.CompareStacks (comparer, l1, l2)

        | Empty :: t1, Empty :: t2 ->
            AvlTree.CompareStacks (comparer, t1, t2)

        | Node (Empty, Empty, n1k, _) :: t1, Node (Empty, Empty, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, t1, t2)
            | c -> c

        | Node (Empty, Empty, n1k, _) :: t1, Node (Empty, n2r, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, Empty :: t1, n2r :: t2)
            | c -> c

        | Node (Empty, n1r, n1k, _) :: t1, Node (Empty, Empty, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, n1r :: t1, Empty :: t2)
            | c -> c

        | Node (Empty, n1r, n1k, _) :: t1, Node (Empty, n2r, n2k, _) :: t2 ->
            match comparer.Compare (n1k, n2k) with
            | 0 ->
                AvlTree.CompareStacks (comparer, n1r :: t1, n2r :: t2)
            | c -> c

        | Node (Empty, Empty, _, _) :: _, _ ->
            AvlTree.CompareStacks (comparer, Empty :: l1, l2)
        
        | Node (n1l, n1r, n1k, _) :: t1, _ ->
            AvlTree.CompareStacks (comparer, n1l :: Node (Empty, n1r, n1k, 0u) :: t1, l2)
        
        | _, Node (Empty, Empty, _, _) :: _ ->
            AvlTree.CompareStacks (comparer, l1, Empty :: l2)
        
        | _, Node (n2l, n2r, n2k, _) :: t2 ->
            AvlTree.CompareStacks (comparer, l1, n2l :: Node (Empty, n2r, n2k, 0u) :: t2)
                
    //
    static member Compare (comparer : IComparer<'T>, s1 : AvlTree<'T>, s2 : AvlTree<'T>) : int =
        // OPTIMIZATION : If the trees are identical, there's no need to compare them.
        if s1 === s2 then 0
        else
            match s1, s2 with
            | Empty, Empty -> 0
            | Empty, _ -> -1
            | _, Empty -> 1
            | _ ->
                AvlTree<'T>.CompareStacks (comparer, [s1], [s2])

    /// Computes the height of a AvlTree (rather than returning the height value stored in it's root).
    [<Pure>]
    static member private ComputeHeight (tree : AvlTree<'T>) =
        match tree with
        | Empty -> 0u
        | Node (l, r, _, _) ->
            1u + max (AvlTree.ComputeHeight l) (AvlTree.ComputeHeight r)
        
    /// Determines if a AvlTree is correctly formed.
    [<Pure>]
    static member internal AvlInvariant (tree : AvlTree<'T>) =
        match tree with
        | Empty -> true
        | Node (l, r, _, h) ->
            let height_l = AvlTree.ComputeHeight l
            let height_r = AvlTree.ComputeHeight r
            let height_diff = (max height_l height_r) - (min height_l height_r)
            
            height_diff <= balanceTolerance
            && h = ((max height_l height_r) + 1u)
            && AvlTree.AvlInvariant l
            && AvlTree.AvlInvariant r

    /// Returns the height of a AvlTree.
    [<Pure>]
    static member inline Height (tree : AvlTree<'T>) =
        match tree with
        | Empty -> 0u
        | Node (_,_,_,h) -> h
{'fraction_non_alphanumeric': 0.11562608998953611, 'fraction_numerical': 0.02153819323334496, 'mean_word_length': 2.139611278401314, 'pattern_counts': {'":': 0, '<': 61, '<?xml version=': 0, '>': 120, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6055785', 'n_tokens_mistral': 3785, 'n_tokens_neox': 3616, 'n_words': 1158}