Menu Close

Etiqueta: Data.Map

Número de ocurrencias de elementos

Definir la función

   ocurrenciasElementos :: Ord a => [a] -> [(a,Int)]

tal que (ocurrencias xs) es el conjunto de los elementos de xs junto con sus números de ocurrencias. Por ejemplo,

   ocurrenciasElementos1 [3,2,3,1,2,3,5,3] == [(3,4),(2,2),(1,1),(5,1)]
   ocurrenciasElementos1 "tictac"          == [('t',2),('i',1),('c',2),('a',1)]

Soluciones

import Data.List (group, nub, sort)
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
ocurrenciasElementos1 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos1 xs =
  [(x,ocurrencias x xs) | x <- nub xs]
 
-- (ocurrencias x xs) es el número de ocurrencias de x en xs. Por
-- ejemplo,
--    ocurrencias 'a' "Salamanca"  ==  4
ocurrencias :: Ord a => a -> [a] -> Int
ocurrencias x xs = length (filter (==x) xs)
 
-- 2ª solución
-- ===========
 
ocurrenciasElementos2 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos2 xs = map ocurrencias (nub xs)
  where ocurrencias x = (x,fromJust (lookup x (frecuencias xs)))
 
-- (frecuencias xs) es la lista ordenada de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    frecuencias [3,2,3,1,2,3,5,3]  ==  [(1,1),(2,2),(3,4),(5,1)]
frecuencias :: Ord a => [a] -> [(a, Int)]
frecuencias xs = [(head ys, length ys) | ys <- group (sort xs)]
 
-- 3ª solución
-- ===========
 
ocurrenciasElementos3 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos3 xs = map ocurrencias (nub xs)
  where diccionario   = dicFrecuencias xs
        ocurrencias x = (x, diccionario M.! x)
 
-- (dicFrecuencias xs) es el diccionario de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    λ> dicFrecuencias [3,2,3,1,2,3,5,3]
--    fromList [(1,1),(2,2),(3,4),(5,1)]
dicFrecuencias :: Ord a => [a] -> M.Map a Int
dicFrecuencias xs = M.fromListWith (+) (zip xs (repeat 1))
 
-- 4ª solución
-- ===========
 
ocurrenciasElementos4 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos4 = foldl aux []
  where
    aux [] y                     = [(y,1)]
    aux ((x,k):xs) y | x == y    = (x, k + 1) : xs
                     | otherwise = (x, k) : aux xs y
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_ocurrenciasElementos :: [Integer] -> Bool
prop_ocurrenciasElementos xs =
  all (== (ocurrenciasElementos1 xs))
      [f xs | f <- [ocurrenciasElementos2,
                    ocurrenciasElementos3,
                    ocurrenciasElementos4]]
 
-- La comprobación es
--    λ> quickCheck prop_ocurrenciasElementos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> last (ocurrenciasElementos1 (show (product [1..10^5])))
--    ('5',42935)
--    (7.93 secs, 11,325,169,512 bytes)
--    λ> last (ocurrenciasElementos2 (show (product [1..10^5])))
--    ('5',42935)
--    (8.46 secs, 11,750,911,592 bytes)
--    λ> last (ocurrenciasElementos3 (show (product [1..10^5])))
--    ('5',42935)
--    (8.29 secs, 11,447,015,896 bytes)
--    λ> last (ocurrenciasElementos4 (show (product [1..10^5])))
--    ('5',42935)
--    (9.97 secs, 12,129,527,912 bytes)

El código se encuentra en GitHub.

Sistema factorádico de numeración

El sistema factorádico es un sistema numérico basado en factoriales en el que el n-ésimo dígito, empezando desde la derecha, debe ser multiplicado por n! Por ejemplo, el número “341010” en el sistema factorádico es 463 en el sistema decimal ya que

   3×5! + 4×4! + 1×3! + 0×2! + 1×1! + 0×0! = 463

En este sistema numérico, el dígito de más a la derecha es siempre 0, el segundo 0 o 1, el tercero 0,1 o 2 y así sucesivamente.

Con los dígitos del 0 al 9 el mayor número que podemos codificar es el 10!-1 = 3628799. En cambio, si lo ampliamos con las letras A a Z podemos codificar hasta 36!-1 = 37199332678990121746799944815083519999999910.

Definir las funciones

   factoradicoAdecimal :: String -> Integer
   decimalAfactoradico :: Integer -> String

