Ejercicio

Números con un segmento divisible por su longitud

PorJosé A. Alonso 1-junio-2016

El número 5671 tiene la curiosa propiedad de tener un único segmento divisible por su longitud. En efecto, los segmentos de 5671 son 5, 6, 7, 1, 56, 67, 71, 567, 671 y 5671 y de ellos sólo el 56 es divisible por 4 (que es la longitud de 5671).

Un número de 3 dígitos con la misma propiedad es el 104, ya que su único segmento divisible por 3 es 0.

Un número de 7 dígitos con la misma propiedad es el 1132451, ya que su único segmento divisible por 7 es 245.

Definir las funciones

   conUnicoSegmentoDivisible :: Integer -> Bool
   sucUnicoSegmentoDivisible :: [Integer]

1 2	conUnicoSegmentoDivisible :: Integer -> Bool sucUnicoSegmentoDivisible :: [Integer]

tales que

(conUnicoSegmentoDivisible x) se verifica si x tiene un único segmento divisible por la longitud de x. Por ejemplo,

     conUnicoSegmentoDivisible 5671     ==  True
     conUnicoSegmentoDivisible 104      ==  True
     conUnicoSegmentoDivisible 1132451  ==  True
     conUnicoSegmentoDivisible 15       ==  False
     conUnicoSegmentoDivisible 16       ==  False
     conUnicoSegmentoDivisible 2016     ==  False

conUnicoSegmentoDivisible 5671 == True

conUnicoSegmentoDivisible 104 == True

conUnicoSegmentoDivisible 1132451 == True

conUnicoSegmentoDivisible 15 == False

conUnicoSegmentoDivisible 16 == False

conUnicoSegmentoDivisible 2016 == False

sucUnicoSegmentoDivisible es la sucesión de los números x tales que x tiene un único segmento divisible por la longitud de x. Por ejemplo,

     λ> take 25 sucUnicoSegmentoDivisible
     [1,2,3,4,5,6,7,8,9,21,23,25,27,29,41,43,45,47,49,61,63,65,67,69,81]

1 2	λ> take 25 sucUnicoSegmentoDivisible [1,2,3,4,5,6,7,8,9,21,23,25,27,29,41,43,45,47,49,61,63,65,67,69,81]

Sucesión infinita de todas las palabras

PorJosé A. Alonso 31-mayo-2016

El conjunto de todas las palabras se puede ordenar como en los diccionarios:

     a,   b, ...,   z,   A,   B, ...,   Z,
    aa,  ab, ...,  az,  aA,  aB, ...,  aZ,
    ba,  bb, ...,  bz,  bA,  bB, ...,  bZ,
   ...
    za,  zb, ...,  zz,  zA,  zB, ...,  zZ,
   aaa, aab, ..., aaz, aaA, aaB, ..., aaZ,
   baa, bab, ..., baz, baA, baB, ..., baZ,
   ...

a, b, ..., z, A, B, ..., Z,

aa, ab, ..., az, aA, aB, ..., aZ,

ba, bb, ..., bz, bA, bB, ..., bZ,

...

za, zb, ..., zz, zA, zB, ..., zZ,

aaa, aab, ..., aaz, aaA, aaB, ..., aaZ,

baa, bab, ..., baz, baA, baB, ..., baZ,

...

Definir las funciones

   palabras :: [String]
   posicion :: String -> Integer

1 2	palabras :: [String] posicion :: String -> Integer

tales que

palabras es la lista ordenada de todas las palabras. Por ejemplo,

     λ> take 10 (drop 100 palabras)
     ["aW","aX","aY","aZ","ba","bb","bc","bd","be","bf"]
     λ> take 10 (drop 2750 palabras)
     ["ZU","ZV","ZW","ZX","ZY","ZZ","aaa","aab","aac","aad"]
     λ> palabras !! (10^6)
     "gePO"

λ> take 10 (drop 100 palabras)

["aW","aX","aY","aZ","ba","bb","bc","bd","be","bf"]

λ> take 10 (drop 2750 palabras)

["ZU","ZV","ZW","ZX","ZY","ZZ","aaa","aab","aac","aad"]

λ> palabras !! (10^6)

"gePO"

(posicion n) es la palabra que ocupa la posición n en la lista ordenada de todas las palabras. Por ejemplo,

   posicion "c"                    ==  2
   posicion "ab"                   ==  53
   posicion "ba"                   ==  104
   posicion "eva"                  ==  14664
   posicion "adan"                 ==  151489
   posicion "HoyEsMartes"          ==  4957940944437977046
   posicion "EnUnLugarDeLaMancha"  ==  241779893912461058861484239910864

posicion "c" == 2

posicion "ab" == 53

posicion "ba" == 104

posicion "eva" == 14664

posicion "adan" == 151489

posicion "HoyEsMartes" == 4957940944437977046

posicion "EnUnLugarDeLaMancha" == 241779893912461058861484239910864

Comprobar con QuickCheck que para todo entero positivo n se verifica que

   posicion (palabras `genericIndex` n) == n

1	posicion (palabras `genericIndex` n) == n

Soluciones

[schedule expon=’2016-06-07′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 07 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2016-06-07′ at=»06:00″]

import Data.List (genericIndex, genericLength)
import Test.QuickCheck

-- 1ª definición de palabras
-- =========================
    
palabras1 :: [String]
palabras1 = concatMap palabrasDeLongitud [1..]

