José A. Alonso

Problema de las jarras

PorJosé A. Alonso 18-mayo-201626-marzo-2022

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en la jarra de A litros de capacidad.

Definir, mediante búsqueda en espacio de estados, la función

   jarras :: (Int,Int,Int) -> [[(Int,Int)]]

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal (jarras (a,b,c)) es la lista de las soluciones del problema de las
jarras (a,b,c). Por ejemplo,

   λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]
   [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   []

λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]

[(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

[]

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y
-- el contenido que se desea lograr 

-- Un estado es una lista de dos números. El primero es el contenido de
-- la jarra de 4 litros y el segundo el de la de 3 litros. 
type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras
inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool
esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]
sucesoresEjarras (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > 0, x + y > a] ++
    [(x-(b-y),b) | x > 0, y < b, x + y > b] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales
type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras
inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool
esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]
sucesoresNjarras p n@(e:es) =
    [e':n | e' <- sucesoresEjarras p e,
            e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]
solucionesJarras p = buscaEE (sucesoresNjarras p)
                             (esFinalNjarras p)
                             inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras p = map reverse (solucionesJarras p)

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y

-- el contenido que se desea lograr

-- Un estado es una lista de dos números. El primero es el contenido de

-- la jarra de 4 litros y el segundo el de la de 3 litros.

type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras

inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool

esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]

sucesoresEjarras (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > 0, x + y > a] ++

[(x-(b-y),b) | x > 0, y < b, x + y > b] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales

type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras

inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool

esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]

sucesoresNjarras p n@(e:es) =

[e':n | e' <- sucesoresEjarras p e,

e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]

solucionesJarras p = buscaEE (sucesoresNjarras p)

(esFinalNjarras p)

inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras p = map reverse (solucionesJarras p)

Problema del dominó

PorJosé A. Alonso 17-mayo-201626-marzo-2022

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir, mediante búsqueda en espacio de estados, la función

   domino :: [(Int,Int)] -> [[(Int,Int)]]

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   ghci> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   ghci> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   ghci> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   ghci> domino [(1,2),(2,3),(5,4)]
   []
   ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0

ghci> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

ghci> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

ghci> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

ghci> domino [(1,2),(2,3),(5,4)]

[]

ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

type Ficha  = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino
inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool
esFinalDomino (fs,_) = null fs 

