diciembre 2019 – Página 4

Sublistas con producto dado

PorJosé A. Alonso 5-diciembre-201917-diciembre-2019

Definir las funciones

   sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
   unifactorizables :: [Integer]

1 2	sublistasConProducto :: Integer -> [Integer] -> [[Integer]] unifactorizables :: [Integer]

tales que

(sublistasConProducto n xs) es la lista de las sublistas de la lista ordenada estrictamente creciente xs (cuyos elementos son enteros mayores que 1) cuyo producto es el número entero n (con n mayor que 1). Por ejemplo,

     λ> sublistasConProducto 72 [2,3,4,5,6,7,9,10,16]
     [[2,4,9],[3,4,6]]
     λ> sublistasConProducto 720 [2,3,4,5,6,7,9,10,16]
     [[2,3,4,5,6],[2,4,9,10],[3,4,6,10],[5,9,16]]
     λ> sublistasConProducto 2 [4,7]
     []
     λ> length (sublistasConProducto 1234567 [1..1234567])
     4

λ> sublistasConProducto 72 [2,3,4,5,6,7,9,10,16]

[[2,4,9],[3,4,6]]

λ> sublistasConProducto 720 [2,3,4,5,6,7,9,10,16]

[[2,3,4,5,6],[2,4,9,10],[3,4,6,10],[5,9,16]]

λ> sublistasConProducto 2 [4,7]

[]

λ> length (sublistasConProducto 1234567 [1..1234567])

unifactorizables es la lísta de los números enteros mayores que 1 que se pueden escribir sólo de una forma única como producto de enteros distintos mayores que uno. Por ejemplo,

     λ> take 20 unifactorizables
     [2,3,4,5,7,9,11,13,17,19,23,25,29,31,37,41,43,47,49,53]
     λ> unifactorizables !! 300
     1873

λ> take 20 unifactorizables

[2,3,4,5,7,9,11,13,17,19,23,25,29,31,37,41,43,47,49,53]

λ> unifactorizables !! 300

1873

Soluciones

import Test.QuickCheck
import Data.List (nub, sort, subsequences)

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

sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto n xs =
  [ys | ys <- subsequences xs
      , product ys == n]

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

sublistasConProducto2 :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto2 _ [] = []
sublistasConProducto2 n (x:xs)
  | x > n     = []
  | x == n    = [[x]]
  | r == 0    = map (x:) (sublistasConProducto2 q xs)
                ++ sublistasConProducto2 n xs
  | otherwise = sublistasConProducto2 n xs
  where (q,r) = quotRem n x

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_sublistasConProducto :: Integer -> [Integer] -> Bool
prop_sublistasConProducto n xs =
  sort (sublistasConProducto n' xs') == sublistasConProducto2 n' xs'
  where n'  = 2 + abs n
        xs' = (nub . sort . map ((+2) . abs)) xs

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=30}) prop_sublistasConProducto
--    +++ OK, passed 100 tests.

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

--    λ> sublistasConProducto 15 [1..23]
--    [[3,5],[1,3,5],[15],[1,15]]
--    (3.44 secs, 7,885,411,472 bytes)
--    λ> sublistasConProducto2 15 [1..23]
--    [[1,3,5],[1,15],[3,5],[15]]
--    (0.01 secs, 135,056 bytes)
--
--    λ> length (sublistasConProducto2 1234567 [1..1234567])
--    4
--    (1.49 secs, 1,054,380,480 bytes)

-- Definición de unifactorizables
-- ==============================

unifactorizables :: [Integer]
unifactorizables =
  [n | n <- [2..]
     , length (sublistasConProducto2 n [2..n]) == 1]

import Test.QuickCheck

import Data.List (nub, sort, subsequences)

-- 1ª solución

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

sublistasConProducto :: Integer -> [Integer] -> [[Integer]]

sublistasConProducto n xs =

[ys | ys <- subsequences xs

, product ys == n]

-- 2ª solución

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

sublistasConProducto2 :: Integer -> [Integer] -> [[Integer]]

sublistasConProducto2 _ [] = []

sublistasConProducto2 n (x:xs)

| x > n = []

| x == n = [[x]]

| r == 0 = map (x:) (sublistasConProducto2 q xs)

++ sublistasConProducto2 n xs

| otherwise = sublistasConProducto2 n xs

where (q,r) = quotRem n x

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sublistasConProducto :: Integer -> [Integer] -> Bool

prop_sublistasConProducto n xs =

sort (sublistasConProducto n' xs') == sublistasConProducto2 n' xs'

where n' = 2 + abs n