-- (palabrasDeLongitud n) es la lista ordenada de palabras longitud
-- n. Por ejemplo,
--    take 3 (palabrasDeLongitud 2)  ==  ["aa","ab","ac"]
--    take 3 (palabrasDeLongitud 3)  ==  ["aaa","aab","aac"]
palabrasDeLongitud :: Integer -> [String]
palabrasDeLongitud 1 = [[x]  | x <- letras]
palabrasDeLongitud n = [x:ys | x <- letras,
                               ys <- palabrasDeLongitud (n-1)]

-- letras es la lista ordenada de las letras.                       
letras :: [Char]
letras = ['a'..'z'] ++ ['A'..'Z']

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

palabras2 :: [String]
palabras2 = concat (iterate f elementales)
    where f = concatMap (\x -> map (x++) elementales)

-- elementales es la lista de las palabras de una letra.              
elementales :: [String]            
elementales = map (:[]) letras

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

palabras3 :: [String]
palabras3 = tail $ map reverse aux
    where aux = "" : [c:cs | cs <- aux, c <- letras]

-- Comparación
-- ===========

--    λ> palabras1 !! (10^6)
--    "gePO"
--    (0.87 secs, 480,927,648 bytes)
--    λ> palabras2 !! (10^6)
--    "gePO"
--    (0.11 secs, 146,879,840 bytes)
--    λ> palabras3 !! (10^6)
--    "gePO"
--    (0.25 secs, 203,584,608 bytes)

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

posicion1 :: String -> Integer
posicion1 cs = genericLength (takeWhile (/=cs) palabras1)

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

posicion2 :: String -> Integer
posicion2 ""     = -1
posicion2 (c:cs) = (1 + posicionLetra c) * 52^(length cs) + posicion2 cs

posicionLetra :: Char -> Integer
posicionLetra c = genericLength (takeWhile (/=c) letras)

-- La propiedad es
prop_palabras :: (Positive Integer) -> Bool
prop_palabras (Positive n) =
    posicion2 (palabras3 `genericIndex` n) == n

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

import Data.List (genericIndex, genericLength)

import Test.QuickCheck

-- 1ª definición de palabras

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

palabras1 :: [String]

palabras1 = concatMap palabrasDeLongitud [1..]

-- (palabrasDeLongitud n) es la lista ordenada de palabras longitud

-- n. Por ejemplo,

-- take 3 (palabrasDeLongitud 2) == ["aa","ab","ac"]

-- take 3 (palabrasDeLongitud 3) == ["aaa","aab","aac"]

palabrasDeLongitud :: Integer -> [String]

palabrasDeLongitud 1 = [[x] | x <- letras]

palabrasDeLongitud n = [x:ys | x <- letras,

ys <- palabrasDeLongitud (n-1)]

-- letras es la lista ordenada de las letras.

letras :: [Char]

letras = ['a'..'z'] ++ ['A'..'Z']

-- 2ª definición de palabras

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

palabras2 :: [String]

palabras2 = concat (iterate f elementales)

where f = concatMap (\x -> map (x++) elementales)

-- elementales es la lista de las palabras de una letra.

elementales :: [String]

elementales = map (:[]) letras

-- 3ª definición de palabras

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

palabras3 :: [String]

palabras3 = tail $ map reverse aux

where aux = "" : [c:cs | cs <- aux, c <- letras]

-- Comparación

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

-- λ> palabras1 !! (10^6)

-- "gePO"

-- (0.87 secs, 480,927,648 bytes)

-- λ> palabras2 !! (10^6)

-- "gePO"

-- (0.11 secs, 146,879,840 bytes)

-- λ> palabras3 !! (10^6)

-- "gePO"

-- (0.25 secs, 203,584,608 bytes)

-- 1ª definición de posicion

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

posicion1 :: String -> Integer

posicion1 cs = genericLength (takeWhile (/=cs) palabras1)

-- 1ª definición de posicion

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

posicion2 :: String -> Integer

posicion2 "" = -1

posicion2 (c:cs) = (1 + posicionLetra c) * 52^(length cs) + posicion2 cs

posicionLetra :: Char -> Integer

posicionLetra c = genericLength (takeWhile (/=c) letras)

-- La propiedad es

prop_palabras :: (Positive Integer) -> Bool

prop_palabras (Positive n) =

posicion2 (palabras3 `genericIndex` n) == n

-- La comprobación es

-- λ> quickCheck prop_palabras

-- +++ OK, passed 100 tests.

[/schedule]

Cadenas de primos complementarios

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

El complemento de un número positivo x se calcula por el siguiente procedimiento:

si x es mayor que 9, se toma cada dígito por su valor posicional y se resta del mayor los otro dígitos. Por ejemplo, el complemento de 1448 es 1000 – 400 – 40 – 8 = 552. Para
si x es menor que 10, su complemento es x.

Definir las funciones

   cadena    :: Integer -> [Integer]
   conCadena :: Int -> [Integer]

1 2	cadena :: Integer -> [Integer] conCadena :: Int -> [Integer]

tales que

(cadena x) es la cadena de primos a partir de x tal que cada uno es el complemento del anterior. Por ejemplo,

     cadena 8         == []
     cadena 7         == [7]
     cadena 13        == [13,7]
     cadena 643       == [643,557,443]
     cadena 18127     == [18127,1873,127,73,67,53,47]
     cadena 18181213  == [18181213,1818787,181213,18787,1213,787,613,587]

cadena 8 == []

cadena 7 == [7]

cadena 13 == [13,7]

cadena 643 == [643,557,443]

cadena 18127 == [18127,1873,127,73,67,53,47]

