Data.Maybe

Cambio con el menor número de monedas

PorJosé A. Alonso 15-marzo-201926-marzo-2022

El problema del cambio con el menor número de monedas consiste en, dada una lista ms de tipos de monedas (con infinitas monedas de cada tipo) y una cantidad objetivo x, calcular el menor número de monedas de ms cuya suma es x. Por ejemplo, con monedas de 1, 3 y 4 céntimos se puede obtener 6 céntimos de 4 formas

   1, 1, 1, 1, 1, 1
   1, 1, 1, 3
   1, 1, 4
   3, 3

1, 1, 1, 1, 1, 1

1, 1, 1, 3

1, 1, 4

3, 3

El menor número de monedas que se necesita es 2. En cambio, con monedas de 2, 5 y 10 es imposible obtener 3.

Definir

   monedas :: [Int] -> Int -> Maybe Int

1	monedas :: [Int] -> Int -> Maybe Int

tal que (monedas ms x) es el menor número de monedas de ms cuya suma es x, si es posible obtener dicha suma y es Nothing en caso contrario. Por ejemplo,

   monedas [1,3,4]  6                    ==  Just 2
   monedas [2,5,10] 3                    ==  Nothing
   monedas [1,2,5,10,20,50,100,200] 520  ==  Just 4

monedas [1,3,4] 6 == Just 2

monedas [2,5,10] 3 == Nothing

monedas [1,2,5,10,20,50,100,200] 520 == Just 4

Soluciones

import Data.Array ((!), array)

-- 1ª solución
-- ===========

monedas :: [Int] -> Int -> Maybe Int
monedas ms x
  | null cs   = Nothing
  | otherwise = Just (minimum (map length cs))
  where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas
-- de ms. Por ejemplo,
--   λ> cambios [1,5,10] 12
--   [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]
--   λ> cambios [2,5,10] 3
--   []
--   λ> cambios [1,3,4] 6
--   [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]
cambios :: [Int] -> Int -> [[Int]]
cambios _      0 = [[]]
cambios []     _ = []
cambios (k:ks) m
  | m < k     = []
  | otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++
                cambios ks m

-- 2ª solución
-- ===========

monedas2 :: [Int] -> Int -> Maybe Int
monedas2 ms n
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = aux n
    aux 0 = 0
    aux k = siguiente (minimo [aux (k - x) | x <- ms,  k >= x])

infinito :: Int
infinito = 10^30

minimo :: [Int] -> Int
minimo [] = infinito
minimo xs = minimum xs

siguiente :: Int -> Int
siguiente x | x == infinito = infinito
            | otherwise     = 1 + x

-- 3ª solución
-- ===========

monedas3 :: [Int] -> Int -> Maybe Int
monedas3 ms n  
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = v ! n
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

-- Comparación de eficiencia
-- =========================