tales que

  • (factoradicoAdecimal cs) es el número decimal correspondiente al número factorádico cs. Por ejemplo,
     λ> decimalAfactoradico 463
     "341010"
     λ> decimalAfactoradico 2022
     "2441000"
     λ> decimalAfactoradico 36288000
     "A0000000000"
     λ> map decimalAfactoradico [1..10]
     ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     λ> decimalAfactoradico 37199332678990121746799944815083519999999
     "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"
  • (decimalAfactoradico n) es el número factorádico correpondiente al número decimal n. Por ejemplo,
     λ> factoradicoAdecimal "341010"
     463
     λ> factoradicoAdecimal "2441000"
     2022
     λ> factoradicoAdecimal "A0000000000"
     36288000
     λ> map factoradicoAdecimal ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     [1,2,3,4,5,6,7,8,9,10]
     λ> factoradicoAdecimal "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"
     37199332678990121746799944815083519999999

Comprobar con QuickCheck que, para cualquier entero positivo n,

   factoradicoAdecimal (decimalAfactoradico n) == n

Soluciones

{-# LANGUAGE TupleSections #-}
 
import Data.List (genericIndex, genericLength)
import qualified Data.Map as M
import Test.QuickCheck
import Test.Hspec
 
-- 1ª solución
-- ===========
 
factoradicoAdecimal1 :: String -> Integer
factoradicoAdecimal1 cs = sum (zipWith (*) xs ys)
  where xs = map caracterAentero cs
        n  = length cs
        ys = reverse (take n facts)
 
-- (caracterAentero c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero '0'  ==  0
--    caracterAentero '1'  ==  1
--    caracterAentero '9'  ==  9
--    caracterAentero 'A'  ==  10
--    caracterAentero 'B'  ==  11
--    caracterAentero 'Z'  ==  35
caracterAentero :: Char -> Integer
caracterAentero c =
  head [n | (n,x) <- zip [0..] caracteres, x == c]
 
-- caracteres es la lista de caracteres
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']
caracteres :: String
caracteres = ['0'..'9'] ++ ['A'..'Z']
 
-- facts es la lista de los factoriales. Por ejemplo,
--    λ> take 12 facts
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
facts :: [Integer]
facts = scanl (*) 1 [1..]
 
decimalAfactoradico1 :: Integer -> String
decimalAfactoradico1 n = aux n (reverse (takeWhile (<=n) facts))
  where aux 0 xs     = ['0' | _ <- xs]
        aux m (x:xs) = enteroAcaracter (m `div` x) : aux (m `mod` x) xs
 
-- (enteroAcaracter k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter 0   ==  '0'
--    enteroAcaracter 1   ==  '1'
--    enteroAcaracter 9   ==  '9'
--    enteroAcaracter 10  ==  'A'
--    enteroAcaracter 11  ==  'B'
--    enteroAcaracter 35  ==  'Z'
enteroAcaracter :: Integer -> Char
enteroAcaracter k = caracteres `genericIndex` k
 
-- 2ª solución
-- ===========
 
factoradicoAdecimal2 :: String -> Integer
factoradicoAdecimal2 cs = sum (zipWith (*) xs ys)
    where xs = map caracterAentero2 cs
          n  = length cs
          ys = reverse (take n facts)
 
-- (caracterAentero2 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero2 '0'  ==  0
--    caracterAentero2 '1'  ==  1
--    caracterAentero2 '9'  ==  9
--    caracterAentero2 'A'  ==  10
--    caracterAentero2 'B'  ==  11
--    caracterAentero2 'Z'  ==  35
caracterAentero2 :: Char -> Integer
caracterAentero2 c = caracteresEnteros M.! c
 
-- caracteresEnteros es el diccionario cuyas claves son los caracteres y
-- las claves son los números de 0 a 35.
caracteresEnteros :: M.Map Char Integer
caracteresEnteros = M.fromList (zip (['0'..'9'] ++ ['A'..'Z']) [0..])
 
decimalAfactoradico2 :: Integer -> String
decimalAfactoradico2 n = aux n (reverse (takeWhile (<=n) facts))
    where aux 0 xs     = ['0' | _ <- xs]
          aux m (x:xs) = enteroAcaracter2 (m `div` x) : aux (m `mod` x) xs
 
-- (enteroAcaracter2 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter2 0   ==  '0'
--    enteroAcaracter2 1   ==  '1'
--    enteroAcaracter2 9   ==  '9'
--    enteroAcaracter2 10  ==  'A'
--    enteroAcaracter2 11  ==  'B'
--    enteroAcaracter2 35  ==  'Z'
enteroAcaracter2 :: Integer -> Char
enteroAcaracter2 k = enterosCaracteres M.! k
 
-- enterosCaracteres es el diccionario cuyas claves son los número de 0
-- a 35 y las claves son los caracteres.
enterosCaracteres :: M.Map Integer Char
enterosCaracteres = M.fromList (zip [0..] caracteres)
 
-- 3ª solución
-- ===========
 
factoradicoAdecimal3 :: String -> Integer
factoradicoAdecimal3 cs =
  sum (zipWith (*) facts (reverse (map caracterAentero3 cs)))
 
-- (caracterAentero3 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero3 '0'  ==  0
--    caracterAentero3 '1'  ==  1
--    caracterAentero3 '9'  ==  9
--    caracterAentero3 'A'  ==  10
--    caracterAentero3 'B'  ==  11
--    caracterAentero3 'Z'  ==  35
caracterAentero3 :: Char -> Integer
caracterAentero3 c =
  genericLength (takeWhile (/= c) caracteres)
 
decimalAfactoradico3 :: Integer -> String
decimalAfactoradico3 n = aux "" 2 (n, 0)
  where aux s _ (0, 0) = s
        aux s n (d, r) = aux (enteroAcaracter3 r: s) (n + 1) (d `divMod` n)
 
-- (enteroAcaracter3 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter3 0   ==  '0'
--    enteroAcaracter3 1   ==  '1'
--    enteroAcaracter3 9   ==  '9'
--    enteroAcaracter3 10  ==  'A'
--    enteroAcaracter3 11  ==  'B'
--    enteroAcaracter3 35  ==  'Z'
enteroAcaracter3 :: Integer -> Char
enteroAcaracter3 n =
  caracteres !! (fromInteger n)
 
-- 4ª solución
-- ===========
 
factoradicoAdecimal4 :: String -> Integer
factoradicoAdecimal4 =
  sum . zipWith (*) facts . reverse . map caracterAentero4
 
-- (caracterAentero4 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero4 '0'  ==  0
--    caracterAentero4 '1'  ==  1
--    caracterAentero4 '9'  ==  9
--    caracterAentero4 'A'  ==  10
--    caracterAentero4 'B'  ==  11
--    caracterAentero4 'Z'  ==  35
caracterAentero4 :: Char -> Integer
caracterAentero4 =
  genericLength . flip takeWhile caracteres . (/=)
 
decimalAfactoradico4 :: Integer -> String
decimalAfactoradico4 = f "" 2 . (, 0)
  where f s _ (0, 0) = s
        f s n (d, r) = f (enteroAcaracter4 r: s) (n + 1) (d `divMod` n)
 
-- (enteroAcaracter4 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter4 0   ==  '0'
--    enteroAcaracter4 1   ==  '1'
--    enteroAcaracter4 9   ==  '9'
--    enteroAcaracter4 10  ==  'A'
--    enteroAcaracter4 11  ==  'B'
--    enteroAcaracter4 35  ==  'Z'
enteroAcaracter4 :: Integer -> Char
enteroAcaracter4 = (caracteres `genericIndex`)
 
-- Propiedad de inverso
-- ====================
 
prop_factoradico :: Integer -> Property
prop_factoradico n =
  n >= 0 ==>
  factoradicoAdecimal1 (decimalAfactoradico1 n) == n &&
  factoradicoAdecimal2 (decimalAfactoradico2 n) == n &&
  factoradicoAdecimal3 (decimalAfactoradico3 n) == n &&
  factoradicoAdecimal4 (decimalAfactoradico4 n) == n
 
-- La comprobación es
--    λ> quickCheck prop_factoradico
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (decimalAfactoradico1 (10^300000))
--    68191
--    (2.46 secs, 9,088,634,744 bytes)
--    λ> length (decimalAfactoradico2 (10^300000))
--    68191
--    (2.36 secs, 9,088,634,800 bytes)
--    λ> length (decimalAfactoradico3 (10^300000))
--    68191
--    (2.18 secs, 4,490,856,416 bytes)
--    λ> length (decimalAfactoradico4 (10^300000))
--    68191
--    (1.98 secs, 4,490,311,536 bytes)
--
--    λ> length (show (factoradicoAdecimal1 (show (10^50000))))
--    213237
--    (0.93 secs, 2,654,156,680 bytes)
--    λ> length (show (factoradicoAdecimal2 (show (10^50000))))
--    213237
--    (0.51 secs, 2,633,367,168 bytes)
--    λ> length (show (factoradicoAdecimal3 (show (10^50000))))
--    213237
--    (0.93 secs, 2,635,792,192 bytes)
--    λ> length (show (factoradicoAdecimal4 (show (10^50000))))
--    213237
--    (0.43 secs, 2,636,996,848 bytes)

El código se encuentra en GitHub.

Operaciones con polinomios como diccionarios

Los polinomios se pueden representar mediante diccionarios con los exponentes como claves y los coeficientes como valores.

El tipo de los polinomios con coeficientes de tipo a se define por

   type Polinomio a = M.Map Int a

Dos ejemplos de polinomios (que usaremos en los ejemplos) son

   3 + 7x - 5x^3
   4 + 5x^3 + x^5

se definen por

  ejPol1, ejPol2 :: Polinomio Int
  ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
  ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

Definir las funciones

   sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
   multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
   multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a

tales que

  • (sumaPol p q) es la suma de los polinomios p y q. Por ejemplo,
     λ> sumaPol ejPol1 ejPol2
     fromList [(0,7),(1,7),(5,1)]
     λ> sumaPol ejPol1 ejPol1
     fromList [(0,6),(1,14),(3,-10)]
  • (multPorTerm (n,a) p) es el producto del término ax^n por p. Por ejemplo,
     λ> multPorTerm (2,3) (M.fromList [(0,4),(2,1)])
     fromList [(2,12),(4,3)]
  • (multPol p q) es el producto de los polinomios p y q. Por ejemplo,
     λ> multPol ejPol1 ejPol2
     fromList [(0,12),(1,28),(3,-5),(4,35),(5,3),(6,-18),(8,-5)]
     λ> multPol ejPol1 ejPol1
     fromList [(0,9),(1,42),(2,49),(3,-30),(4,-70),(6,25)]
     λ> multPol ejPol2 ejPol2
     fromList [(0,16),(3,40),(5,8),(6,25),(8,10),(10,1)]

Soluciones

import qualified Data.Map as M
 
type Polinomio a = M.Map Int a 
 
ejPol1, ejPol2 :: Polinomio Int
ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
ejPol2 = M.fromList [(0,4),(3,5),(5,1)]
 
sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
sumaPol p q = 
    M.filter (/=0) (M.unionWith (+) p q)
 
multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
multPorTerm (n,a) p =
    M.map (*a) (M.mapKeys (+n) p)
 
multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a
multPol p q
    | M.null p  = M.empty
    | otherwise = sumaPol (multPorTerm t q) (multPol r q)
    where (t,r) = M.deleteFindMin p

Operaciones con polinomios como diccionarios

Los polinomios se pueden representar mediante diccionarios con los exponentes como claves y los coeficientes como valores.

El tipo de los polinomios con coeficientes de tipo a se define por

   type Polinomio a = M.Map Int a

Dos ejemplos de polinomios (que usaremos en los ejemplos) son

   3 + 7x - 5x^3
   4 + 5x^3 + x^5

se definen por

  ejPol1, ejPol2 :: Polinomio Int
  ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
  ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

Definir las funciones

   sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
   multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
   multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a

tales que

  • (sumaPol p q) es la suma de los polinomios p y q. Por ejemplo,
     ghci> sumaPol ejPol1 ejPol2
     fromList [(0,7),(1,7),(5,1)]
     ghci> sumaPol ejPol1 ejPol1
     fromList [(0,6),(1,14),(3,-10)]
  • (multPorTerm (n,a) p) es el producto del término ax^n por p. Por ejemplo,
     ghci> multPorTerm (2,3) (M.fromList [(0,4),(2,1)])
     fromList [(2,12),(4,3)]
  • (multPol p q) es el producto de los polinomios p y q. Por ejemplo,
     ghci> multPol ejPol1 ejPol2
     fromList [(0,12),(1,28),(3,-5),(4,35),(5,3),(6,-18),(8,-5)]
     ghci> multPol ejPol1 ejPol1
     fromList [(0,9),(1,42),(2,49),(3,-30),(4,-70),(6,25)]
     ghci> multPol ejPol2 ejPol2
     fromList [(0,16),(3,40),(5,8),(6,25),(8,10),(10,1)]

Soluciones

import qualified Data.Map as M
 
type Polinomio a = M.Map Int a 
 
ejPol1, ejPol2 :: Polinomio Int
ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
ejPol2 = M.fromList [(0,4),(3,5),(5,1)]
 
sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
sumaPol p q = 
    M.filter (/=0) (M.unionWith (+) p q)
 
multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
multPorTerm (n,a) p =
    M.map (*a) (M.mapKeys (+n) p)
 
multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a
multPol p q
    | M.null p  = M.empty
    | otherwise = sumaPol (multPorTerm t q) (multPol r q)
    where (t,r) = M.deleteFindMin p