cadena 18181213 == [18181213,1818787,181213,18787,1213,787,613,587]

(conCadena n) es la lista de números cuyas cadenas tienen n elementos. Por ejemplo,

     take 6 (conCadena 3)                == [23,31,61,67,103,307]
     [head (conCadena n) | n <- [4..8]]  == [37,43,157,18127,181873]

1 2	take 6 (conCadena 3) == [23,31,61,67,103,307] [head (conCadena n) \| n <- [4..8]] == [37,43,157,18127,181873]

Soluciones

[schedule expon=’2016-06-06′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 06 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2016-06-06′ at=»06:00″]

import Data.Numbers.Primes

cadena :: Integer -> [Integer]
cadena x    
    | x < 10 && isPrime x = [x]
    | otherwise           = takeWhile isPrime (iterate f x)
    where f x | x < 10 && isPrime x = 0
              | otherwise           = complemento x

complemento :: Integer -> Integer
complemento x = (div x c)*c - (rem x c)
    where c = 10^(length (show x) - 1)          

conCadena :: Int -> [Integer]
conCadena n =
    [y | y <- primes, length (cadena y) == n]

import Data.Numbers.Primes

cadena :: Integer -> [Integer]

cadena x

| x < 10 && isPrime x = [x]

| otherwise = takeWhile isPrime (iterate f x)

where f x | x < 10 && isPrime x = 0

| otherwise = complemento x

complemento :: Integer -> Integer

complemento x = (div x c)*c - (rem x c)

where c = 10^(length (show x) - 1)

conCadena :: Int -> [Integer]

conCadena n =

[y | y <- primes, length (cadena y) == n]

[/schedule]

Construcción del árbol a partir de los recorridos preorden e inorden

PorJosé A. Alonso 27-mayo-201627-mayo-2016

Los árboles binarios con valores en las hojas y en los nodos se pueden representar con el siguiente tipo

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
                deriving (Show, Eq)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

Por ejemplo, el árbol

/ \

3 7

/ \

2 4

se representa por

   N 9 (N 3 (H 2) (H 4)) (H 7)

1	N 9 (N 3 (H 2) (H 4)) (H 7)

Definir las siguientes funciones

   preorden :: Arbol a -> [a]
   inorden  :: Arbol a -> [a]
   arboles  :: Eq a => [a] -> [a] -> [Arbol a]

preorden :: Arbol a -> [a]

inorden :: Arbol a -> [a]

arboles :: Eq a => [a] -> [a] -> [Arbol a]

tales que

(preorden x) es la lista correspondiente al recorrido preorden del árbol x; es decir, primero visita la raíz del árbol, a continuación recorre el subárbol izquierdo y, finalmente, recorre el subárbol derecho. Por ejemplo,

     preorden (N 9 (N 3 (H 2) (H 4)) (H 7))  ==  [9,3,2,4,7]

1	preorden (N 9 (N 3 (H 2) (H 4)) (H 7)) == [9,3,2,4,7]

(inorden x) es la lista correspondiente al recorrido inorden del árbol x; es decir, primero recorre el subárbol izquierdo, a continuación visita la raíz del árbol y, finalmente, recorre el subárbol derecho. Por ejemplo,

     inorden (N 9 (N 3 (H 2) (H 4)) (H 7))  ==  [2,3,4,9,7]

1	inorden (N 9 (N 3 (H 2) (H 4)) (H 7)) == [2,3,4,9,7]

(arboles xs ys) es la lista de los árboles con recorrido preorden xs y recorrido inorden de ys. Por ejemplo,

      λ> arboles [9,3,2,4,7] [2,3,4,9,7]
      [N 9 (N 3 (H 2) (H 4)) (H 7)]
      λ> arboles [9,3,2,4,7] [2,4,3,9,7]
      []
      λ> arboles [1,1,1,2,3] [1,1,2,1,3]
      [N 1 (H 1) (N 1 (H 2) (H 3)),
       N 1 (N 1 (H 1) (H 2)) (H 3)]
      λ> let x = N 1 (N 1 (H 1) (H 3)) (N 1 (N 1 (H 1) (H 2)) (H 3))
      λ> arboles (preorden x) (inorden x)
      [N 1 (H 1) (N 1 (H 3) (N 1 (H 1) (N 1 (H 2) (H 3)))),
       N 1 (H 1) (N 1 (H 3) (N 1 (N 1 (H 1) (H 2)) (H 3))),
       N 1 (N 1 (H 1) (H 3)) (N 1 (H 1) (N 1 (H 2) (H 3))),
       N 1 (N 1 (H 1) (H 3)) (N 1 (N 1 (H 1) (H 2)) (H 3))]

λ> arboles [9,3,2,4,7] [2,3,4,9,7]

[N 9 (N 3 (H 2) (H 4)) (H 7)]

λ> arboles [9,3,2,4,7] [2,4,3,9,7]

[]

λ> arboles [1,1,1,2,3] [1,1,2,1,3]

[N 1 (H 1) (N 1 (H 2) (H 3)),

N 1 (N 1 (H 1) (H 2)) (H 3)]

λ> let x = N 1 (N 1 (H 1) (H 3)) (N 1 (N 1 (H 1) (H 2)) (H 3))

λ> arboles (preorden x) (inorden x)

[N 1 (H 1) (N 1 (H 3) (N 1 (H 1) (N 1 (H 2) (H 3)))),

N 1 (H 1) (N 1 (H 3) (N 1 (N 1 (H 1) (H 2)) (H 3))),

N 1 (N 1 (H 1) (H 3)) (N 1 (H 1) (N 1 (H 2) (H 3))),

N 1 (N 1 (H 1) (H 3)) (N 1 (N 1 (H 1) (H 2)) (H 3))]

Comprobar con QuickCheck, que para todo árbol x se verifican las siguientes propiedades

    prop_arboles1 :: Arbol Int -> Bool
    prop_arboles1 x =
        x `elem` arboles (preorden x) (inorden x)
    
    prop_arboles2 :: Arbol Int -> Bool
    prop_arboles2 x =
        and [preorden a == xs && inorden a == ys | a <- as] 
        where xs = preorden x
              ys = inorden x
              as = arboles xs ys

prop_arboles1 :: Arbol Int -> Bool

prop_arboles1 x =

x `elem` arboles (preorden x) (inorden x)

prop_arboles2 :: Arbol Int -> Bool

prop_arboles2 x =

and [preorden a == xs && inorden a == ys | a <- as]

where xs = preorden x

ys = inorden x

as = arboles xs ys

Nota: Para la comprobación, se usa el siguiente generador

   import Control.Monad 
   
   instance Arbitrary a => Arbitrary (Arbol a) where
     arbitrary = sized arbol
       where
         arbol 0       = liftM H arbitrary 
         arbol n | n>0 = oneof [liftM H arbitrary,
                                liftM3 N arbitrary subarbol subarbol]
                         where subarbol = arbol (div n 2)

import Control.Monad

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbol

where

arbol 0 = liftM H arbitrary

arbol n | n>0 = oneof [liftM H arbitrary,

liftM3 N arbitrary subarbol subarbol]

where subarbol = arbol (div n 2)

Soluciones

[schedule expon=’2016-06-02′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 02 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2016-06-02′ at=»06:00″]

import Data.List (elemIndex, elemIndices)
import Data.Maybe (isJust, fromJust)
import Test.QuickCheck
import Control.Monad 

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
             deriving (Show, Eq)

preorden :: Arbol a -> [a]
preorden (H x)     = [x]
preorden (N x i d) = x : (preorden i ++ preorden d)

inorden :: Arbol a -> [a]
inorden (H x)     = [x]
inorden (N x i d) = inorden i ++ (x : inorden d)

arboles :: Eq a => [a] -> [a] -> [Arbol a]
arboles [] _      = []
arboles [x] ys | ys == [x] = [H x]
               | otherwise = []
arboles (x:xs) ys =
    [N x i d | k <- elemIndices x ys 
             , let (ys1,_:ys2) = splitAt k ys
             , let (xs1,xs2)   = splitAt k xs
             , i <- arboles xs1 ys1
             , d <- arboles xs2 ys2]

prop_arboles1 :: Arbol Int -> Bool
prop_arboles1 x =
    x `elem` arboles (preorden x) (inorden x)

prop_arboles2 :: Arbol Int -> Bool
prop_arboles2 x =
    and [preorden a == xs && inorden a == ys | a <- as] 
    where xs = preorden x
          ys = inorden x
          as = arboles xs ys

instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbol
    where
      arbol 0       = liftM H arbitrary 
      arbol n | n>0 = oneof [liftM H arbitrary,
                             liftM3 N arbitrary subarbol subarbol]
                      where subarbol = arbol (div n 2)

import Data.List (elemIndex, elemIndices)

import Data.Maybe (isJust, fromJust)

import Test.QuickCheck

import Control.Monad

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

preorden :: Arbol a -> [a]

preorden (H x) = [x]

preorden (N x i d) = x : (preorden i ++ preorden d)

inorden :: Arbol a -> [a]

inorden (H x) = [x]

inorden (N x i d) = inorden i ++ (x : inorden d)

arboles :: Eq a => [a] -> [a] -> [Arbol a]

arboles [] _ = []

arboles [x] ys | ys == [x] = [H x]

| otherwise = []

arboles (x:xs) ys =

[N x i d | k <- elemIndices x ys

, let (ys1,_:ys2) = splitAt k ys

, let (xs1,xs2) = splitAt k xs

, i <- arboles xs1 ys1

, d <- arboles xs2 ys2]

prop_arboles1 :: Arbol Int -> Bool

prop_arboles1 x =

x `elem` arboles (preorden x) (inorden x)

prop_arboles2 :: Arbol Int -> Bool

prop_arboles2 x =

and [preorden a == xs && inorden a == ys | a <- as]

where xs = preorden x

ys = inorden x

as = arboles xs ys

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbol

where

arbol 0 = liftM H arbitrary

arbol n | n>0 = oneof [liftM H arbitrary,

liftM3 N arbitrary subarbol subarbol]

where subarbol = arbol (div n 2)

[/schedule]

El problema de las N torres

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

El problema de las N torres consiste en colocar N torres en un tablero con N filas y N columnas de forma que no haya dos torres en la misma fila ni en la misma columna.

Cada solución del problema de puede representar mediante una matriz con ceros y unos donde los unos representa las posiciones ocupadas por las torres y los ceros las posiciones libres. Por ejemplo,

   ( 0 1 0 )
   ( 1 0 0 )
   ( 0 0 1 )

( 0 1 0 )

( 1 0 0 )

( 0 0 1 )

representa una solución del problema de las 3 torres.

Definir las funciones

   torres  :: Int -> [Matrix Int]
   nTorres :: Int -> Integer

1 2	torres :: Int -> [Matrix Int] nTorres :: Int -> Integer

tales que
+ (torres n) es la lista de las soluciones del problema de las n torres. Por ejemplo,

      λ> torres 3
      [( 1 0 0 )
       ( 0 1 0 )
       ( 0 0 1 )
      ,( 1 0 0 )
       ( 0 0 1 )
       ( 0 1 0 )
      ,( 0 1 0 )
       ( 1 0 0 )
       ( 0 0 1 )
      ,( 0 1 0 )
       ( 0 0 1 )
       ( 1 0 0 )
      ,( 0 0 1 )
       ( 1 0 0 )
       ( 0 1 0 )
      ,( 0 0 1 )
       ( 0 1 0 )
       ( 1 0 0 )
      ]

λ> torres 3

[( 1 0 0 )

( 0 1 0 )

( 0 0 1 )

,( 1 0 0 )

( 0 0 1 )

( 0 1 0 )

,( 0 1 0 )

( 1 0 0 )

( 0 0 1 )

,( 0 1 0 )

( 0 0 1 )

( 1 0 0 )

,( 0 0 1 )

( 1 0 0 )

( 0 1 0 )

,( 0 0 1 )

( 0 1 0 )

( 1 0 0 )

]

(nTorres n) es el número de soluciones del problema de las n torres. Por ejemplo,

      λ> nTorres 3
      6
      λ> length (show (nTorres (10^4)))
      35660

λ> nTorres 3

λ> length (show (nTorres (10^4)))

35660

Soluciones

[schedule expon=’2016-05-31′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 31 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2016-05-31′ at=»06:00″]

import Data.List (genericLength, sort, permutations)
import Data.Matrix 

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

torres1 :: Int -> [Matrix Int]
torres1 n = 
    [permutacionAmatriz n p | p <- sort (permutations [1..n])]

permutacionAmatriz :: Int -> [Int] -> Matrix Int
permutacionAmatriz n p =
    matrix n n f
    where f (i,j) | (i,j) `elem` posiciones = 1
                  | otherwise               = 0
          posiciones = zip [1..n] p    

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

torres2 :: Int -> [Matrix Int]
torres2 = map fromLists . permutations . toLists . identity

-- El cálculo con la definición anterior es:
--    λ> identity 3
--    ( 1 0 0 )
--    ( 0 1 0 )
--    ( 0 0 1 )
--    
--    λ> toLists it
--    [[1,0,0],[0,1,0],[0,0,1]]
--    λ> permutations it
--    [[[1,0,0],[0,1,0],[0,0,1]],
--     [[0,1,0],[1,0,0],[0,0,1]],
--     [[0,0,1],[0,1,0],[1,0,0]],
--     [[0,1,0],[0,0,1],[1,0,0]],
--     [[0,0,1],[1,0,0],[0,1,0]],
--     [[1,0,0],[0,0,1],[0,1,0]]]
--    λ> map fromLists it
--    [( 1 0 0 )
--     ( 0 1 0 )
--     ( 0 0 1 )
--    ,( 0 1 0 )
--     ( 1 0 0 )
--     ( 0 0 1 )
--    ,( 0 0 1 )
--     ( 0 1 0 )
--     ( 1 0 0 )
--    ,( 0 1 0 )
--     ( 0 0 1 )
--     ( 1 0 0 )
--    ,( 0 0 1 )
--     ( 1 0 0 )
--     ( 0 1 0 )
--    ,( 1 0 0 )
--     ( 0 0 1 )
--     ( 0 1 0 )
--    ]

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

nTorres1 :: Int -> Integer
nTorres1 = genericLength . torres1

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

nTorres2 :: Int -> Integer
nTorres2 n = product [1..fromIntegral n]

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

--    λ> nTorres1 9
--    362880
--    (4.22 secs, 693,596,128 bytes)
--    λ> nTorres2 9
--    362880
--    (0.00 secs, 0 bytes)

import Data.List (genericLength, sort, permutations)

import Data.Matrix

-- 1ª definición de torres

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

torres1 :: Int -> [Matrix Int]

torres1 n =

[permutacionAmatriz n p | p <- sort (permutations [1..n])]

permutacionAmatriz :: Int -> [Int] -> Matrix Int

permutacionAmatriz n p =

matrix n n f

where f (i,j) | (i,j) `elem` posiciones = 1

| otherwise = 0

posiciones = zip [1..n] p

-- 2ª definición de torres

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

torres2 :: Int -> [Matrix Int]

torres2 = map fromLists . permutations . toLists . identity

-- El cálculo con la definición anterior es:

-- λ> identity 3

-- ( 1 0 0 )

-- ( 0 1 0 )

-- ( 0 0 1 )

-- λ> toLists it

-- [[1,0,0],[0,1,0],[0,0,1]]

-- λ> permutations it

-- [[[1,0,0],[0,1,0],[0,0,1]],

-- [[0,1,0],[1,0,0],[0,0,1]],

-- [[0,0,1],[0,1,0],[1,0,0]],

-- [[0,1,0],[0,0,1],[1,0,0]],

-- [[0,0,1],[1,0,0],[0,1,0]],

-- [[1,0,0],[0,0,1],[0,1,0]]]

-- λ> map fromLists it

-- [( 1 0 0 )

-- ( 0 1 0 )

-- ( 0 0 1 )

-- ,( 0 1 0 )

-- ( 1 0 0 )

-- ( 0 0 1 )

-- ,( 0 0 1 )

-- ( 0 1 0 )

-- ( 1 0 0 )

-- ,( 0 1 0 )

-- ( 0 0 1 )

-- ( 1 0 0 )

-- ,( 0 0 1 )

-- ( 1 0 0 )

-- ( 0 1 0 )

-- ,( 1 0 0 )

-- ( 0 0 1 )

-- ( 0 1 0 )

-- ]