sucesoresDomino :: EstadoDomino -> [EstadoDomino]
sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]
sucesoresDomino (fs,n@((x,y):qs)) =
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
    [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

solucionesDomino :: [Ficha] -> [EstadoDomino]
solucionesDomino ps = buscaEE sucesoresDomino
                              esFinalDomino         
                              (inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]
domino ps = map snd (solucionesDomino ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

type Ficha = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino

inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool

esFinalDomino (fs,_) = null fs

sucesoresDomino :: EstadoDomino -> [EstadoDomino]

sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]

sucesoresDomino (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

solucionesDomino :: [Ficha] -> [EstadoDomino]

solucionesDomino ps = buscaEE sucesoresDomino

esFinalDomino

(inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]

domino ps = map snd (solucionesDomino ps)

Sucesión duplicadora

PorJosé A. Alonso 16-mayo-201625-abril-2021

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª solución
duplicadora :: Integer -> [Integer]
duplicadora x =
    reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
    reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª solución

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Problema de las puertas

PorJosé A. Alonso 13-mayo-201625-abril-2021

Un hotel dispone de n habitaciones y n camareros. Los camareros tienen la costumbre de cambiar de estado las puestas (es decir, abrir las cerradas y cerrar las abiertas). El proceso es el siguiente:

Inicialmente todas las puertas están cerradas.
El primer camarero cambia de estado las puertas de todas las habitaciones.
El segundo cambia de estado de las puertas de las habitaciones pares.
El tercero cambia de estado todas las puertas que son múltiplos de 3.
El cuarto cambia de estado todas las puertas que son múltiplos de 4
Así, hasta que ha pasado el último camarero.

Por ejemplo, para n = 5

   Pase    | Puerta 1 | Puerta 2 | Puerta 3 | Puerta 4 | Puerta 5
   --------+----------+----------+----------+----------+----------
   Inicial | Cerrada  | Cerrada  | Cerrada  | Cerrada  | Cerrada
   Pase 1  | Abierta  | Abierta  | Abierta  | Abierta  | Abierta
   Pase 2  | Abierta  | Cerrada  | Abierta  | Cerrada  | Abierta
   Pase 3  | Abierta  | Cerrada  | Cerrada  | Cerrada  | Abierta
   Pase 4  | Abierta  | Cerrada  | Cerrada  | Abierta  | Abierta
   Pase 5  | Abierta  | Cerrada  | Cerrada  | Abierta  | Cerrada

--------+----------+----------+----------+----------+----------

Los estados de las puertas se representan por el siguiente tipo de datos

   data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)

1 2	data Estado = Abierta \| Cerrada deriving (Eq, Show)

Definir la función

   final :: Int -> [Estado]

1	final :: Int -> [Estado]

tal que (final n) es la lista de los estados de las n puertas después
de que hayan pasado los n camareros. Por
ejemplo,

   ghci> final 5
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
   ghci> final 7
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

ghci> final 5

[Abierta,Cerrada,Cerrada,Abierta,Cerrada]

ghci> final 7

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

Soluciones

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

data Estado = Abierta | Cerrada 
              deriving (Eq, Show)
 
cambia Abierta = Cerrada
cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n
-- habitaciones. Por ejemplo,
--    inicial 5  ==  [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]
inicial :: Int -> [Estado]
inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el
-- camarero k que las encuentra en los estados es. Por ejemplo,
--    ghci> pase 1 (inicial 5)
--    [Abierta,Abierta,Abierta,Abierta,Abierta]
--    ghci> pase 2 it
--    [Abierta,Cerrada,Abierta,Cerrada,Abierta]
--    ghci> pase 3 it
--    [Abierta,Cerrada,Cerrada,Cerrada,Abierta]
--    ghci> pase 4 it
--    [Abierta,Cerrada,Cerrada,Abierta,Abierta]
--    ghci> pase 5 it
--    [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
pase :: [Estado] -> Int -> [Estado] 
pase es k = zipWith cambiaK  es[1..] 
  where cambiaK e n | n `mod` k == 0 = cambia e
                    | otherwise      = e
               
final :: Int -> [Estado]
final n = aux [1..n] (inicial n) 
    where aux []     es = es  
          aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')
-- ========================

final2 :: Int -> [Estado]
final2 n = foldl pase (inicial n) [1..n] 

-- 3ª definición (basada en los cambios de cada posición)
-- ======================================================

final3 :: Int -> [Estado]
final3 n = map f [1..n]
    where f x | even (length (divisores x)) = Cerrada
              | otherwise                   = Abierta

divisores :: Int -> [Int]
divisores n = [x| x <- [1..n], n `mod` x == 0]

-- 4ª definición (basada en posiciones de abiertas)
-- ================================================

-- En primer lugar, vamos a determinar la lista de las posiciones
-- (comenzando a contar en 1) de las puertas que quedan abierta en el
-- problema de las n puertas. 
posicionesAbiertas :: Int -> [Int]
posicionesAbiertas n = 
    [x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,
--    ghci> posicionesAbiertas 200
--    [1,4,9,16,25,36,49,64,81,100,121,144,169,196]
-- Se observa las que quedan abiertas son las que sus posiciones son
-- cuadrados perfectos. Usando esta observación se construye la
-- siguiente definición

final4 :: Int -> [Estado]
final4 n = aux [1..n] [k*k | k <- [1..]] 
    where aux (x:xs) (y:ys) | x == y  =  Abierta : aux xs ys
          aux (x:xs) ys               =  Cerrada : aux xs ys
          aux []     _                =  []

-- 1ª solución

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

data Estado = Abierta | Cerrada

deriving (Eq, Show)

cambia Abierta = Cerrada

cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n

-- habitaciones. Por ejemplo,

-- inicial 5 == [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]

inicial :: Int -> [Estado]

inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el

-- camarero k que las encuentra en los estados es. Por ejemplo,

-- ghci> pase 1 (inicial 5)

-- [Abierta,Abierta,Abierta,Abierta,Abierta]

-- ghci> pase 2 it

-- [Abierta,Cerrada,Abierta,Cerrada,Abierta]

-- ghci> pase 3 it

-- [Abierta,Cerrada,Cerrada,Cerrada,Abierta]

-- ghci> pase 4 it

-- [Abierta,Cerrada,Cerrada,Abierta,Abierta]

-- ghci> pase 5 it

-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada]

pase :: [Estado] -> Int -> [Estado]

pase es k = zipWith cambiaK es[1..]

where cambiaK e n | n `mod` k == 0 = cambia e

| otherwise = e

final :: Int -> [Estado]

final n = aux [1..n] (inicial n)

where aux [] es = es

aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')

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

final2 :: Int -> [Estado]

final2 n = foldl pase (inicial n) [1..n]

-- 3ª definición (basada en los cambios de cada posición)

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

final3 :: Int -> [Estado]

final3 n = map f [1..n]

where f x | even (length (divisores x)) = Cerrada

| otherwise = Abierta

divisores :: Int -> [Int]

divisores n = [x| x <- [1..n], n `mod` x == 0]

-- 4ª definición (basada en posiciones de abiertas)

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

-- En primer lugar, vamos a determinar la lista de las posiciones

-- (comenzando a contar en 1) de las puertas que quedan abierta en el

-- problema de las n puertas.

posicionesAbiertas :: Int -> [Int]

posicionesAbiertas n =

[x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,

-- ghci> posicionesAbiertas 200

-- [1,4,9,16,25,36,49,64,81,100,121,144,169,196]

-- Se observa las que quedan abiertas son las que sus posiciones son

-- cuadrados perfectos. Usando esta observación se construye la

-- siguiente definición

final4 :: Int -> [Estado]

final4 n = aux [1..n] [k*k | k <- [1..]]

where aux (x:xs) (y:ys) | x == y = Abierta : aux xs ys

aux (x:xs) ys = Cerrada : aux xs ys

aux [] _ = []

Juego de bloques con letras

PorJosé A. Alonso 12-mayo-201619-mayo-2016

Para el juego de los bloques se dispone de un conjunto de bloques con una letra en cada una de sus dos caras. El objetivo del juego consiste en formar palabras sin que se pueda usar un bloque más de una vez y sin diferenciar mayúsculas de minúsculas. Por ejemplo, si se tiene tres bloques de forma que el 1º tiene las letras A y B, el 2ª la N y la O y el 3º la O y la A entonces se puede obtener la palabra ANA de dos formas: una con los bloques 1, 2 y 3 y otra con los 3, 2 y 1.

Definir la función

   soluciones :: [String] -> String -> [[String]]

1	soluciones :: [String] -> String -> [[String]]

tal que (soluciones bs cs) es la lista de las soluciones del juego de los bloque usando los bloques bs (cada bloque es una cadena de dos letras mayúsculas) para formar la palabra cs. Por ejemplo,

   ghci> soluciones ["AB","NO","OA"] "ANA"
   [["AB","NO","OA"],["OA","NO","AB"]]
   ghci> soluciones ["AB","NE","OA"] "Bea"
   [["AB","NE","OA"]]
   ghci> soluciones ["AB","NE","OA"] "EvA"
   []
   ghci> soluciones ["AB","NO","OA","NC"] "ANA"
   [["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]
   ghci> soluciones ["AB","NO","OA","NC"] "Anca"
   [["AB","NO","NC","OA"],["OA","NO","NC","AB"]]
   ghci> soluciones (["AB","NO","OA"] ++ replicate (10^6) "PQ") "ANA"
   [["AB","NO","OA"],["OA","NO","AB"]]

ghci> soluciones ["AB","NO","OA"] "ANA"

[["AB","NO","OA"],["OA","NO","AB"]]

ghci> soluciones ["AB","NE","OA"] "Bea"

[["AB","NE","OA"]]

ghci> soluciones ["AB","NE","OA"] "EvA"

[]

ghci> soluciones ["AB","NO","OA","NC"] "ANA"

[["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]

ghci> soluciones ["AB","NO","OA","NC"] "Anca"

[["AB","NO","NC","OA"],["OA","NO","NC","AB"]]

ghci> soluciones (["AB","NO","OA"] ++ replicate (10^6) "PQ") "ANA"

[["AB","NO","OA"],["OA","NO","AB"]]

Soluciones

import Data.List (delete)
import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]
soluciones _ []      = [[]]
soluciones bs (c:cs) = [b:rs | b <- bs, 
                               toUpper c `elem` b,
                               rs <- soluciones (delete b bs) cs]

import Data.List (delete)

import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]

soluciones _ [] = [[]]

soluciones bs (c:cs) = [b:rs | b <- bs,

toUpper c `elem` b,

rs <- soluciones (delete b bs) cs]

Densidad de números no monótonos

PorJosé A. Alonso 11-mayo-201618-mayo-2016

Un número entero positivo se dice que es

creciente si cada uno de sus dígitos es menor o igual que el que está a su derecha; por ejemplo, 134479.
decreciente si cada uno de sus dígitos es menor o igual que el que está a su derecha; por ejemplo, 664210.
no monótono si no es creciente ni decreciente; por ejemplo, 155369.

Para cada entero positivo n, la densidad números no monótonos hasta n es el cociente entre la cantidad de n números no monótonos entre menores o iguales que n y el número n. Por ejemplo, hasta 150 hay 19 números no monótonos (101, 102, 103, 104, 105, 106, 107, 108, 109, 120, 121, 130, 131, 132, 140, 141, 142, 143 y 150); por tanto, la densidad hasta 150 es 19/150 = 0.12666667

Definir las siguientes funciones

   densidad              :: Integer -> Float
   menorConDensidadMayor :: Float -> Integer

1 2	densidad :: Integer -> Float menorConDensidadMayor :: Float -> Integer

tales que

(densidad n) es la densidad de números no monótonos hasta n. Por ejemplo,

     densidad 100  ==  0.0
     densidad 200  ==  0.265
     densidad 400  ==  0.4375
     densidad 800  ==  0.53375

densidad 100 == 0.0

densidad 200 == 0.265

densidad 400 == 0.4375

densidad 800 == 0.53375

(menorConDensidadMayor x) es el menor número n tal que la densidad de números no monótonos hasta n es mayor o igual que x. Por ejemplo,

     menorConDensidadMayor 0.5   ==  538
     densidad 537                ==  0.49906892
     densidad 538                ==  0.5
     menorConDensidadMayor 0.9   ==  21780
     densidad 21779              ==  0.8999954
     densidad 21780              ==  0.9
     menorConDensidadMayor 0.99  ==  1586996

menorConDensidadMayor 0.5 == 538

densidad 537 == 0.49906892

densidad 538 == 0.5

menorConDensidadMayor 0.9 == 21780

densidad 21779 == 0.8999954

densidad 21780 == 0.9

menorConDensidadMayor 0.99 == 1586996

Soluciones

import Data.List (genericLength, sort)

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

densidad :: Integer -> Float
densidad n = 
    genericLength [x | x <- [1..n], esNoMonotono x] / fromIntegral n

esNoMonotono :: Integer -> Bool
esNoMonotono x = not (esCreciente x) && not (esDecreciente x)

esCreciente :: Integer -> Bool
esCreciente x = show x == sort (show x)

esDecreciente :: Integer -> Bool
esDecreciente x = reverse (show x) == sort (show x)

menorConDensidadMayor :: Float -> Integer 
menorConDensidadMayor x  = 
    buscaProporcion x (filter esNoMonotono [1..])
    where buscaProporcion x = 
              snd . head . filter condicion . zip [1..]
              where condicion (a,b) = a >= x * fromIntegral b

import Data.List (genericLength, sort)

-- 1ª definición

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

densidad :: Integer -> Float

densidad n =

genericLength [x | x <- [1..n], esNoMonotono x] / fromIntegral n

esNoMonotono :: Integer -> Bool

esNoMonotono x = not (esCreciente x) && not (esDecreciente x)

esCreciente :: Integer -> Bool

esCreciente x = show x == sort (show x)

esDecreciente :: Integer -> Bool

esDecreciente x = reverse (show x) == sort (show x)

menorConDensidadMayor :: Float -> Integer

menorConDensidadMayor x =

buscaProporcion x (filter esNoMonotono [1..])

where buscaProporcion x =

snd . head . filter condicion . zip [1..]

where condicion (a,b) = a >= x * fromIntegral b

Sucesión fractal

PorJosé A. Alonso 10-mayo-201625-abril-2021

La sucesión fractal

   0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 
   10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

1 2	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

los términos impares forman la misma sucesión original

     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

1 2	sucFractal :: [Integer] sumaSucFractal :: Integer -> Integer

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      ==  13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

-- 1ª definición de sucFractal
-- ===========================

sucFractal1 :: [Integer]
sucFractal1 = 
    map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
    | even n    = n `div` 2
    | otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal
-- ===========================

sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
    x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal
-- ===============================

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
    sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal
-- ===============================

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal
-- ===============================

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
    | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
    | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
    where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla (x:xs) (y:ys) =

x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Referencia

Fractal sequences and restricted Nim por Lionel Levine.

Conjuntos de primos emparejables

PorJosé A. Alonso 9-mayo-201625-abril-2021

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

   emparejables :: Integer -> Integer -> [[Integer]]

1	emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

   take 5 (emparejables 2   10)  ==  [[3,7]]
   take 5 (emparejables 3   10)  ==  []
   take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
   take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
   take 5 (emparejables 4  100)  ==  []
   take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

take 5 (emparejables 2 10) == [[3,7]]

take 5 (emparejables 3 10) == []

take 5 (emparejables 2 100) == [[3,7],[3,11],[3,17],[3,31],[3,37]]

take 5 (emparejables 3 100) == [[3,37,67],[7,19,97]]

take 5 (emparejables 4 100) == []

take 5 (emparejables 4 1000) == [[3,7,109,673],[23,311,677,827]]

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (nub, sort)
import qualified Data.Set as S

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

emparejables :: Integer -> Integer -> [[Integer]]
emparejables 0 _ = [[]]
emparejables n m = 
    nub [sort (x:xs) | x <- takeWhile (<=m) primes,
                       xs <- xss,
                       all (x `emparejable`) xs]
    where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool
emparejable x y =
    isPrime (concatenacion x y) &&
    isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer
concatenacion x y =
    read (show x ++ show y)

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

emparejables2 :: Integer -> Integer -> [[Integer]]
emparejables2 n m = map reverse (aux n m)
    where aux 1 m = [[x] | x <- takeWhile (<=m) primes]
          aux n m = 
              [p:ys | ys@(x:xs) <- xss,
                      p <- dropWhile (<x) ps,
                      all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

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

emparejables3 :: Integer -> Integer -> [[Integer]]
emparejables3 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,
                                     xs <- xss,
                                     all (x `emparejable`) xs]
              where xss = aux (n-1) m

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

emparejables4 :: Integer -> Integer -> [[Integer]]
emparejables4 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = 
              [S.insert p ys | ys <- xss,
                               let (x,xs) = S.deleteFindMax ys,
                               p <- dropWhile (<x) ps,
                               all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

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

--    λ> head (emparejables 4 1000)
--    [3,7,109,673]
--    (20.36 secs, 11,781,891,120 bytes)
--    
--    λ> head (emparejables2 4 1000)
--    [3,7,109,673]
--    (0.02 secs, 0 bytes)
--    
--    λ> head (emparejables3 4 1000)
--    [3,7,109,673]
--    (38.04 secs, 21,542,334,024 bytes)
--    
--    λ> head (emparejables4 4 1000)
--    [3,7,109,673]
--    (0.03 secs, 0 bytes)

import Data.Numbers.Primes (primes, isPrime)

import Data.List (nub, sort)

import qualified Data.Set as S

-- 1ª definición

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

emparejables :: Integer -> Integer -> [[Integer]]

emparejables 0 _ = [[]]

emparejables n m =

nub [sort (x:xs) | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool

emparejable x y =

isPrime (concatenacion x y) &&

isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer

concatenacion x y =

read (show x ++ show y)

-- 2ª definición

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

emparejables2 :: Integer -> Integer -> [[Integer]]

emparejables2 n m = map reverse (aux n m)

where aux 1 m = [[x] | x <- takeWhile (<=m) primes]

aux n m =

[p:ys | ys@(x:xs) <- xss,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- 3ª definición

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

emparejables3 :: Integer -> Integer -> [[Integer]]

emparejables3 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = aux (n-1) m

-- 2ª definición

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

emparejables4 :: Integer -> Integer -> [[Integer]]

emparejables4 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m =

[S.insert p ys | ys <- xss,

let (x,xs) = S.deleteFindMax ys,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- Comparación de eficiencia

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

-- λ> head (emparejables 4 1000)

-- [3,7,109,673]

-- (20.36 secs, 11,781,891,120 bytes)

-- λ> head (emparejables2 4 1000)

-- [3,7,109,673]

-- (0.02 secs, 0 bytes)

-- λ> head (emparejables3 4 1000)

-- [3,7,109,673]

-- (38.04 secs, 21,542,334,024 bytes)

-- λ> head (emparejables4 4 1000)

-- [3,7,109,673]

-- (0.03 secs, 0 bytes)

Cadenas de divisores

PorJosé A. Alonso 6-mayo-201625-abril-2021

Una cadena de divisores de un número n es una lista donde cada elemento es un divisor de su siguiente elemento en la lista. Por ejemplo, las cadenas de divisores de 12 son [2,4,12], [2,6,12], [2,12], [3,6,12], [3,12], [4,12], [6,12] y [12].

Definir la función

   cadenasDivisores :: Int -> [[Int]]

1	cadenasDivisores :: Int -> [[Int]]

tal que (cadenasDivisores n) es la lista de las cadenas de divisores de n. Por ejemplo,

   λ> cadenasDivisores 12
   [[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]
   λ> length (cadenaDivisores 48)
   48
   λ> length (cadenaDivisores 120)
   132

λ> cadenasDivisores 12

[[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]

λ> length (cadenaDivisores 48)

λ> length (cadenaDivisores 120)

132

Soluciones

import Data.List (sort)
import Data.Numbers.Primes (isPrime)

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

cadenasDivisores :: Int -> [[Int]]
cadenasDivisores n = sort (extiendeLista [[n]])
    where extiendeLista []           = []
          extiendeLista ((1:xs):yss) = xs : extiendeLista yss
          extiendeLista ((x:xs):yss) =
              extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores 12  ==  [6,4,3,2,1]
divisores :: Int -> [Int]
divisores x = 
    [y | y <- [a,a-1..1], x `mod` y == 0]
    where a = x `div` 2

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

cadenasDivisores2 :: Int -> [[Int]]
cadenasDivisores2 = sort . aux
    where aux 1 = [[]]
          aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

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

cadenasDivisores3 :: Int -> [[Int]]
cadenasDivisores3 = sort . map reverse . aux
    where aux 1 = [[]]
          aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores3 12  ==  [1,2,3,4,6]
divisores3 :: Int -> [Int]
divisores3 x = 
    [y | y <- [1..a], x `mod` y == 0]
    where a = x `div` 2

-- 1ª definición de nCadenasDivisores
-- ==================================

nCadenasDivisores1 :: Int -> Int
nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores
-- ==================================

nCadenasDivisores2 :: Int -> Int
nCadenasDivisores2 1 = 1
nCadenasDivisores2 n = 
    sum [nCadenasDivisores2 x | x <- divisores n]

import Data.List (sort)

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

cadenasDivisores :: Int -> [[Int]]

cadenasDivisores n = sort (extiendeLista [[n]])

where extiendeLista [] = []

extiendeLista ((1:xs):yss) = xs : extiendeLista yss

extiendeLista ((x:xs):yss) =

extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores 12 == [6,4,3,2,1]

divisores :: Int -> [Int]

divisores x =

[y | y <- [a,a-1..1], x `mod` y == 0]

where a = x `div` 2

-- 2ª definición

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

cadenasDivisores2 :: Int -> [[Int]]

cadenasDivisores2 = sort . aux

where aux 1 = [[]]

aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

-- 3ª definición

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

cadenasDivisores3 :: Int -> [[Int]]

cadenasDivisores3 = sort . map reverse . aux

where aux 1 = [[]]

aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores3 12 == [1,2,3,4,6]

divisores3 :: Int -> [Int]

divisores3 x =

[y | y <- [1..a], x `mod` y == 0]

where a = x `div` 2

-- 1ª definición de nCadenasDivisores

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

nCadenasDivisores1 :: Int -> Int

nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores

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

nCadenasDivisores2 :: Int -> Int

nCadenasDivisores2 1 = 1

nCadenasDivisores2 n =

sum [nCadenasDivisores2 x | x <- divisores n]

Referencias

Sucesión A163272 de OEIS.
Ordered and unordered factorizations of integers por A. Knopfmacher y M. Mays

Número de divisiones en el algoritmo de Euclides

PorJosé A. Alonso 5-mayo-201612-mayo-2016

Dados dos números naturales, a y b, es posible calcular su máximo común divisor mediante el Algoritmo de Euclides. Este algoritmo se puede resumir en la siguiente fórmula:

   mcd(a,b) = a,                   si b = 0
            = b,                   si a = 0               
            = mcd (a módulo b, b), si a > b
            = mcd (a, b módulo a), si b >= a

mcd(a,b) = a, si b = 0

= b, si a = 0

= mcd (a módulo b, b), si a > b

= mcd (a, b módulo a), si b >= a

Definir la función

   mcdYdivisiones :: Int -> Int -> (Int,Int)

1	mcdYdivisiones :: Int -> Int -> (Int,Int)

tal que (mcdYdivisiones a b) es el número de divisiones usadas en el cálculo del máximo común divisor de a y b mediante el algoritmo de Euclides. Por ejemplo,

   mcdYdivisiones 252 198 == (18,4)

1	mcdYdivisiones 252 198 == (18,4)

ya que los 4 divisiones del cálculo son

     mcd 252 198
   = mcd  54 198
   = mcd  54  36
   = mcd  18  36
   = mcd  18   0

mcd 252 198

= mcd 54 198

= mcd 54 36

= mcd 18 36

= mcd 18 0

Comprobar con QuickCheck que el número de divisiones requeridas por el algoritmo de Euclides para calcular el MCD de a y b es igual o menor que cinco veces el número de dígitos de menor de los números a y b.

Soluciones

import Test.QuickCheck
import Debug.Trace 

mcdYdivisiones :: Int -> Int -> (Int,Int)
mcdYdivisiones a b = mcd a b 0
    where mcd a 0 n = (a,n)
          mcd 0 b n = (b,n)
          mcd a b n | a > b     = mcd (a `mod` b) b (n+1)
                    | otherwise = mcd a (b `mod` a) (n+1) 

-- La propiedad es
prop_mcdYdivisiones :: Int -> Int -> Property
prop_mcdYdivisiones a b =
    a > 0 && b > 0 ==>
      n < 5 * length (show (min a b))  
    where (_,n) = mcdYdivisiones a b
                 
-- La comprobación es
--    λ> quickCheck prop_mcdYdivisiones
--    +++ OK, passed 100 tests.

-- 2ª definición (con traza)
mcdYdivisiones2 :: Int -> Int -> (Int,Int)
mcdYdivisiones2 a b = mcd a b 0
    where mcd a b n
              | trace (show a ++ ", " ++ show b) False = undefined
          mcd a 0 n = (a,n)
          mcd 0 b n = (b,n)
          mcd a b n | a > b     = mcd (a `mod` b) b (n+1)
                    | otherwise = mcd a (b `mod` a) (n+1) 

-- Por ejemplo,
--    λ> mcdYdivisiones2 252 198
--    252, 198
--    54, 198
--    54, 36
--    18, 36
--    18, 0
--    (18,4)

import Test.QuickCheck

import Debug.Trace

mcdYdivisiones :: Int -> Int -> (Int,Int)

mcdYdivisiones a b = mcd a b 0

where mcd a 0 n = (a,n)

mcd 0 b n = (b,n)

mcd a b n | a > b = mcd (a `mod` b) b (n+1)

| otherwise = mcd a (b `mod` a) (n+1)

-- La propiedad es

prop_mcdYdivisiones :: Int -> Int -> Property

prop_mcdYdivisiones a b =

a > 0 && b > 0 ==>

n < 5 * length (show (min a b))

where (_,n) = mcdYdivisiones a b

-- La comprobación es

-- λ> quickCheck prop_mcdYdivisiones

-- +++ OK, passed 100 tests.

-- 2ª definición (con traza)

mcdYdivisiones2 :: Int -> Int -> (Int,Int)

mcdYdivisiones2 a b = mcd a b 0

where mcd a b n

| trace (show a ++ ", " ++ show b) False = undefined

mcd a 0 n = (a,n)

mcd 0 b n = (b,n)

mcd a b n | a > b = mcd (a `mod` b) b (n+1)

| otherwise = mcd a (b `mod` a) (n+1)

-- Por ejemplo,

-- λ> mcdYdivisiones2 252 198

-- 252, 198

-- 54, 198

-- 54, 36

-- 18, 36

-- 18, 0

-- (18,4)

Autor: José A. Alonso

Problema de las jarras

Soluciones

Problema del dominó

Soluciones

Sucesión duplicadora

Soluciones

Problema de las puertas

Soluciones

Juego de bloques con letras

Soluciones

Densidad de números no monótonos

Soluciones

Sucesión fractal

Soluciones

Referencia

Conjuntos de primos emparejables

Soluciones

Cadenas de divisores

Soluciones

Referencias

Número de divisiones en el algoritmo de Euclides

Soluciones

Entradas recientes

Buscar

Correo electrónico