xs' = (nub . sort . map ((+2) . abs)) xs

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=30}) prop_sublistasConProducto

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sublistasConProducto 15 [1..23]

-- [[3,5],[1,3,5],[15],[1,15]]

-- (3.44 secs, 7,885,411,472 bytes)

-- λ> sublistasConProducto2 15 [1..23]

-- [[1,3,5],[1,15],[3,5],[15]]

-- (0.01 secs, 135,056 bytes)

-- λ> length (sublistasConProducto2 1234567 [1..1234567])

-- 4

-- (1.49 secs, 1,054,380,480 bytes)

-- Definición de unifactorizables

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

unifactorizables :: [Integer]

unifactorizables =

[n | n <- [2..]

, length (sublistasConProducto2 n [2..n]) == 1]

Pensamiento

Y en el encinar,
¡luna redonda y beata,
siempre conmigo a la par!
Cerca de Úbeda la grande,
cuyos cerros nadie verá,
me iba siguiendo la luna
sobre el olivar.
Una luna jadeante,
siempre conmigo a la par.

Antonio Machado

Transformaciones lineales de números triangulares

PorJosé A. Alonso 4-diciembre-201911-diciembre-2019

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 8 primeros números triangulares son

    1 = 1
    3 = 1+2
    6 = 1+2+3
   10 = 1+2+3+4
   15 = 1+2+3+4+5
   21 = 1+2+3+4+5+6
   28 = 1+2+3+4+5+6+7
   36 = 1+2+3+4+5+6+7+8

1 = 1

3 = 1+2

6 = 1+2+3

10 = 1+2+3+4

15 = 1+2+3+4+5

21 = 1+2+3+4+5+6

28 = 1+2+3+4+5+6+7

36 = 1+2+3+4+5+6+7+8

Para cada número triangular n existen números naturales a y b, tales que a . n + b también es triangular. Para n = 6, se tiene que

    6 = 1 * 6 + 0
   15 = 2 * 6 + 3
   21 = 3 * 6 + 3
   28 = 4 * 6 + 4
   36 = 5 * 6 + 6

6 = 1 * 6 + 0

15 = 2 * 6 + 3

21 = 3 * 6 + 3

28 = 4 * 6 + 4

36 = 5 * 6 + 6

son números triangulares

Definir la función

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

1	transformaciones :: Integer -> [(Integer,Integer)]

tal que si n es triangular, (transformaciones n) es la lista de los pares (a,b) tales que a es un entero positivo y b el menor número tal que a . n + b es triangular. Por ejemplo,

   take 5 (transformaciones 6)  == [(1,0),(2,3),(3,3),(4,4),(5,6)]
   take 5 (transformaciones 15) == [(1,0),(2,6),(3,10),(4,6),(5,3)]
   transformaciones 21 !! (7*10^7) == (70000001,39732)

take 5 (transformaciones 6) == [(1,0),(2,3),(3,3),(4,4),(5,6)]

take 5 (transformaciones 15) == [(1,0),(2,6),(3,10),(4,6),(5,3)]

transformaciones 21 !! (7*10^7) == (70000001,39732)

Soluciones

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

transformaciones :: Integer -> [(Integer,Integer)]
transformaciones n = (1,0) : [(a, f a) | a <- [2..]]
  where f a = head (dropWhile (<= a*n) triangulares) - a*n

-- triangulares es la lista de los números triangulares. Por ejemplo,  
--    take 5 triangulares == [1,3,6,10,15]
triangulares :: [Integer]
triangulares = scanl1 (+) [1..]

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

transformaciones2 :: Integer -> [(Integer,Integer)]
transformaciones2 n = (1,0): map g [2..]
  where g a = (a, head (dropWhile (<= a*n) triangulares) - a*n)

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

--    λ> transformaciones 21 !! (2*10^7)
--    (20000001,21615)
--    (3.02 secs, 4,320,111,544 bytes)
--    λ> transformaciones2 21 !! (2*10^7)
--    (20000001,21615)
--    (0.44 secs, 3,200,112,320 bytes)
--
--    λ> transformaciones2 21 !! (7*10^7)
--    (70000001,39732)
--    (1.41 secs, 11,200,885,336 bytes)

-- 1ª solución

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

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

transformaciones n = (1,0) : [(a, f a) | a <- [2..]]

where f a = head (dropWhile (<= a*n) triangulares) - a*n

-- triangulares es la lista de los números triangulares. Por ejemplo,

-- take 5 triangulares == [1,3,6,10,15]

triangulares :: [Integer]

triangulares = scanl1 (+) [1..]

-- 2ª solución

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

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

transformaciones2 n = (1,0): map g [2..]