-- 1ª definición de nTorres

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

nTorres1 :: Int -> Integer

nTorres1 = genericLength . torres1

-- 2ª definición de nTorres

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

nTorres2 :: Int -> Integer

nTorres2 n = product [1..fromIntegral n]

-- Comparación de eficiencia

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

-- λ> nTorres1 9

-- 362880

-- (4.22 secs, 693,596,128 bytes)

-- λ> nTorres2 9

-- 362880

-- (0.00 secs, 0 bytes)

[/schedule]

Números automórficos

PorJosé A. Alonso 25-febrero-20163-marzo-2016

Un número n es automórfico si los últimos dígitos de su cuadrado son los dígitos de n. Por ejemplo, 5, 6, 76 y 890625 son números automórficos ya que 5² = 25, 6² = 36, 76² = 5776 y 890625² = 793212890625.

Definir la sucesión

   automorficos :: [Integer]

1	automorficos :: [Integer]

tal que sus elementos son los números automórficos. Por ejemplo,

   λ> take 11 automorficos
   [1,5,6,25,76,376,625,9376,90625,109376,890625]
   λ> automorficos !! 30
   56259918212890625

λ> take 11 automorficos

[1,5,6,25,76,376,625,9376,90625,109376,890625]

λ> automorficos !! 30

56259918212890625

Soluciones

import Data.List (isSuffixOf, nub, sort)

automorficos :: [Integer] 
automorficos = filter esAutomorfico [1..]

esAutomorfico :: Integer -> Bool 
esAutomorfico n = show n `isSuffixOf` show (n*n)

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

automorficos2 :: [Integer] 
automorficos2 = nub (1 : concat [sort [a,b] |
                                 k <- [1..], 
                                 let a = 5^(2^k) `mod` 10^k, 
                                 let b = 10^k - a + 1])

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

-- λ> automorficos !! 12 
-- 7109376 
-- (16.64 secs, 6,759,638,824 bytes)
-- λ> automorficos2 !! 12 
-- 7109376 
-- (0.00 secs, 0 bytes)

import Data.List (isSuffixOf, nub, sort)

automorficos :: [Integer]

automorficos = filter esAutomorfico [1..]

esAutomorfico :: Integer -> Bool

esAutomorfico n = show n `isSuffixOf` show (n*n)

-- 2ª definición

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

automorficos2 :: [Integer]

automorficos2 = nub (1 : concat [sort [a,b] |

k <- [1..],

let a = 5^(2^k) `mod` 10^k,

let b = 10^k - a + 1])

-- Comparación de eficiencia

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

-- λ> automorficos !! 12

-- 7109376

-- (16.64 secs, 6,759,638,824 bytes)

-- λ> automorficos2 !! 12

-- 7109376

-- (0.00 secs, 0 bytes)

Referencias

J.D. Cook, Curious numbers.
Wikipedia, Automorphic number.
E.W. Weisstein, Automorphic number en MathWorld.
N.J.A. Sloane Sucesion A003226 en OEIS.

Dígitos en la factorización

PorJosé A. Alonso 19-febrero-20162-marzo-2016

El enunciado del problema 652 de Números y algo más es el siguiente

Si factorizamos los factoriales de un número en función de sus divisores primos y sus potencias, ¿Cuál es el menor número n tal que entre los factores primos y los exponentes de estos, n! contiene los dígitos del cero al nueve? Por ejemplo

6! = 2⁴x3²x5¹, le faltan los dígitos 0,6,7,8 y 9

12! = 2¹⁰x3⁵x5²x7¹x11¹, le faltan los dígitos 4,6,8 y 9

Definir la función

   digitosDeFactorizacion :: Integer -> [Integer]

1	digitosDeFactorizacion :: Integer -> [Integer]

tal que (digitosDeFactorizacion n) es el conjunto de los dígitos que aparecen en la factorización de n. Por ejemplo,

   digitosDeFactorizacion (factorial 6)   ==  [1,2,3,4,5]
   digitosDeFactorizacion (factorial 12)  ==  [0,1,2,3,5,7]

1 2	digitosDeFactorizacion (factorial 6) == [1,2,3,4,5] digitosDeFactorizacion (factorial 12) == [0,1,2,3,5,7]

Usando la función anterior, calcular la solución del problema.

Comprobar con QuickCheck que si n es mayor que 100, entonces

   digitosDeFactorizacion (factorial n) == [0..9]

1	digitosDeFactorizacion (factorial n) == [0..9]

Soluciones

import Data.List (genericLength, group, nub, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

digitosDeFactorizacion1 :: Integer -> [Integer]
digitosDeFactorizacion1 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion n]))

-- (digitos n) es la lista de los digitos del número n. Por ejemplo, 
--    digitos 320274  ==  [3,2,0,2,7,4]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]

