0votos

Cobro de Productos comprados en Haskell

por josejuan hace 2 años

Una generalización del problema, permite cualquier tipo y número de productos y aplicar cualquier tipo de regla para aplicar descuento (ej. que dos productos sean de la misma marca), también genera el mejor ticket posible aplicando todos los descuentos posibles y mostrando el ticket de la mejor forma posible (agrupando siempre que se pueda).

descuento de la compra en total

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
{-# LANGUAGE FlexibleContexts #-} 
{-# LANGUAGE TupleSections #-} 
{-# LANGUAGE GeneralizedNewtypeDeriving #-} 
import Data.List 
import Data.Function 
import Data.List.Extra 
import qualified Data.List.Ordered as LO 
import Control.Monad 
import Control.Monad.Writer 
 
-- Un importe 
newtype Importe = Importe Double deriving (Eq, Ord, Num, Fractional) 
instance Show Importe where show (Importe x) = show x 
 
-- Un producto con un código, nombre y precio unitario 
data Producto = Producto { prod_id      :: Integer 
                         , prod_nombre  :: String 
                         , prod_precio  :: Importe } deriving (Eq, Ord, Show) 
 
-- Una compra es un conjunto de productos seleccionados por el cliente 
newtype Compra = Compra { compra :: [Producto] } deriving (Eq, Ord, Show) 
 
-- Un porcentaje 
newtype Pct = Pct Double deriving (Eq, Ord, Num, Fractional, Show) 
 
-- Un descuento tiene un nombre y una regla que, dado un conjunto de productos, aplica el descuento 
data Descuento = Descuento { desc_nombre    :: String 
                           , desc_calcula   :: Compra -> Maybe [(Producto, Pct)] } 
instance Show Descuento where show = desc_nombre 
 
-- Un ticket es una compra con un descuento aplicado 
newtype Ticket = Ticket { ticket :: [(Compra, Descuento)] } 
 
instance Show Ticket where 
    show (Ticket cs) = let cd = [(importe d c, sum (prod_precio <$> ps), ps, d) | (c@(Compra ps), d) <- cs] 
                           linea (id, it, ps, d) = ("--- " ++ desc_nombre d ++ " -----------"): map prods (group $ sort ps) 
                                                           ++ ["· · · · · · · · · · · · · · ·" 
                                                              ,"      importe ....... : " ++ show it 
                                                              ,"      descuento ..... : -" ++ show (it - id) 
                                                              ,"      subtotal ...... : " ++ show id] 
                           prods xs@((Producto k n i):_) = "#" ++ show k ++ ": " ++ show (length xs) ++ " x " ++ n ++ "         " ++ show (sum $ prod_precio <$> xs) 
                           totalD = sum . map (\(a, _, _, _) -> a) 
                           totalP = sum . map (\(_, a, _, _) -> a) 
                       in  unlines (concatMap linea cd 
                                               ++ ["**********************************" 
                                                  ,"      Importe ....... : " ++ show (totalP cd) 
                                                  ,"      Descuentos .... : -" ++ show (totalP cd - totalD cd) 
                                                  ,"      TOTAL a pagar . : " ++ show (totalD cd)]) 
                                     
 
-- Calcula todas las formas diferentes de agrupar los productos de la compra 
grupos :: Compra -> [[Compra]] 
grupos = LO.nub . sort . map (sort . map (Compra . sort)) . g . permutations . compra 
    where g :: [[Producto]] -> [[[Producto]]] 
          g [] = [] 
          g (x:xs) = t x ++ g xs 
          t [] = [[]] 
          t xs = concat [map (ys:) (t zs) | i <- [1 .. length xs], let (ys, zs) = splitAt i xs] 
 
-- Aplica un descuento a una compra obteniendo el total final 
importe :: Descuento -> Compra -> Importe 
importe (Descuento _ f) = maybe 1e20 (sum . map (\(Producto _ _ (Importe i), Pct p) -> Importe (i * (1 - p)))) . f 
 
-- Calcula el mejor descuento para una compra dada 
mejorDescuento :: [Descuento] -> Compra -> (Compra, (Importe, Descuento)) 
mejorDescuento ds c = (c, head $ sortOn fst $ map (\d -> (importe d c, d)) ds) 
 
-- Calcula el mejor ticket de una compra 
mejorTicket :: [Descuento] -> Compra -> Ticket 
mejorTicket ds c = let g = map (total . map (mejorDescuento ds)) $ grupos c 
                       total cs = (sum $ map (fst . snd) cs, map (\(c, (_, d)) -> (c, d)) cs) 
                   in  Ticket $ snd $ head $ sortOn (\(f, cs) -> (f, length cs)) g 
                        
 
-- Helpers 
cuando :: ([Producto] -> Bool) -> ([Producto] -> [(Producto, Pct)]) -> Compra -> Maybe [(Producto, Pct)] 
cuando p d (Compra ps) = if p ps then Just (d ps) else Nothing 
 
aplica' :: (Producto -> Bool) -> (Producto -> Pct) -> [(Producto, Pct)] -> [(Producto, Pct)] 
aplica' p d ps = [if o > o' then (x, o) else (x, o') | (x, o) <- ps, let o' = if p x then d x else 0] 
 
aplica :: [(Producto -> Bool, Producto -> Pct)] -> [Producto] -> [(Producto, Pct)] 
aplica fs ps = foldr (uncurry aplica') (map (,0) ps) fs 
 
 
 
{- 
 
    Por ejemplo, se puede ver como se generan 3 tickets para 3 compras diferentes 
    en que se obtiene el mejor descuento posible y con la mejor agrupación (hace 
    el ticket lo más pequeño posible). 
 
-} 
 
melón   = Producto 1 "Melón"    34.5 
salmón  = Producto 2 "Salmón"   54.75 
limón   = Producto 3 "Limón"    12.5 
 
descuentos = [ Descuento "(sin descuento)" $ 
                    Just . map (, 0) . compra 
             , Descuento "Melón -10%" $ 
                    cuando (elem 1 . map prod_id) (aplica [((1==) . prod_id, const 0.1)]) 
             , Descuento "Melón con salmón -10% (sólo al salmón)" $ 
                    cuando ((\ps -> 1 `elem` ps && 2 `elem` ps). map prod_id) (aplica [((2==) . prod_id, const 0.1)]) 
 
main = do 
    putStrLn $ show $ mejorTicket descuentos $ Compra [melón] 
    putStrLn $ show $ mejorTicket descuentos $ Compra [melón, salmón] 
    putStrLn $ show $ mejorTicket descuentos $ Compra [melón, melón, melón, melón, salmón] 
 
{- 
 
#1: 1 x Melón         34.5 
· · · · · · · · · · · · · · · 
      importe ....... : 34.5 
      descuento ..... : -3.45 
      subtotal ...... : 31.05 
********************************** 
      Importe ....... : 34.5 
      Descuentos .... : -3.45 
      TOTAL a pagar . : 31.05 
 
 
 
 
 
 
--- Melón con salmón -10% (sólo al salmón) ----------- 
#1: 1 x Melón         34.5 
#2: 1 x Salmón         54.75 
· · · · · · · · · · · · · · · 
      importe ....... : 89.25 
      descuento ..... : -5.475 
      subtotal ...... : 83.775 
********************************** 
      Importe ....... : 89.25 
      Descuentos .... : -5.475 
      TOTAL a pagar . : 83.775 
 
 
 
 
 
 
--- Melón -10% ----------- 
#1: 3 x Melón         103.5 
· · · · · · · · · · · · · · · 
      importe ....... : 103.5 
      descuento ..... : -10.35 
      subtotal ...... : 93.15 
--- Melón con salmón -10% (sólo al salmón) ----------- 
#1: 1 x Melón         34.5 
#2: 1 x Salmón         54.75 
· · · · · · · · · · · · · · · 
      importe ....... : 89.25 
      descuento ..... : -5.475 
      subtotal ...... : 83.775 
********************************** 
      Importe ....... : 192.75 
      Descuentos .... : -15.825 
      TOTAL a pagar . : 176.925 
       
       
       
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.