where g a = (a, head (dropWhile (<= a*n) triangulares) - a*n)

-- Comparación de eficiencia

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

-- λ> transformaciones 21 !! (2*10^7)

-- (20000001,21615)

-- (3.02 secs, 4,320,111,544 bytes)

-- λ> transformaciones2 21 !! (2*10^7)

-- (20000001,21615)

-- (0.44 secs, 3,200,112,320 bytes)

-- λ> transformaciones2 21 !! (7*10^7)

-- (70000001,39732)

-- (1.41 secs, 11,200,885,336 bytes)

Pensamiento

A la hora del rocío,
de la niebla salen
sierra blanca y prado verde.
¡El sol en los encinares!

Antonio Machado

Múltiplos con ceros y unos

PorJosé A. Alonso 3-diciembre-201925-marzo-2022

Se observa que todos los primeros números naturales tienen al menos un múltiplo no nulo que está formado solamente por ceros y unos. Por ejemplo, 1×10=10, 2×5=10, 3×37=111, 4×25=100, 5×2=10, 6×185=1110; 7×143=1001; 8X125=1000; 9×12345679=111111111.

Definir la función

   multiplosCon1y0 :: Integer -> [Integer]

1	multiplosCon1y0 :: Integer -> [Integer]

tal que (multiplosCon1y0 n) es la lista de los múltiplos de n cuyos dígitos son 1 ó 0. Por ejemplo,

   take 4 (multiplosCon1y0 3)      ==  [111,1011,1101,1110]
   take 3 (multiplosCon1y0 23)     ==  [110101,1011011,1101010]
   head (multiplosCon1y0 1234658)  ==  110101101101000000110

take 4 (multiplosCon1y0 3) == [111,1011,1101,1110]

take 3 (multiplosCon1y0 23) == [110101,1011011,1101010]

head (multiplosCon1y0 1234658) == 110101101101000000110

Comprobar con QuickCheck que todo entero positivo tiene algún múltiplo cuyos dígitos son 1 ó 0.

Soluciones

import Test.QuickCheck

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

multiplosCon1y0 :: Integer -> [Integer]
multiplosCon1y0 n = [x | x <- multiplos n
                       , todos1y0 x]

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo, 
--    take 12 (multiplos 5)  ==  [5,10,15,20,25,30,35,40,45,50,55,60]
multiplos :: Integer -> [Integer]
multiplos n = [n,2*n..]

-- (todos1y0 n) se verifica si todos los dígitos de n son el 1 o el
-- 0. Por ejmplo,
--    todos1y0 1101110  ==  True
--    todos1y0 1102110  ==  False
todos1y0 :: Integer -> Bool
todos1y0 n = all (`elem` "01") (show n)

-- 2ª definición
-- =============
    
multiplosCon1y0b :: Integer -> [Integer] 
multiplosCon1y0b n = 
    [x | x <- numerosCon1y0
       , x `rem` n == 0] 

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por
-- ejemplo,  
--    ghci> take 15 numerosCon1y0
--    [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]
numerosCon1y0 :: [Integer]
numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

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

--    λ> head (multiplosCon1y0 9)
--    111111111
--    (7.70 secs, 10,853,320,456 bytes)
--    λ> head (multiplosCon1y0b 9)
--    111111111
--    (0.01 secs, 167,992 bytes)
                        
-- Comprobación de la propiedad
-- ============================
                        
-- La propiedad es
prop_existe_multiplosCon1y0 :: Integer -> Property
prop_existe_multiplosCon1y0 n = 
    n > 0 ==> (not . null) (multiplosCon1y0b n)

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

import Test.QuickCheck

-- 1ª definición

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

multiplosCon1y0 :: Integer -> [Integer]

multiplosCon1y0 n = [x | x <- multiplos n

, todos1y0 x]

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo,

-- take 12 (multiplos 5) == [5,10,15,20,25,30,35,40,45,50,55,60]

multiplos :: Integer -> [Integer]

multiplos n = [n,2*n..]

-- (todos1y0 n) se verifica si todos los dígitos de n son el 1 o el

-- 0. Por ejmplo,

-- todos1y0 1101110 == True

-- todos1y0 1102110 == False

todos1y0 :: Integer -> Bool

todos1y0 n = all (`elem` "01") (show n)

-- 2ª definición

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

multiplosCon1y0b :: Integer -> [Integer]

multiplosCon1y0b n =

[x | x <- numerosCon1y0

, x `rem` n == 0]

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por

-- ejemplo,

-- ghci> take 15 numerosCon1y0

-- [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]

numerosCon1y0 :: [Integer]

numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

-- Comparación de eficiencia

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

