fork download
copy 
  1. -- Apply a pricing procedure = a list of percentual or absolute additions
  2. --   forwards ("compute")
  3. --   and backwards ("resolve" - which is the point here).
  4.  
  5. -- Each condition is a linear function on any of the formerly computed,
  6. -- intermediate terms, so a condition is a function [a] -> a
  7.  
  8. percent :: Fractional a => a -> a -> a
  9. percent p x = p * x / 100
  10.  
  11. -- Need a data type for conditions,
  12. -- in order to distinguish absolute from relative conditions
  13. data Condition a  = RelativeCondition {apply :: a}
  14.                   | AbsoluteCondition {apply :: a}
  15.  
  16. -- predicate function for detecting relative types
  17. isRelative :: Condition a -> Bool
  18. isRelative (RelativeCondition _) = True
  19. isRelative _                     = False
  20.  
  21.  
  22. condRel, condRelBase
  23.     :: Fractional a => a -> Condition ([a] -> a)
  24. condAbs
  25.     :: a -> Condition ([a] -> a)
  26. condRel p     = RelativeCondition (\ x ->  percent p ( last x ) )
  27. condRelBase p = RelativeCondition (\ x ->  percent p ( head x ) )
  28. condAbs q     = AbsoluteCondition (\ x -> q )
  29.  
  30.  
  31. -- How to compute a scheme:
  32. -- Apply functions successively, starting with base price
  33. compute :: Num a => [Condition ([a] -> a)] -> a -> a
  34. compute scheme base = last $ foldl (\x f -> x ++ [ last x + apply f x ] ) [base] scheme
  35.  
  36. -- How to resolve a scheme
  37. resolve scheme result =
  38.    ( result - compute scheme 0 )
  39.      / compute (reduced scheme) 1
  40.  
  41. -- A sample calculation scheme
  42. scheme :: Fractional a => [Condition ([a] -> a)]
  43. scheme = [
  44.  condAbs      10.00,
  45.  condRel      5.00,
  46.  condRelBase  3.25,
  47.  condAbs     20.00,
  48.  condRel      3.00,
  49.  condRelBase  2.00,
  50.  condRel      7.00,
  51.  condAbs     10.00
  52.  ]
  53.  
  54. --- Reduced scheme consists only of the relative conditions
  55. reduced :: [Condition a] -> [Condition a]
  56. reduced scheme = filter isRelative scheme
  57.  
  58.  
  59. -- Test (should reproduce the input (100) )
  60. main = do
  61.     print $ resolve scheme $ compute scheme 100
  62.  
Success #stdin #stdout 0s 6272KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
100.0
https://ideone.com/2rJO9C
Reverse a pricing procedure (in Haskell) -- Redux
language:
Haskell (ghc 8.4.4)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!