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

4 Comentarios

import Data.Numbers.Primes (isPrime, primeFactors)
import Data.List (genericLength, nub, group)

unifactorizables :: [Integer]
unifactorizables = primosOcuadradosDePrimos

primosOcuadradosDePrimos :: [Integer]
primosOcuadradosDePrimos =
  [x | x<- [2..]
     , isPrime x || factorizacion x == [(head (primeFactors x),2)] ]

factorizacion :: Integer -> [(Integer,Integer)]
factorizacion x = zip (factoresprimos x) (exponentesOrdenados x)

factoresprimos :: Integer -> [Integer]
factoresprimos = nub . primeFactors

exponentesOrdenados :: Integer -> [Integer]
exponentesOrdenados =  map genericLength . group . primeFactors

-- Me falta la primera definicion

import Data.Numbers.Primes (isPrime, primeFactors)

import Data.List (genericLength, nub, group)

unifactorizables :: [Integer]

unifactorizables = primosOcuadradosDePrimos

primosOcuadradosDePrimos :: [Integer]

primosOcuadradosDePrimos =

[x | x<- [2..]

, isPrime x || factorizacion x == [(head (primeFactors x),2)] ]

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

factorizacion x = zip (factoresprimos x) (exponentesOrdenados x)

factoresprimos :: Integer -> [Integer]

factoresprimos = nub . primeFactors

exponentesOrdenados :: Integer -> [Integer]

exponentesOrdenados = map genericLength . group . primeFactors

-- Me falta la primera definicion

Responder

import Data.List
import Data.Numbers.Primes

sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto n xs = sort (producto n xs)

producto :: Integer -> [Integer] -> [[Integer]]
producto n xs = [ys | ys <- subsequences (filter (>1) xs)
                    , product ys == n]

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

divisores :: Integer -> [Integer]
divisores = sort
          . map (product . concat)
          . sequence
          . map inits
          . group
          . primeFactors

import Data.List

import Data.Numbers.Primes

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

sublistasConProducto n xs = sort (producto n xs)

producto :: Integer -> [Integer] -> [[Integer]]

producto n xs = [ys | ys <- subsequences (filter (>1) xs)

, product ys == n]

unifactorizables :: [Integer]

unifactorizables = [n | n <- [2..]

, length (sublistasConProducto n (divisores n)) == 1]

divisores :: Integer -> [Integer]

divisores = sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

Responder

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

sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto n xs = sort (producto n xs)
 
producto :: Integer -> [Integer] -> [[Integer]]
producto n xs = [ys | ys <- subsequences (filter (>1) xs), product ys == n]
 
unifactorizables :: [Integer]
unifactorizables = [n | n <- [2..], isPrime n || cuadradoPrimo n]

cuadradoPrimo :: Integer -> Bool
cuadradoPrimo n
  | fromInteger (round x) == x = isPrime (round x)
  | otherwise = False
  where x = sqrt (fromInteger n)

import Data.List (sort, subsequences)

import Data.Numbers.Primes (isPrime)

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

sublistasConProducto n xs = sort (producto n xs)

producto :: Integer -> [Integer] -> [[Integer]]

producto n xs = [ys | ys <- subsequences (filter (>1) xs), product ys == n]

unifactorizables :: [Integer]

unifactorizables = [n | n <- [2..], isPrime n || cuadradoPrimo n]

cuadradoPrimo :: Integer -> Bool

cuadradoPrimo n

| fromInteger (round x) == x = isPrime (round x)

| otherwise = False

where x = sqrt (fromInteger n)

Responder

import Data.Numbers.Primes (primes)
import Data.List (subsequences)

listaCreciente :: [Integer] -> Bool
listaCreciente [] = True
listaCreciente [_] = True
listaCreciente (x:y:xs) | x < y     = listaCreciente xs
                        | otherwise = False

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

primosOcuadradosDePrimos :: [Integer]
primosOcuadradosDePrimos = 
   sort (take (10^6) primes ++ take (10^6) cuadradosDePrimos)

cuadradosDePrimos :: [Integer]
cuadradosDePrimos = [x^2 | x <- primes]

unifactorizables :: [Integer]
unifactorizables = primosOcuadradosDePrimos

import Data.Numbers.Primes (primes)

import Data.List (subsequences)

listaCreciente :: [Integer] -> Bool

listaCreciente [] = True

listaCreciente [_] = True

listaCreciente (x:y:xs) | x < y = listaCreciente xs

| otherwise = False

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

sublistasConProducto n xs =

[ys | ys <- filter listaCreciente (subsequences xs)

, product ys == n]

primosOcuadradosDePrimos :: [Integer]

primosOcuadradosDePrimos =

sort (take (10^6) primes ++ take (10^6) cuadradosDePrimos)

cuadradosDePrimos :: [Integer]

cuadradosDePrimos = [x^2 | x <- primes]

unifactorizables :: [Integer]

unifactorizables = primosOcuadradosDePrimos

Responder

Sublistas con producto dado

Soluciones

Pensamiento

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Pensamiento

Se puede imprimir o compartir con

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico