search

dotnet / fsharp

The F# compiler, F# core library, F# language service, and F# tooling integration for Visual Studio
https://dotnet.microsoft.com/languages/fsharp
MIT License
3.9k stars 783 forks source link

Function produces different result when piped into. #1326

Closed flideros closed 8 years ago

flideros commented 8 years ago

In the attached code, the degreeGPE function produces an unexpected result when a check function is piped into. When the same function is used outside of degreeGPE is produces the correct result.

Repro steps

Provide the steps required to reproduce the problem

  1. Step A
//Function
    let rec degreeGPE u xList =         
        match isPolynomialGPE u xList with
        | false -> Undefined
        | true ->
            match u with
            | Number n when n = NumberType.Zero -> NegativeInfinity
            | NaryOp (Sum, aList) -> (List.rev (List.sortWith NumberType.compareNumbers (List.map (fun x -> degreeGPE x xList) aList))).Head
            | _ -> 
                let powers = 
                    let eNumber acc (n:Expression) = match n = Number NumberType.Zero with | false -> (Integer 0I,Base n)::acc | true -> (NegativeInfinity,Base n)::acc
                    let eSymbol acc (v:Expression) = (Integer 1I,Base v)::acc
                    let eBinaryOp acc x = match x with | BinaryOp (Symbol(Variable a),ToThePowerOf,Number(Integer b)) -> (Integer b,Base x) :: acc | _ -> acc
                    let eUnaryOp acc x = acc
                    let eNaryOp acc x = acc
                    let acc = []                
                    Cata.foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc u
                let compare x' y' = NumberType.compareNumbers (fst x') (fst y')
                let out = List.rev(List.sortWith compare powers)
                let check x = match x = NumberType.Zero with | true -> Undefined | false -> x
                List.collect (fun xx ->  
                    let x' = 
                        match List.exists (fun (a,b) -> xx = b) out with
                        | true -> List.filter (fun (a,b) -> xx = b ) out
                        | false -> [NumberType.Zero,xx]
                    [(List.rev(List.sortWith compare x')).Head]) xList
                |> List.fold (fun acc (a,b) -> acc + a) NumberType.Zero
                |> check 

//***FSI***
open Algebra

let y = Symbol (Variable "y")
let z = Symbol (Variable "z")
let a = Symbol (Variable "a")
let b = Symbol (Variable "b")
let c = Symbol (Variable "c")
let three = Number (Integer 3I)
let two = Number (Integer 2I)

open Polynomial

let testD = two*z + a*z + three*y + b*y + c

degreeGPE testD [y]
  1. Step B
//Function
    let rec _degreeGPE u xList =         
        match isPolynomialGPE u xList with
        | false -> Undefined
        | true ->
            match u with
            | Number n when n = NumberType.Zero -> NegativeInfinity
            | NaryOp (Sum, aList) -> (List.rev (List.sortWith NumberType.compareNumbers (List.map (fun x -> _degreeGPE x xList) aList))).Head
            | _ -> 
                let powers = 
                    let eNumber acc (n:Expression) = match n = Number NumberType.Zero with | false -> (Integer 0I,Base n)::acc | true -> (NegativeInfinity,Base n)::acc
                    let eSymbol acc (v:Expression) = (Integer 1I,Base v)::acc
                    let eBinaryOp acc x = match x with | BinaryOp (Symbol(Variable a),ToThePowerOf,Number(Integer b)) -> (Integer b,Base x) :: acc | _ -> acc
                    let eUnaryOp acc x = acc
                    let eNaryOp acc x = acc
                    let acc = []                
                    Cata.foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc u
                let compare x' y' = NumberType.compareNumbers (fst x') (fst y')
                let out = List.rev(List.sortWith compare powers)
                List.collect (fun xx ->  
                    let x' = 
                        match List.exists (fun (a,b) -> xx = b) out with
                        | true -> List.filter (fun (a,b) -> xx = b ) out
                        | false -> [NumberType.Zero,xx]
                    [(List.rev(List.sortWith compare x')).Head]) xList
                |> List.fold (fun acc (a,b) -> acc + a) NumberType.Zero

    let degreeGPE u xList = match (_degreeGPE u xList) = NumberType.Zero with | true -> Undefined | false -> _degreeGPE u xList

//***FSI***
open Algebra

let y = Symbol (Variable "y")
let z = Symbol (Variable "z")
let a = Symbol (Variable "a")
let b = Symbol (Variable "b")
let c = Symbol (Variable "c")
let three = Number (Integer 3I)
let two = Number (Integer 2I)

open Polynomial

let testD = two*z + a*z + three*y + b*y + c

degreeGPE testD [y]

Expected behavior

both a and b should = Integer 1 The only difference is in Step A the check function is piped in and in Step B the check is done in a seperate function.

Actual behavior

Step A result = Undefined Step B result = Integer 1

Known workarounds

Step B is the workaround.

Algebra.zip

dsyme commented 8 years ago

@flideros Please edit the issue following the template in ISSUE_TEMPLATE.md, with exact repro steps, and actual/expected output. If possible, please also trim down the problem to a minimal reproducible example. It will normally be possible to reproduce problems with just a few lines of code.

We won't be able to look at this until the issue is re-edited using the issue template. But we really also need a smaller repro.

flideros commented 8 years ago

@dsyme I tried to repro with a simple function but without success. All the source code is in the attached zip.

dsyme commented 8 years ago

@flideros Normally you create a minimal repro by starting with the large one, and repeatedly chopping out seemingly irrelevant code, until just before the problem either no longer repros. For example, you might chop out the let powers ... and replace it by a let powers = constant or the like. And gradually remove all the prelude code leading up the the problem, again until the problem no longer repros.

I notice you call _degreeGPE u xList twice in the second variant too - if there are side effects somewhere in the code this could explain the different - though I suspect there aren't.

flideros commented 8 years ago

@dsyme I changed the second variant to:

let degreeGPE u xList = 
        let x = _degreeGPE u xList
        match x = NumberType.Zero with | true -> Undefined | false -> x

and it still works. Let me try and take the code to bare bones and see if it still behaves the same.

flideros commented 8 years ago

Here is the repro code...

type Constant =
    | E
    | I
    | Pi

type Symbol = 
    | Constant of Constant
    | Variable of string

type Function = 
    | Equals | GreaterThan | LessThan //Binary -> Relational
    | Sum | Plus | Positive // n-Ary, Binary, Unary -> Algebraic
    | Minus | Negative // Binary, Unary -> Algebraic
    | Product | Times // n-Ary, Binary -> Algebraic
    | Factorial
    | ToThePowerOf    
    | Sin | Cos | Tan
    | FracOp

type Fraction = 
    {numerator:System.Numerics.BigInteger; denominator:System.Numerics.BigInteger}
    with
    static member Zero = {numerator = 0I; denominator = 1I}

[<StructuralEquality;NoComparison>]
type NumberType =
    | Complex of System.Numerics.Complex
    | Rational of Fraction 
    | Integer of System.Numerics.BigInteger //System.Numerics.BigInteger
    | Real of float
    | PositiveInfinity
    | NegativeInfinity
    | ComplexInfinity
    | Undefined

type NumberType with    
    member this.isNegative = 
        match this with
        | Complex x when x.Real < 0.0 -> true
        | Rational x when x.numerator < 0I -> true
        | Integer x when x < 0I -> true
        | Real x when x < 0.0 -> true
        | NegativeInfinity -> true
        | _ -> false

    static member hcf x y =        
        let rec hcf a b =
            match a = 0I, a<b with
            | true, _ ->  b
            | false, true -> hcf a (b - a)
            | false, false -> hcf (a - b) b
        hcf x y

    static member compareNumbers x y =
        match x,y with
        | Integer x, Integer y when x > y -> 1
        | Integer x, Integer y when x = y -> 0
        | Integer x, Integer y when x < y -> -1
        | Rational x, Rational y when y.numerator * x.denominator > x.numerator * y.denominator -> -1
        | Rational x, Rational y when y.numerator * x.denominator < x.numerator * y.denominator -> 1
        | Rational x, Rational y when y.numerator * x.denominator = x.numerator * y.denominator -> 0
        | Integer x, Rational y when y.numerator > x * y.denominator -> -1
        | Integer x, Rational y when y.numerator < x * y.denominator -> 1
        | Integer x, Rational y when y.numerator = x * y.denominator -> 0
        | Rational x, Integer y when x.numerator > y * x.denominator -> 1
        | Rational x, Integer y when x.numerator < y * x.denominator -> -1
        | Rational x, Integer y when x.numerator = y * x.denominator -> 0
        | _ -> 0

    static member One = Integer 1I

    static member Zero = Integer 0I

    static member (~-) x = 
        match x with
        | Complex x -> Complex (-x) 
        | Integer x -> Integer (-x)
        | Rational f -> Rational {f with numerator = -f.numerator}
        | PositiveInfinity -> NegativeInfinity
        | NegativeInfinity -> PositiveInfinity
        | _ -> Undefined //Use until all defenitions are made

    static member (+) (x, y) = 
        match x, y with
        | Complex x, Complex y -> Complex (x + y) 
        | Integer x, Integer y -> Integer (x + y)
        | Rational f1, Rational f2 -> 
            let nTemp = f1.numerator * f2.denominator + f2.numerator * f1.denominator
            let dTemp = f1.denominator * f2.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | Rational f1, Integer i2 -> 
            let nTemp = f1.numerator + i2 * f1.denominator
            let dTemp = f1.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | Integer i2, Rational f1 -> 
            let nTemp = f1.numerator + i2 * f1.denominator
            let dTemp = f1.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | PositiveInfinity, PositiveInfinity -> PositiveInfinity
        | NegativeInfinity, NegativeInfinity -> NegativeInfinity
        | NegativeInfinity, PositiveInfinity -> Undefined
        | PositiveInfinity, NegativeInfinity -> Undefined
        | _ -> Undefined //Use until all defenitions are made

    static member (*) (x, y) = 
        match x, y with
        | Complex x, Complex y -> Complex (x * y) 
        | Integer x, Integer y -> Integer (x * y)
        | Rational f1, Rational f2 -> 
            let nTemp = f1.numerator * f2.numerator 
            let dTemp = f1.denominator * f2.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | Rational f1, Integer i2 -> 
            let nTemp = f1.numerator * i2 * f1.denominator
            let dTemp = f1.denominator * f1.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | Integer i2, Rational f1 -> 
            let nTemp = f1.numerator * i2 * f1.denominator
            let dTemp = f1.denominator * f1.denominator
            let hcfTemp = NumberType.hcf (abs nTemp) dTemp
            match dTemp / hcfTemp = 1I with
            | true -> Integer (nTemp / hcfTemp)
            | false -> Rational { numerator = nTemp / hcfTemp; denominator = dTemp / hcfTemp }
        | PositiveInfinity, PositiveInfinity -> PositiveInfinity
        | NegativeInfinity, NegativeInfinity -> NegativeInfinity
        | NegativeInfinity, PositiveInfinity -> Undefined
        | PositiveInfinity, NegativeInfinity -> Undefined
        | _ -> Undefined //Use until all defenitions are made                    

    static member Pow (x, y) = 
        match x, y with
        | Complex x, Complex y -> Complex (x ** y) 
        | Integer x, Integer y when y >= 0I-> Integer (x ** int y)
        | Integer x, Integer y when y < 0I-> 
            Rational {numerator = 1I * System.Numerics.BigInteger x.Sign; denominator = ((abs x) ** int (abs y))}
        | Rational r, Integer i when i >= 0I -> 
            Rational {numerator = r.numerator ** int i; denominator = r.denominator ** int i}
        | Rational r, Integer i when i < 0I -> 
            Rational {numerator = ((System.Numerics.BigInteger r.numerator.Sign) * r.denominator) ** 
                                  int (abs i); denominator = (abs r.numerator) ** int (abs i)}
        | PositiveInfinity, PositiveInfinity -> PositiveInfinity
        | NegativeInfinity, NegativeInfinity -> NegativeInfinity
        | NegativeInfinity, PositiveInfinity -> Undefined
        | PositiveInfinity, NegativeInfinity -> Undefined
        | _ -> Undefined //Use until all defenitions are made 

    static member (!*) x = 
        let rec factorial n =
            match n with
            | Integer x when x = 0I || x = 1I -> Integer 1I
            | Integer x when x > 1I -> n * factorial (n + -(Integer 1I))
            | Integer x when x < 0I -> n * factorial (-n + -(Integer 1I))
            | _ -> Undefined
        factorial x

type Expression =
    | Number of NumberType
    | Symbol of Symbol
    | BinaryOp of Expression * Function * Expression
    | UnaryOp of Function * Expression
    | NaryOp of Function * (Expression list)

let rec recurseExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp exp : 'r =
        let recurse = recurseExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp
        match exp with 
        | Number n -> eNumber (Number n)
        | Symbol v -> eSymbol (Symbol v)
        | BinaryOp (a,op,b) -> eBinaryOp (recurse a,op,recurse b)
        | UnaryOp (op,a) -> eUnaryOp (op,recurse a)
        | NaryOp (op,aList) -> eNaryOp (op,(List.map recurse aList))

let rec foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc exp : 'r =
        let recurse = foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp
        match exp with 
        | Number n -> 
            let finalAcc = eNumber acc (Number n)
            finalAcc
        | Symbol v -> 
            let finalAcc = eSymbol acc (Symbol v)
            finalAcc
        | BinaryOp (a,op,b) ->                        
            let newAcc = eBinaryOp acc (BinaryOp (a,op,b))
            [a;b] |> List.fold recurse newAcc
        | UnaryOp (op,a) -> 
            let newAcc = eUnaryOp acc (UnaryOp (op,a))
            recurse newAcc a
        | NaryOp (op,aList) -> 
            let newAcc = eNaryOp acc (NaryOp (op,aList))
            aList |> List.fold recurse newAcc  

let isNumber x = 
        match x with 
        | Number n -> true
        | _ -> false

let isNegativeNumber x =
        match x with 
        | Number n when n.isNegative -> true
        | _ -> false

let Base x = 
        match x with
        | Number n-> Number Undefined
        | BinaryOp (a,ToThePowerOf,b) -> a
        | _ -> x

let Exponent x =
        match x with
        | Number n -> Number Undefined
        | BinaryOp (a,ToThePowerOf,b) -> b
        | _ -> Number NumberType.One

let Term x =
        match x with
        | Number n -> Number Undefined
        | NaryOp(Product,p) when isNumber p.[0] -> 
            match p.Length with
            | 1 -> Number Undefined
            | 2 -> p.[1]
            | _ -> NaryOp(Product,p.Tail)
        | NaryOp(Product,x) when isNumber x.[0] = false -> NaryOp(Product,x)
        | a -> a

let Const x =
        match x with
        | Number n -> Number Undefined
        | NaryOp(op,a) when isNumber a.[0] -> a.[0]
        | NaryOp(op,a) when isNumber a.[0] = false -> Number NumberType.One
        | _ -> Number NumberType.One

//Comparison
let rec compareExpressions x' y' =
        match x', y' with
        | Number x, Number y -> NumberType.compareNumbers x y //O-1
        | Symbol x, Symbol y when x > y -> 1 //O-2
        | Symbol x, Symbol y when x < y -> -1 //O-2
        | Symbol x, Symbol y when x = y -> 0 //O-2
        | NaryOp(op1, x), NaryOp(op2, y) when //O-3.1 & O-6.2.(a)
            op1 = op2 && 
            (List.rev x).Head <> (List.rev y).Head ->
            compareExpressions ((List.rev x).Head) ((List.rev y).Head) 
        | NaryOp(op1, x), NaryOp(op2, y) when //O-3 & O-6.2
            op1 = op2 && 
            (List.rev x).Head = (List.rev y).Head ->
            match x.Tail.IsEmpty , y.Tail.IsEmpty with
            | false, false -> compareExpressions (NaryOp(op1, (List.rev((List.rev x).Tail)))) (NaryOp(op1, (List.rev((List.rev y).Tail)))) //O-3.2 & O-6.2.(b)
            | true, false -> 1 //O-3.3 & O-6.2.(c)
            | false, true -> -1 //O-3.3 & O-6.2.(c)
            | true, true -> 0        
        | BinaryOp(x1, op1, y1), BinaryOp(x2, op2, y2) when op1 = op2 && x1 <> x2 -> compareExpressions x1 x2 //O-4.1
        | BinaryOp(x1, op1, y1), BinaryOp(x2, op2, y2) when op1 = op2 && x1 = x2 -> compareExpressions y1 y2 //O-4.2        
        | UnaryOp(op1, x), UnaryOp(op2, y) when op1 = op2 -> compareExpressions x y //O-5
        | BinaryOp(x1, op1, y1), BinaryOp(x2, op2, y2) when op1 < op2 -> -1 //O-6.1
        | BinaryOp(x1, op1, y1), BinaryOp(x2, op2, y2) when op1 > op2 -> 1 //O-6.1
        | BinaryOp(x1, op1, y1), NaryOp(op2, y) when op1 < op2 -> -1 //O-6.1
        | BinaryOp(x1, op1, y1), NaryOp(op2, y) when op1 > op2 -> 1 //O-6.1
        | BinaryOp(x1, op1, y1), UnaryOp(op2, y) when op1 < op2 -> -1 //O-6.1
        | BinaryOp(x1, op1, y1), UnaryOp(op2, y) when op1 > op2 -> 1 //O-6.1
        | NaryOp(op1, x), NaryOp(op2, y) when op1 < op2 -> -1 //O-6.1
        | NaryOp(op1, x), NaryOp(op2, y) when op1 > op2 -> 1 //O-6.1
        | NaryOp(op1, x), BinaryOp(x2, op2, y2) when op1 < op2 -> -1 //O-6.1
        | NaryOp(op1, x), BinaryOp(x2, op2, y2) when op1 > op2 -> 1 //O-6.1
        | NaryOp(op1, x), UnaryOp(op2, y) when op1 < op2 -> -1 //O-6.1
        | NaryOp(op1, x), UnaryOp(op2, y) when op1 > op2 -> 1 //O-6.1        
        | UnaryOp(op1, x), UnaryOp(op2, y) when op1 > op2 -> -1 //O-6.1
        | UnaryOp(op1, x), UnaryOp(op2, y) when op1 < op2 -> 1 //O-6.1
        | UnaryOp(op1, x), BinaryOp(x2, op2, y2) when op1 > op2 -> -1 //O-6.1
        | UnaryOp(op1, x), BinaryOp(x2, op2, y2) when op1 < op2 -> 1 //O-6.1
        | UnaryOp(op1, x), NaryOp(op2, y) when op1 > op2 -> -1 //O-6.1
        | UnaryOp(op1, x), NaryOp(op2, y) when op1 < op2 -> 1 //O-6.1        
        | _, Number _ -> 1 //O-7
        | Number _, _ -> -1 //O-7 
        | NaryOp(Product, x), y -> compareExpressions (NaryOp(Product, x)) (NaryOp(Product, [y])) //O-8        
        | BinaryOp(base', ToThePowerOf, power'), b when base' <> Base b -> compareExpressions base' (Base b) //O-9
        | BinaryOp(base', ToThePowerOf, power'), b when base' = Base b -> compareExpressions power' (Exponent b) //O-9        
        | NaryOp(Sum, s), b -> compareExpressions (NaryOp(Sum, s)) (NaryOp(Sum, [b])) //O-10        
        | UnaryOp(Factorial, x), b when x = b -> -1 //O-11.1
        | UnaryOp(Factorial, x), b when x <> b -> compareExpressions (UnaryOp(Factorial, x)) (UnaryOp(Factorial, b)) //O-11.2        
        | NaryOp(op, x), Symbol v when x = [Symbol v] -> -1 //O-12.1
        | NaryOp(op, x), Symbol v when x <> [Symbol v] -> compareExpressions (NaryOp(op, x)) (NaryOp(op, [Symbol v])) //O-12.2
        | BinaryOp(x,op, y), Symbol v when x = Symbol v -> -1 //O-12.1
        | BinaryOp(x,op, y), Symbol v when x <> Symbol v -> compareExpressions (BinaryOp(x,op, y)) (BinaryOp(Symbol v,op, y)) //O-12.2
        | UnaryOp(op, x), Symbol v when x = Symbol v -> -1 //O-12.1
        | UnaryOp(op, x), Symbol v when x <> Symbol v -> compareExpressions (UnaryOp(op, x)) (UnaryOp(op, Symbol v)) //O-12.2        
        | _ -> -1 * (compareExpressions y' x') //O-13

// Simplification Operators
let rec simplifyPower x =
        let rec simplifyIntegerPower x =        
            match x with
            | BinaryOp(Number base',ToThePowerOf,Number(Integer i)) when base' <> NumberType.Zero -> Number (base'**(Integer i)) //SINTPOW-1
            | BinaryOp(base',ToThePowerOf,Number(Integer i)) when base' <> Number NumberType.Zero && i = 0I -> Number (Integer 1I) //SINTPOW-2
            | BinaryOp(base',ToThePowerOf,Number(Integer i)) when base' <> Number NumberType.Zero && i = 1I-> base' //SINTPOW-3
            | BinaryOp((BinaryOp(base',ToThePowerOf,power')),ToThePowerOf,Number(Integer i)) -> //SINTPOW-4
                 let p =  simplifyProduct (NaryOp(Product,[power'; Number(Integer i)])) 
                 match p with 
                 | Number (Integer ii) -> simplifyIntegerPower (BinaryOp(base',ToThePowerOf,p))
                 | _ -> (BinaryOp(base',ToThePowerOf,p)) 
            | BinaryOp((NaryOp(Product,eList)),ToThePowerOf,Number(Integer i)) -> //SINTPOW-5
                let eList' = List.map (fun x -> simplifyIntegerPower (BinaryOp(x,ToThePowerOf,Number(Integer i)))) eList
                simplifyProduct (NaryOp(Product,eList'))
            | _ -> x //SINTPOW-6        
        match x with
        | BinaryOp(base',ToThePowerOf,power') when base' = Number Undefined || power' = Number Undefined -> Number Undefined //SPOW-1
        | BinaryOp(base',ToThePowerOf,Number n) when base' = Number NumberType.Zero && n.isNegative = false -> Number NumberType.Zero //SPOW-2
        | BinaryOp(base',ToThePowerOf,power') when base' = Number NumberType.Zero -> Number Undefined //SPOW-2
        | BinaryOp(base',ToThePowerOf,power') when base' = Number NumberType.One -> Number NumberType.One //SPOW-3
        | BinaryOp(base',ToThePowerOf,Number (Integer n)) -> simplifyIntegerPower x //SPOW-4        
        | _ -> x //SPOW-5        

    and simplifyProduct p =      
        let rec simplifyProductRec p =
            match p with
            | [NaryOp(Product, x); NaryOp(Product, y)] -> mergeProducts x y //SPRDREC-2.1
            | [NaryOp(Product, x); a] -> mergeProducts x [a] //SPRDREC-2.2
            | [a; NaryOp(Product, x)] -> mergeProducts [a] x //SPRDREC-2.3
            | [a; b] ->
                match a, b with            
                | Number a, Number b -> //SPRDREC-1
                    let n = Number (a * b)
                    match n with
                    | Number x when x = NumberType.One -> [] //SPRDREC-1.1
                    | _ -> [n] //SPRDREC-1.1
                | Number a, b when a = NumberType.One -> [b] //SPRDREC-1.2.a
                | a, Number b when b = NumberType.One -> [a] //SPRDREC-1.2.b
                | a, b when Base b = Base a -> //SPRDREC-1.3
                    let s = simplifySum (NaryOp(Sum,[Exponent a; Exponent b]))
                    let p = simplifyPower (BinaryOp(Base a, ToThePowerOf, s))
                    match p with
                    | Number n when n = NumberType.One -> [] //SPRDREC-1.3
                    | _ -> [p] //SPRDREC-1.3
                | a, b when compareExpressions a b = 1 -> [b; a] //SPRDREC-1.4
                | _ -> [a; b] //SPRDREC-1.5
            | l when List.length l > 2 -> //SPRDREC-3
                let w = simplifyProductRec l.Tail
                match l.Head with
                | NaryOp(Product, x) -> mergeProducts x w //SPRDREC-3.1
                | _ -> mergeProducts [l.Head] w //SPRDREC-3.2
            | _ -> p        
        and mergeProducts a b = 
            let sort = List.sortWith (fun x -> compareExpressions x)
            let a' = sort a
            let b' = sort b
            match a', b' with
            | x, [] -> x //MPRD-1
            | [], y -> y //MPRD-2
            | x, y -> //MPRD-3
                let h = simplifyProductRec [x.Head; y.Head]
                match h with
                | [] -> mergeProducts x.Tail y.Tail //MPRD-3.1
                | [h'] -> h'::(mergeProducts x.Tail y.Tail) //MPRD-3.2
                | [a; b] when compareExpressions x.Head y.Head = -1 -> x.Head::(mergeProducts x.Tail y) //MPRD-3.3
                | _ -> y.Head::(mergeProducts x y.Tail) //MPRD-3.4
        match p with
        | NaryOp(Product,x) when List.exists (fun elem -> elem = Number Undefined) x || x.IsEmpty -> Number Undefined //SPRD-1
        | NaryOp(Product,x) when List.exists (fun elem -> elem = Number NumberType.Zero) x -> Number NumberType.Zero //SPRD-2
        | NaryOp(Product,x) when List.length x = 1 -> x.[0] //SPRD-3
        | NaryOp(Product,x) -> //SPRD-4
            let x' : Expression list = simplifyProductRec x
            match x' with
            | []-> Number NumberType.One //SPRD-4.3
            | [x1] -> x1 //SPRD-4.1
            | _ -> NaryOp(Product,x') //SPRD-4.2
        | _ -> Number Undefined

and simplifySum p = 
        let rec simplifySumRec s =
            match s with
            | [NaryOp(Sum, x); NaryOp(Sum, y)] -> mergeSums x y 
            | [NaryOp(Sum, x); a] -> mergeSums x [a] 
            | [a; NaryOp(Sum, x)] -> mergeSums [a] x 
            | [a'; b'] ->
                match a', b' with            
                | Number a, Number b -> 
                    let n = Number (a + b)
                    match n with
                    | Number x when x = NumberType.Zero -> [] 
                    | _ -> [n] 
                | Number a, b when a = NumberType.Zero -> [b] 
                | a, Number b when b = NumberType.Zero -> [a] 
                | a, b when Term a = Term b -> [(simplifyProduct (NaryOp(Product,[(simplifySum (NaryOp(Sum, [(Const a); (Const b)]))); Term a])))]
                | a, b when compareExpressions a b = 1 -> [b; a] 
                | _ -> [a'; b'] 
            | l when List.length l > 2 -> 
                let w = simplifySumRec l.Tail
                match l.Head with
                | NaryOp(Sum, x) -> mergeSums x w 
                | _ -> mergeSums [l.Head] w 
            | _ -> s
        and mergeSums a b = 
            let sort = List.sortWith (fun x -> compareExpressions x)
            let a' = sort a
            let b' = sort b
            match a', b' with
            | x, [] -> x //MPRD-1
            | [], y -> y //MPRD-2
            | x, y -> //MPRD-3
                let h = simplifySumRec [x.Head; y.Head]
                match h with
                | [] -> mergeSums x.Tail y.Tail //MPRD-3.1
                | [h'] -> h'::(mergeSums x.Tail y.Tail) //MPRD-3.2
                | [a; b] when compareExpressions x.Head y.Head = -1 -> x.Head::(mergeSums x.Tail y) //MPRD-3.3
                | _ -> y.Head::(mergeSums x y.Tail) //MPRD-3.4
        match p with
        | NaryOp(Sum,x) when List.exists (fun elem -> elem = Number Undefined) x || x.IsEmpty -> Number Undefined     
        | NaryOp(Sum,x) when List.length x = 1 -> x.[0] 
        | NaryOp(Sum,x) ->
            let x' : Expression list = simplifySumRec x
            match x' with
            | []-> Number NumberType.Zero 
            | [x1] -> x1 
            | _ -> NaryOp(Sum,x') 
        | _ -> Number Undefined    

let simplifyFactorial x = 
        match x with
        | UnaryOp(Factorial, a) when isNegativeNumber a -> UnaryOp(Factorial,a)
        | UnaryOp(Factorial, Number x) -> Number !*x
        | _ -> x

let simplifyExpression x = 
        let rec simplify a' =
            match a' with 
            | NaryOp(Sum,a) -> simplifySum (NaryOp(Sum,(List.map simplify a)))
            | NaryOp(Product,a) -> simplifyProduct (NaryOp(Product,(List.map simplify a)))
            | BinaryOp(a,ToThePowerOf,b) -> simplifyPower (BinaryOp(simplify a,ToThePowerOf,simplify b))
            | UnaryOp(Factorial,a) -> simplifyFactorial (simplify a)
            | _ -> a'
        simplify x

let negate x = simplifyProduct (NaryOp(Product, [Number (Integer -1I); x]))

type Expression with
    member this.isNumber = isNumber this    
    member this.isNegativeNumber = isNegativeNumber this
    member this.Base = Base this
    member this.Exponent = Exponent this
    member this.Term = Term this
    member this.Const = Const this

    static member compareExpressions x y = compareExpressions x y

    static member (~+) (x:Expression) = x    
    static member (~-) (x:Expression) = negate x
    static member (+) (x, y) = NaryOp(Sum,[x; y]) |> simplifySum    
    static member (*) (x, y) = NaryOp(Product,[x; y]) |> simplifyProduct
    static member (-) (x, y) = NaryOp(Sum,[x; -y]) |> simplifySum
    static member Pow (x, y) = BinaryOp (x, ToThePowerOf, y) |> simplifyPower       
    static member (/) (x, y) = NaryOp(Product,[x; (y**(-(Number NumberType.One)))]) |> simplifyProduct
    static member (!*) x = UnaryOp(Factorial,x) |> simplifyFactorial

let kind x = 
        match x with
        | Number (Integer i) -> "Integer"
        | Number (Rational r) -> "Rational"
        | _ -> "Undefined"
        // etc.

let numberOfOperands x = 
        match x with
        | Number n -> Undefined
        | Symbol v -> Undefined
        | BinaryOp (a,op,b) -> Integer 2I
        | UnaryOp (op,a) -> Integer 1I
        | NaryOp (op,aList) -> Integer (System.Numerics.BigInteger aList.Length)

let operand a b =
        match a, b with
        | UnaryOp (op,u), 1 -> u
        | BinaryOp (x,op,y), 1 -> x
        | BinaryOp (x,op,y), 2 -> y
        | NaryOp (op,u), n when n > 0 && n <= u.Length -> u.[n-1]
        | _ -> Number Undefined

let numberOfCompoundExpressions (x:Expression) = 
        let eNumber acc (n:Expression) = acc
        let eSymbol acc (v:Expression) = acc
        let eBinaryOp acc x = acc + 1
        let eUnaryOp acc x = acc + 1
        let eNaryOp acc x = acc + 1
        let acc = 0
        foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc x

let numberOfAtomicExpressions (x:Expression) = 
        let eNumber acc (n:Expression) = 1 + acc
        let eSymbol acc (v:Expression) = 1 + acc
        let eBinaryOp acc x = acc
        let eUnaryOp acc x = acc
        let eNaryOp acc x = acc
        let acc = 0
        foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc x

let subExpressions (x:Expression) = 
        let eNumber acc (n:Expression) = n::acc
        let eSymbol acc (v:Expression) = v::acc
        let eBinaryOp acc x = x::acc
        let eUnaryOp acc x = x::acc
        let eNaryOp acc x = x::acc
        let acc = []
        foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc x

let variables (x:Expression) = 
        let eNumber acc (n:Expression) = acc
        let eSymbol acc (v:Expression) = match v with | Symbol (Variable v) -> Variable v::acc | Symbol (Constant c) -> acc | _ -> acc
        let eBinaryOp acc x = acc
        let eUnaryOp acc x = acc
        let eNaryOp acc x = acc
        let acc = []
        foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc x
        |> Seq.distinct
        |> Seq.toList

// Structure-based Operators  
let freeOf u t =
        let completeSubExpressions = subExpressions u
        not (List.exists (fun x -> x = t) completeSubExpressions)

let substitute (y, t) u =
        let eNumber (n:Expression) = (match n = y with | true -> t | false -> n)
        let eSymbol (v:Expression) = (match v = y with | true -> t | false -> v)
        let eBinaryOp (a,op,b) = (match BinaryOp (a,op,b) = y with | true -> t | false -> BinaryOp (a,op,b))
        let eUnaryOp (op,a) = (match UnaryOp (op,a) = y with | true -> t | false -> UnaryOp (op,a))
        let eNaryOp (op,aList) = (match NaryOp (op,aList) = y with | true -> t | false -> NaryOp (op,aList))
        recurseExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp u
        //|> simplifyExpression

let substituteSequential (yList : (Expression*Expression) list) u =        
        List.fold (fun u' (x,y) -> substitute (x, y) u') u yList

let rec substituteConcurrent (yList : (Expression*Expression) list) = function
        | Number n ->
            let x = List.exists (fun x -> fst x = Number n) yList            
            match x with
            | true -> 
                let y = (List.find (fun x -> fst x = Number n) yList)
                (snd y)
            | false -> Number n
        | Symbol v ->
            let x = List.exists (fun x -> fst x = Symbol v) yList
            match x with
            | true -> 
                let y = (List.find (fun x -> fst x = Symbol v) yList)
                (snd y)
            | false -> (Symbol v)
        | BinaryOp (a,op,b) ->
            let x = List.exists (fun x -> fst x = BinaryOp (a,op,b)) yList
            match x with
            | true -> 
                let y = (List.find (fun x -> fst x = BinaryOp (a,op,b)) yList)
                (snd y)
            | false -> (BinaryOp (substituteConcurrent yList a,op,substituteConcurrent yList b))
        | UnaryOp (op,a) ->
            let x = List.exists (fun x -> fst x = UnaryOp (op,a)) yList
            match x with
            | true -> 
                let y = (List.find (fun x -> fst x = UnaryOp (op,a)) yList)
                (snd y)
            | false -> (UnaryOp (op,substituteConcurrent yList a))
        | NaryOp (op,aList) ->
            let x = List.exists (fun x -> fst x = NaryOp (op,aList)) yList
            match x with
            | true -> 
                let y = (List.find (fun x -> fst x = NaryOp (op,aList)) yList)
                (snd y)
            | false -> (NaryOp (op,List.map (fun x -> substituteConcurrent yList x) aList))

let rec (|GeneralMonomial|_|) (xList : Expression list) = function        
        | BinaryOp (a,ToThePowerOf,(Number (Integer b))) when //GME-3
            b > 1I && List.exists (fun x -> a = x) xList -> Some (BinaryOp (a,ToThePowerOf,(Number (Integer b))))
        | NaryOp (Product, a) -> //GME-4
            let test = List.forall (fun x -> (match x with | GeneralMonomial xList x -> true
                                                           | _ -> false) = true) a
            match test with
            | true -> Some (NaryOp (Product, a))
            | false -> None
        | a when List.forall (fun x -> freeOf (a) x ) xList || //GME-1
                 List.exists (fun x -> a = x) xList -> Some (a) //GME-2        
        | _-> None

let (|GeneralPolynomial|_|) (xList : Expression list) = function
        | NaryOp (Sum, a) -> //GPE-2
            match List.forall (fun x -> (match x with | GeneralMonomial xList x -> true                                                     
                                                      | _ -> false) = true) a with
            | true -> Some (NaryOp (Sum, a))
            | false -> None
        | x when (match x with | GeneralMonomial xList x -> true //GPE-1
                               | _ -> false) = true -> Some x
        | _-> None

let isPolynomialGPE x xList =
        match x with
        | GeneralPolynomial xList p -> true
        | _ -> false

////////////////////////////////////////////////////////////
//good code
let rec _degreeGPE u xList =         
        match isPolynomialGPE u xList with
        | false -> Undefined
        | true ->
            match u with
            | Number n when n = NumberType.Zero -> NegativeInfinity
            | NaryOp (Sum, aList) -> (List.rev (List.sortWith NumberType.compareNumbers (List.map (fun x -> _degreeGPE x xList) aList))).Head
            | _ -> 
                let powers = 
                    let eNumber acc (n:Expression) = match n = Number NumberType.Zero with | false -> (Integer 0I,Base n)::acc | true -> (NegativeInfinity,Base n)::acc
                    let eSymbol acc (v:Expression) = (Integer 1I,Base v)::acc
                    let eBinaryOp acc x = match x with | BinaryOp (Symbol(Variable a),ToThePowerOf,Number(Integer b)) -> (Integer b,Base x) :: acc | _ -> acc
                    let eUnaryOp acc x = acc
                    let eNaryOp acc x = acc
                    let acc = []                
                    foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc u
                let compare x' y' = NumberType.compareNumbers (fst x') (fst y')
                let out = List.rev(List.sortWith compare powers)
                List.collect (fun xx ->  
                    let x' = 
                        match List.exists (fun (a,b) -> xx = b) out with
                        | true -> List.filter (fun (a,b) -> xx = b ) out
                        | false -> [NumberType.Zero,xx]
                    [(List.rev(List.sortWith compare x')).Head]) xList
                |> List.fold (fun acc (a,b) -> acc + a) NumberType.Zero

let degreeGPE u xList = 
        let x = _degreeGPE u xList
        match x = NumberType.Zero with | true -> Undefined | false -> x

////////////////////////////////////////////////////////////
//Bad code

let rec degreeGPEBad u xList =         
        match isPolynomialGPE u xList with
        | false -> Undefined
        | true ->
            match u with
            | Number n when n = NumberType.Zero -> NegativeInfinity
            | NaryOp (Sum, aList) -> (List.rev (List.sortWith NumberType.compareNumbers (List.map (fun x -> degreeGPE x xList) aList))).Head
            | _ -> 
                let powers = 
                    let eNumber acc (n:Expression) = match n = Number NumberType.Zero with | false -> (Integer 0I,Base n)::acc | true -> (NegativeInfinity,Base n)::acc
                    let eSymbol acc (v:Expression) = (Integer 1I,Base v)::acc
                    let eBinaryOp acc x = match x with | BinaryOp (Symbol(Variable a),ToThePowerOf,Number(Integer b)) -> (Integer b,Base x) :: acc | _ -> acc
                    let eUnaryOp acc x = acc
                    let eNaryOp acc x = acc
                    let acc = []                
                    foldExpression eNumber eSymbol eBinaryOp eUnaryOp eNaryOp acc u
                let compare x' y' = NumberType.compareNumbers (fst x') (fst y')
                let out = List.rev(List.sortWith compare powers)
                let check x = match x = NumberType.Zero with | true -> Undefined | false -> x
                List.collect (fun xx ->  
                    let x' = 
                        match List.exists (fun (a,b) -> xx = b) out with
                        | true -> List.filter (fun (a,b) -> xx = b ) out
                        | false -> [NumberType.Zero,xx]
                    [(List.rev(List.sortWith compare x')).Head]) xList
                |> List.fold (fun acc (a,b) -> acc + a) NumberType.Zero
                |> check //if you comment this line to get the correct answer
                         //otherwise it returns the wrong answer.

//////////////////////////////////////////
//Tests
let y = Symbol (Variable "y")
let z = Symbol (Variable "z")
let a = Symbol (Variable "a")
let b = Symbol (Variable "b")
let c = Symbol (Variable "c")
let three = Number (Integer 3I)
let two = Number (Integer 2I)

let testD = two*z + a*z + three*y + b*y + c

degreeGPE testD [y]

degreeGPEBad testD [y]
dsyme commented 8 years ago

@flideros I don't really understand the issue. When you add "check" to the code, it only applies to one (recursive) case of the match. This means it will

(a) apply to the results of some recursive calls (if they happen to go through that branch) and (b) may not apply to the result of the outermost (first) call (depending on whether it goes through that branch, which I think it doesn't)

You then move "check" outside the function, when it will

(c) definitely apply to the first iteration

Secondly, in your "bad" version the recursive call calls the "good" version.

When I changed your "bad" code to only apply check on the first call, and not recursive calls, the results of OK and Bad code were the same


let rec degreeGPEBad first u xList =         
        match isPolynomialGPE u xList with
        | false -> Undefined |> (if first then check else id)
        | true ->
            match u with
            | Number n when n = NumberType.Zero -> NegativeInfinity |> (if first then check else id)
            | NaryOp (Sum, aList) -> (List.rev (List.sortWith NumberType.compareNumbers (List.map (fun x -> degreeGPEBad false x xList) aList))).Head |> (if first then check else id)
            | _ ->
dsyme commented 8 years ago

I'll close this for now. If you can get this to a standalone repro that is under 50 lines I'll look again :)

flideros commented 8 years ago

You solved it. The recursive call was the culprit. Thank you for you patience.

dsyme commented 8 years ago

No problem :) Though it will make me more insistent on minimized repros when others submit future bug reports :)