-- λ> head (multiplosCon1y0 9)

-- 111111111

-- (7.70 secs, 10,853,320,456 bytes)

-- λ> head (multiplosCon1y0b 9)

-- 111111111

-- (0.01 secs, 167,992 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_existe_multiplosCon1y0 :: Integer -> Property

prop_existe_multiplosCon1y0 n =

n > 0 ==> (not . null) (multiplosCon1y0b n)

-- La comprobación es

-- λ> quickCheck prop_existe_multiplosCon1y0

-- +++ OK, passed 100 tests.

Pensamiento

Huye del triste amor, amor pacato,
sin peligro, sin venda ni aventura,
que espera del amor prenda segura,
porque en amor locura es lo sensato.

Antonio Machado

Múltiplos palíndromos

PorJosé A. Alonso 2-diciembre-201911-diciembre-2019

Los números 545, 5995 y 15151 son los tres menores palíndromos (capicúas) que son divisibles por 109.

Definir las funciones

   multiplosPalindromos :: Integer -> [Integer]
   multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

1 2	multiplosPalindromos :: Integer -> [Integer] multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

tales que

(multiplosPalindromos n) es la lista de los palíndromos divisibles por n. Por ejemplo,

     take 5 (multiplosPalindromos 109) == [545,5995,15151,64746,74447]

1	take 5 (multiplosPalindromos 109) == [545,5995,15151,64746,74447]

(multiplosPalindromosMenores x n) es la lista de los palíndromos divisibles por n, menores que x. Por ejemplo,

     λ> multiplosPalindromosMenores (10^5) 109
     [545,5995,15151,64746,74447,79897,84148,89598,99299]

1 2	λ> multiplosPalindromosMenores (10^5) 109 [545,5995,15151,64746,74447,79897,84148,89598,99299]

Nota: Este ejercicio está basado en el problema 655 del Proyecto Euler.

Soluciones

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

multiplosPalindromos :: Integer -> [Integer]
multiplosPalindromos n =
  [x | x <- multiplos n
     , esPalindromo x]

-- (esPalindromo n) se verifica si n es palíndromo. Por ejemplo, 
--    esPalindromo 32523  ==  True
--    esPalindromo 32533  ==  False
esPalindromo :: Integer -> Bool
esPalindromo n = reverse xs == xs
  where xs = show n

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo, 
--    take 12 (multiplos 5)  ==  [5,10,15,20,25,30,35,40,45,50,55,60]
multiplos :: Integer -> [Integer]
multiplos n = [n,2*n..]

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

multiplosPalindromos2 :: Integer -> [Integer]
multiplosPalindromos2 = filter esPalindromo . multiplos 

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

multiplosPalindromosMenores :: Integer -> Integer -> [Integer]
multiplosPalindromosMenores x n =
  takeWhile (<x) (multiplosPalindromos n)

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

multiplosPalindromosMenores2 :: Integer -> Integer -> [Integer]
multiplosPalindromosMenores2 x =
  takeWhile (<x) . multiplosPalindromos

-- 1ª definición de multiplosPalindromos

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

multiplosPalindromos :: Integer -> [Integer]

multiplosPalindromos n =

[x | x <- multiplos n

, esPalindromo x]

-- (esPalindromo n) se verifica si n es palíndromo. Por ejemplo,

-- esPalindromo 32523 == True

-- esPalindromo 32533 == False

esPalindromo :: Integer -> Bool

esPalindromo n = reverse xs == xs

where xs = show n

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo,

-- take 12 (multiplos 5) == [5,10,15,20,25,30,35,40,45,50,55,60]

multiplos :: Integer -> [Integer]

multiplos n = [n,2*n..]

-- 2ª definición de multiplosPalindromos

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

multiplosPalindromos2 :: Integer -> [Integer]

multiplosPalindromos2 = filter esPalindromo . multiplos

-- 1ª definición de multiplosPalindromosMenores

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

multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

multiplosPalindromosMenores x n =

takeWhile (<x) (multiplosPalindromos n)

-- 2ª definición de multiplosPalindromosMenores

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

multiplosPalindromosMenores2 :: Integer -> Integer -> [Integer]

multiplosPalindromosMenores2 x =

takeWhile (<x) . multiplosPalindromos

Pensamiento

Esta luz de Sevilla… Es el palacio
donde nací, con su rumor de fuente.

Antonio Machado

Meses: diciembre 2019

Sublistas con producto dado

Soluciones

Pensamiento

Transformaciones lineales de números triangulares

Soluciones

Pensamiento

Múltiplos con ceros y unos

Soluciones

Pensamiento

Múltiplos palíndromos

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico