Menu Close

Aritmética lunar

En la aritmética lunar la suma y el producto se hace como en la terrícola salvo que sus tablas de sumar y de multiplicar son distintas. La suma lunar de dos dígitos es su máximo (por ejemplo, 1 + 3 = 3 y 7 + 4 = 7) y el producto lunar de dos dígitos es su mínimo (por ejemplo, 1 x 3 = 1 y 7 x 4 = 4). Por tanto,

     3 5 7        3 5 7
   +   6 4      x   6 4
   -------      -------
     3 6 7        3 4 4
                3 5 6
                -------
                3 5 6 4

Definir las funciones

   suma     :: Integer -> Integer -> Integer
   producto :: Integer -> Integer -> Integer

tales que

  • (suma x y) es la suma lunar de x e y. Por ejemplo,
     suma 357 64  ==  367
     suma 64 357  ==  367
     suma 1 3     ==  3
     suma 7 4     ==  7
  • (producto x y) es el producto lunar de x e y. Por ejemplo,
     producto 357 64  ==  3564
     producto 64 357  ==  3564
     producto 1 3     ==  1
     producto 7 4     ==  4

Comprobar con QuickCheck que la suma y el producto lunar son conmutativos.

Soluciones

import Test.QuickCheck
 
suma :: Integer -> Integer -> Integer
suma 0 0 = 0
suma x y = max x2 y2 + 10 * suma x1 y1
  where (x1,x2) = x `divMod` 10
        (y1,y2) = y `divMod` 10
 
producto :: Integer -> Integer -> Integer
producto 0 _ = 0
producto x y = productoDigitoNumero x2 y `suma` (10 * producto x1 y)
  where (x1, x2) = x `divMod` 10
 
-- (productoDigitoNumero d x) es el producto del dígito d por el número
-- x. Por ejemplo,
--    productoDigitoNumero 4 357  ==  344
--    productoDigitoNumero 6 357  ==  356
productoDigitoNumero :: Integer -> Integer -> Integer
productoDigitoNumero _ 0 = 0
productoDigitoNumero d x = min d x2 + 10 * productoDigitoNumero d x1
  where (x1, x2) = x `divMod` 10
 
-- La propiedad es
prop_conmutativa :: Positive Integer -> Positive Integer -> Bool
prop_conmutativa (Positive x) (Positive y) =
  suma x y == suma y x &&
  producto x y == producto y x
 
-- La comprobación es
--    λ> quickCheck prop_conmutativa
--    +++ OK, passed 100 tests.

Pensamiento

Cantad conmigo en coro: saber, nada sabemos,
de arcano mar vinimos, a ignota mar iremos …
La luz nada ilumina y el sabio nada enseña.
¿Qué dice la palabra? ¿Qué el agua de la peña?

Antonio Machado

3 soluciones de “Aritmética lunar

  1. frahidzam
    import Test.QuickCheck
     
    suma :: Integer -> Integer -> Integer
    suma x y
      | length xs > length ys = aEntero (sumaAux x y ++ drop b (reverse xs))
      | otherwise             = aEntero (sumaAux x y ++ drop a (reverse ys))
     where xs            = digitos x
           ys            = digitos y
           sumaAux x y = zipWith max (reverse xs) (reverse ys)
           a             = length xs
           b             = length ys
     
    digitos :: Integer -> [Integer]
    digitos n = [read [x] | x <- show n]
     
    aEntero :: [Integer] -> Integer
    aEntero xs = sum [a*10^b | (a,b) <- zip xs [0..]]
     
    producto :: Integer -> Integer -> Integer
    producto x y = sumaL [productoP x a | a <- reverse (digitos y)]
     
    productoP :: Integer -> Integer -> Integer
    productoP x y = aEntero (reverse [min a y | a <- digitos x])
     
    sumaL :: [Integer] -> Integer
    sumaL []       = 0
    sumaL [x]      = x
    sumaL (x:y:xs) = suma (suma x (10*y))  (sumaL (map  (*100) xs))
     
    prop_sumaLunar :: Integer -> Integer -> Property
    prop_sumaLunar a b =
      a >= 0 && b >= 0 ==> suma a b == suma b a
     
    prop_productoLunar :: Integer -> Integer -> Property
    prop_productoLunar a b =
      a >= 0 && b >= 0 ==> producto a b == producto b a
  2. adogargon
    suma :: Integer -> Integer -> Integer
    suma x y = maximum [x,y]
     
    digitos :: Integer -> [Integer]
    digitos x = [read [y] | y <- show x ]
     
    producto :: Integer -> Integer -> Integer
    producto x y = minimum [x,y]
     
    lee :: [Integer] -> Integer
    lee []     = 0
    lee (x:xs) = x * 10 ^ length xs + lee xs
     
    sumaLunar ::  Integer -> Integer -> Integer
    sumaLunar x y = lee (reverse (zipWith suma xs ys))
      where xs = completa (reverse (digitos x)) (length (digitos y))
            ys = completa (reverse (digitos y)) (length (digitos x))
     
    completa :: [Integer] -> Int -> [Integer]
    completa xs n
      | length xs >= n = xs
      | otherwise      = xs ++ replicate (n - length xs) 0 
     
    productoLunar :: Integer -> Integer -> Integer
    productoLunar x y =
      foldl1 sumaLunar
             (map lee (zipWith completa yss [length (digitos y)..]))
      where yss = [map (producto z) (digitos y) | z <- reverse (digitos x)]
     
    prop :: Integer -> Integer -> Property 
    prop x y =
      x >= 0 && y >= 0 ==>
      sumaLunar x y == sumaLunar y x &&
      productoLunar y x == productoLunar x y
  3. luipromor
    suma :: Integer -> Integer -> Integer
    suma x y
      | (length . aux) x == (length . aux) y =
        (read . concat) (map (show . f) (zip (aux x) (aux y)))
      | (length . aux) x >= (length . aux) y =
        g (head (aux x) : aux (suma ((g . tail . aux) x) y))
      | otherwise =
        g (head (aux y) : aux (suma x ((g . tail . aux) y)))
      where aux x = [read [n] :: Integer | n <- show x]
            f (a,b) | a < b     = b
                    | otherwise = a
            g :: [Integer] -> Integer
            g = read . concatMap show 
     
    producto :: Integer -> Integer -> Integer
    producto  x y = h (aux7 x (aux y))
      where aux7 _ []     = []
            aux7 x (y:ys) = f x (y:ys) : aux7 x ys
            aux x = [read [n] :: Integer | n <- show x]
            h (x:xs) = suma x (h xs)
            h []     = 0
            f :: Integer -> [Integer] -> Integer
            f x (y:ys) = 10 ^ length ys *  g (aux2 y (aux x))  
              where g = read . concatMap show
                    aux2 _ []     = []
                    aux2 y (x:xs) = min y x : aux2 y xs
     
    prop_suma_producto  :: Integer -> Integer -> Property
    prop_suma_producto x y =
      x >= 0 && y >= 0 ==>
      suma x y == suma y x &&
      producto x y == producto y x

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.