-- (numerosDeFactorizacion n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion 60  ==  [1,2,3,5]
numerosDeFactorizacion :: Integer -> [Integer]
numerosDeFactorizacion n = 
   sort (nub (aux (factorizacion n)))
   where aux [] = []
         aux ((x,y):zs) = x : y : aux zs

-- (factorización n) es la factorización de n. Por ejemplo,
--    factorizacion 300  ==  [(2,2),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n = 
    [(head xs, genericLength xs) | xs <- group (factorizacion' n)]

-- (factorizacion' n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion' :: Integer -> [Integer]
factorizacion' n | n == 1    = []
                 | otherwise = x : factorizacion' (div n x)
                 where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
menorFactor :: Integer -> Integer
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 5  ==  120
factorial :: Integer -> Integer
factorial n = product [1..n]

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

digitosDeFactorizacion2 :: Integer -> [Integer]
digitosDeFactorizacion2 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n]))

-- (numerosDeFactorizacion2 n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion2 60  ==  [1,2,3,5]
numerosDeFactorizacion2 :: Integer -> [Integer]
numerosDeFactorizacion2 n = 
    sort (nub (aux (factorizacion2 n)))
    where aux xs = concat [[a,b] | (a,b) <- xs]

-- (factorización2 n) es la factorización de n. Por ejemplo,
--    factorizacion2 300  ==  [(2,2),(3,1),(5,2)]
factorizacion2 :: Integer -> [(Integer,Integer)]
factorizacion2 n =
    [(head xs, genericLength xs) | xs <- group (primeFactors n)]

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

digitosDeFactorizacion3 :: Integer -> [Integer]
digitosDeFactorizacion3 n =
    sort (nub (concat [digitos x | x <- aux (group (primeFactors n))]))
    where aux  []            = []
          aux (ys@(y:_):xss) = y : genericLength ys : aux xss

-- Definición
-- ==========

digitosDeFactorizacion :: Integer -> [Integer]
digitosDeFactorizacion = digitosDeFactorizacion3

-- Solución
-- ========

-- Para calcular la solución, se define la constante
solucion :: Integer
solucion = 
    head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]]

-- El cálculo de la solución es
--    ghci> solucion2
--    49

-- Propiedad
-- =========

-- La propiedad es
prop_completa :: Integer -> Bool
prop_completa n =
    digitosDeFactorizacion (factorial n1) == [0..9]
    where n1 = 101 + abs n

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

100

101

102

103

104

105

106

107

108

109

import Data.List (genericLength, group, nub, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª definición

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

digitosDeFactorizacion1 :: Integer -> [Integer]

digitosDeFactorizacion1 n =

sort (nub (concat [digitos x | x <- numerosDeFactorizacion n]))

-- (digitos n) es la lista de los digitos del número n. Por ejemplo,

-- digitos 320274 == [3,2,0,2,7,4]

digitos :: Integer -> [Integer]

digitos n = [read [x] | x <- show n]

-- (numerosDeFactorizacion n) es el conjunto de los números en la

-- factorización de n. Por ejemplo,

-- numerosDeFactorizacion 60 == [1,2,3,5]

numerosDeFactorizacion :: Integer -> [Integer]

numerosDeFactorizacion n =

sort (nub (aux (factorizacion n)))

where aux [] = []

aux ((x,y):zs) = x : y : aux zs

-- (factorización n) es la factorización de n. Por ejemplo,

-- factorizacion 300 == [(2,2),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion n =

[(head xs, genericLength xs) | xs <- group (factorizacion' n)]

-- (factorizacion' n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion' :: Integer -> [Integer]

factorizacion' n | n == 1 = []

| otherwise = x : factorizacion' (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

menorFactor :: Integer -> Integer

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 5 == 120

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª definición

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

digitosDeFactorizacion2 :: Integer -> [Integer]

digitosDeFactorizacion2 n =

sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n]))

-- (numerosDeFactorizacion2 n) es el conjunto de los números en la

-- factorización de n. Por ejemplo,

-- numerosDeFactorizacion2 60 == [1,2,3,5]

numerosDeFactorizacion2 :: Integer -> [Integer]

numerosDeFactorizacion2 n =

sort (nub (aux (factorizacion2 n)))

where aux xs = concat [[a,b] | (a,b) <- xs]

-- (factorización2 n) es la factorización de n. Por ejemplo,

-- factorizacion2 300 == [(2,2),(3,1),(5,2)]

factorizacion2 :: Integer -> [(Integer,Integer)]

factorizacion2 n =

[(head xs, genericLength xs) | xs <- group (primeFactors n)]

-- 3ª definición

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

digitosDeFactorizacion3 :: Integer -> [Integer]

digitosDeFactorizacion3 n =

sort (nub (concat [digitos x | x <- aux (group (primeFactors n))]))

where aux [] = []

aux (ys@(y:_):xss) = y : genericLength ys : aux xss

-- Definición

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

digitosDeFactorizacion :: Integer -> [Integer]

digitosDeFactorizacion = digitosDeFactorizacion3

-- Solución

-- ========

-- Para calcular la solución, se define la constante

solucion :: Integer

solucion =

head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]]

-- El cálculo de la solución es

-- ghci> solucion2

-- 49

-- Propiedad

-- =========

-- La propiedad es

prop_completa :: Integer -> Bool

prop_completa n =

digitosDeFactorizacion (factorial n1) == [0..9]

where n1 = 101 + abs n

-- La comprobación es

-- λ> quickCheck prop_completa

-- +++ OK, passed 100 tests.

La solución en Maxima

/* digitos(n) es la lista de los digitos del número n. Por ejemplo, 
      digitos (320274) == [3,2,0,2,7,4]
*/      
digitos (n) := charlist (string (n))$

digitosDeFactorizacion (n) :=
   unique (apply (append, map (digitos, apply (append, ifactors (n))))) $

solucion () := block ([n:1],
  while length (digitosDeFactorizacion (n!)) < 10 do
     n : n+1,
  n)$   

/*
   (%i5) digitosDeFactorizacion (6!);
   (%o5) [1, 2, 3, 4, 5]

   (%i6) solucion ();
   (%o6) 49
*/

/* digitos(n) es la lista de los digitos del número n. Por ejemplo,

digitos (320274) == [3,2,0,2,7,4]

digitos (n) := charlist (string (n))$

digitosDeFactorizacion (n) :=

unique (apply (append, map (digitos, apply (append, ifactors (n))))) $

solucion () := block ([n:1],

while length (digitosDeFactorizacion (n!)) < 10 do

n : n+1,

n)$

(%i5) digitosDeFactorizacion (6!);

(%o5) [1, 2, 3, 4, 5]

(%i6) solucion ();

(%o6) 49

Diagonales de matrices como listas

PorJosé A. Alonso 16-febrero-201623-febrero-2016

Las matrices se pueden representar como listas de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   diagonal :: [[a]] -> [a]

1	diagonal :: [[a]] -> [a]

tal que (diagonal xss) es la diagonal de la matriz xss. Por ejemplo,

   diagonal [[3,5,2],[4,7,1],[6,9,0]]           ==  [3,7,0]
   diagonal [[3,5],[4,7],[6,9]]                 ==  [3,7]
   diagonal [[3,5,2],[4,7,1]]                   ==  [3,7]
   sum (diagonal (replicate 20000 [1..20000]))  ==  200010000

diagonal [[3,5,2],[4,7,1],[6,9,0]] == [3,7,0]

diagonal [[3,5],[4,7],[6,9]] == [3,7]

diagonal [[3,5,2],[4,7,1]] == [3,7]

sum (diagonal (replicate 20000 [1..20000])) == 200010000

Soluciones

import Data.Array  ((!), listArray)
import Data.Matrix (fromLists, getDiag)
import Data.Vector (toList)

-- 1ª definición (por recursión):
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 [tail xs | xs <- xss]
diagonal1 _           = []

-- 2ª definición (por comprensión):
diagonal2 :: [[a]] -> [a]
diagonal2 xss = [xs!!k | (xs,k) <- zip xss [0..n]]
    where n = length (head xss) - 1

-- 3ª definición (con Data.Matrix)
diagonal3 :: [[a]] -> [a]
diagonal3 = toList . getDiag . fromLists

-- 4ª definición (con Data.Array)
diagonal4 :: [[a]] -> [a]
diagonal4 xss = [p!(i,i) | i <- [1..k]] 
    where m = length xss
          n = length (head xss)
          k = min m n
          p = listArray ((1,1),(m,n)) (concat xss)

-- Comparación de eficiencia
--    λ> let n = 3000 in sum (diagonal1 (replicate n [1..n]))
--    4501500
--    (2.08 secs, 754,089,992 bytes)
--    λ> let n = 3000 in sum (diagonal2 (replicate n [1..n]))
--    4501500
--    (0.06 secs, 0 bytes)
--    λ> let n = 3000 in sum (diagonal3 (replicate n [1..n]))
--    4501500
--    (1.22 secs, 1,040,787,360 bytes)
--    λ> let n = 3000 in sum (diagonal4 (replicate n [1..n]))
--    4501500
--    (0.96 secs, 624,463,632 bytes)

import Data.Array ((!), listArray)

import Data.Matrix (fromLists, getDiag)

import Data.Vector (toList)

-- 1ª definición (por recursión):

diagonal1 :: [[a]] -> [a]

diagonal1 ((x:_):xss) = x : diagonal1 [tail xs | xs <- xss]

diagonal1 _ = []

-- 2ª definición (por comprensión):

diagonal2 :: [[a]] -> [a]

diagonal2 xss = [xs!!k | (xs,k) <- zip xss [0..n]]

where n = length (head xss) - 1

-- 3ª definición (con Data.Matrix)

diagonal3 :: [[a]] -> [a]

diagonal3 = toList . getDiag . fromLists

-- 4ª definición (con Data.Array)

diagonal4 :: [[a]] -> [a]

diagonal4 xss = [p!(i,i) | i <- [1..k]]

where m = length xss

n = length (head xss)

k = min m n

p = listArray ((1,1),(m,n)) (concat xss)

-- Comparación de eficiencia

-- λ> let n = 3000 in sum (diagonal1 (replicate n [1..n]))

-- 4501500

-- (2.08 secs, 754,089,992 bytes)

-- λ> let n = 3000 in sum (diagonal2 (replicate n [1..n]))

-- 4501500

-- (0.06 secs, 0 bytes)

-- λ> let n = 3000 in sum (diagonal3 (replicate n [1..n]))

-- 4501500

-- (1.22 secs, 1,040,787,360 bytes)

-- λ> let n = 3000 in sum (diagonal4 (replicate n [1..n]))

-- 4501500

-- (0.96 secs, 624,463,632 bytes)

Solución con Maxima

diagonal (xss) := block ([A],
  A : apply (matrix, xss),
  [m,n] : matrix_size (A),
  k : min (m,n),
  makelist (A[i,i],i,k))$

diagonal (xss) := block ([A],

A : apply (matrix, xss),

[m,n] : matrix_size (A),

k : min (m,n),

makelist (A[i,i],i,k))$

Números con un segmento divisible por su longitud

Sucesión infinita de todas las palabras

Soluciones

Cadenas de primos complementarios

Soluciones

Construcción del árbol a partir de los recorridos preorden e inorden

Soluciones

El problema de las N torres

Soluciones

Números automórficos

Soluciones

Referencias

Diagonales de matrices como listas

Soluciones

Solución con Maxima

Entradas recientes

Buscar

Correo electrónico