--    λ> monedas [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.02 secs, 871,144 bytes)
--    λ> monedas2 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (15.44 secs, 1,866,519,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.01 secs, 157,232 bytes)
--    
--    λ> monedas [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (14.20 secs, 1,845,293,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (0.01 secs, 623,376 bytes)

import Data.Array ((!), array)

-- 1ª solución

-- ===========

monedas :: [Int] -> Int -> Maybe Int

monedas ms x

| null cs = Nothing

| otherwise = Just (minimum (map length cs))

where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas

-- de ms. Por ejemplo,

-- λ> cambios [1,5,10] 12

-- [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]

-- λ> cambios [2,5,10] 3

-- []

-- λ> cambios [1,3,4] 6

-- [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]

cambios :: [Int] -> Int -> [[Int]]

cambios _ 0 = [[]]

cambios [] _ = []

cambios (k:ks) m

| m < k = []

| otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++

cambios ks m

-- 2ª solución

-- ===========

monedas2 :: [Int] -> Int -> Maybe Int

monedas2 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = aux n

aux 0 = 0

aux k = siguiente (minimo [aux (k - x) | x <- ms, k >= x])

infinito :: Int

infinito = 10^30

minimo :: [Int] -> Int

minimo [] = infinito

minimo xs = minimum xs

siguiente :: Int -> Int

siguiente x | x == infinito = infinito

| otherwise = 1 + x

-- 3ª solución

-- ===========

monedas3 :: [Int] -> Int -> Maybe Int

monedas3 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = v ! n

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 0

f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

-- Comparación de eficiencia

-- =========================

-- λ> monedas [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.02 secs, 871,144 bytes)

-- λ> monedas2 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (15.44 secs, 1,866,519,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.01 secs, 157,232 bytes)

-- λ> monedas [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (14.20 secs, 1,845,293,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (0.01 secs, 623,376 bytes)

Pensamiento

Demos tiempo al tiempo:
para que el vaso rebose
hay que llenarlo primero.

Antonio Machado

Raíz cúbica entera

PorJosé A. Alonso 30-noviembre-201826-marzo-2022

Un número x es un cubo si existe un y tal que x = y^3. Por ejemplo, 8 es un cubo porque 8 = 2^3.

Definir la función

   raizCubicaEntera :: Integer -> Maybe Integer.

1	raizCubicaEntera :: Integer -> Maybe Integer.

tal que (raizCubicaEntera x n) es justo la raíz cúbica del número natural x, si x es un cubo y Nothing en caso contrario. Por ejemplo,

   raizCubicaEntera 8             ==  Just 2
   raizCubicaEntera 9             ==  Nothing
   raizCubicaEntera 27            ==  Just 3
   raizCubicaEntera 64            ==  Just 4
   raizCubicaEntera (2^30)        ==  Just 1024
   raizCubicaEntera (10^9000)     ==  Just (10^3000)
   raizCubicaEntera (5 + 10^9000) ==  Nothing

raizCubicaEntera 8 == Just 2

raizCubicaEntera 9 == Nothing

raizCubicaEntera 27 == Just 3

raizCubicaEntera 64 == Just 4

raizCubicaEntera (2^30) == Just 1024

raizCubicaEntera (10^9000) == Just (10^3000)

raizCubicaEntera (5 + 10^9000) == Nothing

Soluciones

import Test.QuickCheck

-- 1ª definición
-- =============

raizCubicaEntera :: Integer -> Maybe Integer
raizCubicaEntera x = aux 0
  where aux y | y^3 > x   = Nothing
              | y^3 == x  = Just y
              | otherwise = aux (y+1)

-- 2ª definición
-- =============

raizCubicaEntera2 :: Integer -> Maybe Integer
raizCubicaEntera2 x 
  | y^3 == x  = Just y
  | otherwise = Nothing
  where (y:_) = dropWhile (\y -> y^3 < x) [0..]

-- 3ª definición
-- =============

raizCubicaEntera3 :: Integer -> Maybe Integer 
raizCubicaEntera3 1 = Just 1
raizCubicaEntera3 x = aux (0,x)
    where aux (a,b) | d == x    = Just c
                    | c == a    = Nothing
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^3

-- 4ª definición
-- =============

raizCubicaEntera4 :: Integer -> Maybe Integer
raizCubicaEntera4 x 
  | y^3 == x  = Just y
  | otherwise = Nothing
  where y = floor ((fromIntegral x)**(1 / 3))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,
--    λ> raizCubicaEntera4 (2^30)
--    Nothing
--    λ> raizCubicaEntera (2^30)
--    Just 1024

-- Equivalencia
-- ============

-- La propiedad es                        
prop_raizCubicaEntera :: Integer -> Property
prop_raizCubicaEntera x =
  x >= 0 ==>
  and [raizCubicaEntera x == f x | f <- [ raizCubicaEntera2
                                        , raizCubicaEntera3]]

-- La comprobación es              
--    λ> quickCheck prop_raizCubicaEntera
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================
  
--    λ> raizCubicaEntera (10^18)
--    Just 1000000
--    (1.80 secs, 1,496,137,192 bytes)
--    λ> raizCubicaEntera2 (10^18)
--    Just 1000000
--    (0.71 secs, 712,134,128 bytes)
--    λ> raizCubicaEntera3 (10^18)
--    Just 1000000
--    (0.01 secs, 196,424 bytes)
--
--    λ> raizCubicaEntera2 (5^27)
--    Just 1953125
--    (1.42 secs, 1,390,760,920 bytes)
--    λ> raizCubicaEntera3 (5^27)
--    Just 1953125
--    (0.00 secs, 195,888 bytes)
--
--    λ> raizCubicaEntera3 (10^9000) == Just (10^3000)
--    True
--    (2.05 secs, 420,941,368 bytes)
--    λ> raizCubicaEntera3 (5 + 10^9000) == Nothing
--    True
--    (2.08 secs, 420,957,576 bytes)

import Test.QuickCheck

-- 1ª definición

-- =============

raizCubicaEntera :: Integer -> Maybe Integer

raizCubicaEntera x = aux 0

where aux y | y^3 > x = Nothing

| y^3 == x = Just y

| otherwise = aux (y+1)

-- 2ª definición

-- =============

raizCubicaEntera2 :: Integer -> Maybe Integer

raizCubicaEntera2 x

| y^3 == x = Just y

| otherwise = Nothing

where (y:_) = dropWhile (\y -> y^3 < x) [0..]

-- 3ª definición

-- =============

raizCubicaEntera3 :: Integer -> Maybe Integer

raizCubicaEntera3 1 = Just 1

raizCubicaEntera3 x = aux (0,x)

where aux (a,b) | d == x = Just c

| c == a = Nothing

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^3

-- 4ª definición

-- =============

raizCubicaEntera4 :: Integer -> Maybe Integer

raizCubicaEntera4 x

| y^3 == x = Just y

| otherwise = Nothing

where y = floor ((fromIntegral x)**(1 / 3))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,

-- λ> raizCubicaEntera4 (2^30)

-- Nothing

-- λ> raizCubicaEntera (2^30)

-- Just 1024

-- Equivalencia

-- ============

-- La propiedad es

prop_raizCubicaEntera :: Integer -> Property

prop_raizCubicaEntera x =

x >= 0 ==>

and [raizCubicaEntera x == f x | f <- [ raizCubicaEntera2

, raizCubicaEntera3]]

-- La comprobación es

-- λ> quickCheck prop_raizCubicaEntera

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- λ> raizCubicaEntera (10^18)

-- Just 1000000

-- (1.80 secs, 1,496,137,192 bytes)

-- λ> raizCubicaEntera2 (10^18)

-- Just 1000000

-- (0.71 secs, 712,134,128 bytes)

-- λ> raizCubicaEntera3 (10^18)

-- Just 1000000

-- (0.01 secs, 196,424 bytes)

-- λ> raizCubicaEntera2 (5^27)

-- Just 1953125

-- (1.42 secs, 1,390,760,920 bytes)

-- λ> raizCubicaEntera3 (5^27)

-- Just 1953125

-- (0.00 secs, 195,888 bytes)

-- λ> raizCubicaEntera3 (10^9000) == Just (10^3000)

-- True

-- (2.05 secs, 420,941,368 bytes)

-- λ> raizCubicaEntera3 (5 + 10^9000) == Nothing

-- True

-- (2.08 secs, 420,957,576 bytes)

Pensamiento

Tras el vivir y el soñar,
está lo que más importa:
despertar.

Antonio Machado

Búsqueda en los dígitos de pi

PorJosé A. Alonso 13-abril-201826-marzo-2022

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

1	posicion :: String -> IO (Maybe Int)

tal que (posicion n) es (Just k) si k es la posición de n en la sucesión formada por un millón dígitos decimales del número pi y Nothing si n no ocurre en dicha sucesión. Por ejemplo,

   λ> posicion "15"
   Just 3
   λ> posicion "2017"
   Just 8897
   λ> posicion "022017"
   Just 382052
   λ> posicion "14022017"
   Nothing
   λ> posicion "999999"
   Just 762
   λ> posicion "458151"
   Just 999995

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

Nota. Se puede comprobar la función mediante The pi-search page o Pi search engine.

Soluciones

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)
posicion ns = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int
posicionEnLista xs ys = aux xs 1
  where aux [] _ = Nothing
        aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n
                     | otherwise              = aux xs (n+1)

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n

| otherwise = aux xs (n+1)

División equitativa

PorJosé A. Alonso 6-febrero-201826-marzo-2022

Definir la función

   divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

1	divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

tal que (divisionEquitativa xs) determina si la lista de números enteros positivos xs se puede dividir en dos partes (sin reordenar sus elementos) con la misma suma. Si es posible, su valor es el par formado por las dos partes. Si no lo es, su valor es Nothing. Por ejemplo,

   divisionEquitativa [1,2,3,4,5,15]  ==  Just ([1,2,3,4,5],[15])
   divisionEquitativa [15,1,2,3,4,5]  ==  Just ([15],[1,2,3,4,5])
   divisionEquitativa [1,2,3,4,7,15]  ==  Nothing
   divisionEquitativa [1,2,3,4,15,5]  ==  Nothing

divisionEquitativa [1,2,3,4,5,15] == Just ([1,2,3,4,5],[15])

divisionEquitativa [15,1,2,3,4,5] == Just ([15],[1,2,3,4,5])

divisionEquitativa [1,2,3,4,7,15] == Nothing

divisionEquitativa [1,2,3,4,15,5] == Nothing

Soluciones

import Data.Maybe (isNothing, fromJust, listToMaybe)
import Data.List  (elemIndex, inits, tails)

-- 1ª solución
divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa1 xs = aux (particiones xs)
 where aux []                              = Nothing
       aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)
                        | otherwise        = aux ys                   
       particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución
divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa2 xs
  | 2 * b == suma = Just $ splitAt (length as + 1) xs
  | otherwise     = Nothing
  where suma        = sum xs
        (as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución
divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa3 xs
  | odd n       = Nothing
  | isNothing p = Nothing
  | otherwise   = Just (splitAt (1 + fromJust p) xs)
  where n  = sum xs
        ys = scanl1 (+) xs
        p  = elemIndex (n `div` 2) ys

-- 4ª solución
divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa4 xs
  | odd (sum xs) = Nothing
  | otherwise    = aux [] xs
  where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)
                          | sum as > sum bs  = Nothing
                          | otherwise        = aux (b:as) (bs')

-- 5ª solución
divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa5 xs =
  listToMaybe
    [(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)
              , sum ys == sum zs ]

import Data.Maybe (isNothing, fromJust, listToMaybe)

import Data.List (elemIndex, inits, tails)

-- 1ª solución

divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa1 xs = aux (particiones xs)

where aux [] = Nothing

aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)

| otherwise = aux ys

particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución

divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa2 xs

| 2 * b == suma = Just $ splitAt (length as + 1) xs

| otherwise = Nothing

where suma = sum xs

(as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución

divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa3 xs

| odd n = Nothing

| isNothing p = Nothing

| otherwise = Just (splitAt (1 + fromJust p) xs)

where n = sum xs

ys = scanl1 (+) xs

p = elemIndex (n `div` 2) ys

-- 4ª solución

divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa4 xs

| odd (sum xs) = Nothing

| otherwise = aux [] xs

where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)

| sum as > sum bs = Nothing

| otherwise = aux (b:as) (bs')

-- 5ª solución

divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa5 xs =

listToMaybe

[(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)

, sum ys == sum zs ]

Ordenación según una cadena

PorJosé A. Alonso 29-diciembre-201726-marzo-2022

Dada una lista xs y una cadena cs de la misma longitud, la ordenación de xs según cs consiste en emparejar los elementos de cs con los de xs (de forma que al menor elemento de cs le corresponde el menor de xs, al segundo de cs el segundo de xs, etc.) y ordenar los elementos de xs en el mismo orden que sus correspondientes elementos de cs. Por ejemplo, si xs es [6,4,2] y cs es «CAB» entonces a ‘A’ le corresponde el 2, a ‘B’ el 4 y a ‘C’ el 6; luego la ordenación es [6,2,4].

Definir la función

   ordenacion :: Ord a => [a] -> String -> [a]

1	ordenacion :: Ord a => [a] -> String -> [a]

tal que (ordenacion xs ys) es la ordenación de la lista xs según la cadena cs. Por ejemplo,

   ordenacion [6,4,2] "CAB"     ==  [6,2,4]
   ordenacion [1,5,3] "ABC"     ==  [1,3,5]
   ordenacion [1,5,3,7] "ABEC"  ==  [1,3,7,5]

ordenacion [6,4,2] "CAB" == [6,2,4]

ordenacion [1,5,3] "ABC" == [1,3,5]

ordenacion [1,5,3,7] "ABEC" == [1,3,7,5]

Soluciones

import Data.List (sort)
import Data.Maybe (fromJust)

ordenacion :: Ord a => [a] -> String -> [a]
ordenacion xs cs =
  [fromJust (lookup y diccionario) | y <- cs]
  where diccionario = zip (sort cs) (sort xs)

import Data.List (sort)

import Data.Maybe (fromJust)

ordenacion :: Ord a => [a] -> String -> [a]

ordenacion xs cs =

[fromJust (lookup y diccionario) | y <- cs]

where diccionario = zip (sort cs) (sort xs)

Cambio con el menor número de monedas

Soluciones

Pensamiento

Raíz cúbica entera

Soluciones

Pensamiento

Búsqueda en los dígitos de pi

Soluciones

División equitativa

Soluciones

Ordenación según una cadena

Soluciones

Entradas recientes

Buscar

Correo electrónico