2016 es un número práctico

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

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

esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1

esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

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

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

--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

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

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

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

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

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

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición

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

esPractico2 :: Integer -> Bool

esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de

-- elementos distintos de la lista creciente xs. Por ejemplo,

-- esSumable [1,2,7] 8 == True

-- esSumable [1,2,7] 6 == False

-- esSumable [1,2,7] 4 == False

-- esSumable [1,2,7] 2 == True

-- esSumable [1,2,7] 0 == True

esSumable :: [Integer] -> Integer -> Bool

esSumable _ 0 = True

esSumable [] _ = False

esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2

-- es práctico syss para su factorización prima

-- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)

-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que

-- 1+e(j)

-- i-1 p(j) - 1

-- p(i) <= 1 + ∏ ----------------

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

and [p <= 1 + c | (p,c) <- zip bases cotas]

where xss = factorizacion n

(x:bases) = map fst xss

cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

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

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

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

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

factorizacion n =

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

-- Comparación de eficiencia

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

-- λ> length [n | n <- [1..400], esPractico1 n]

-- 92

-- (40.21 secs, 8,378,539,464 bytes)

-- λ> length [n | n <- [1..400], esPractico2 n]

-- 92

-- (8.29 secs, 1,109,669,760 bytes)

-- λ> length [n | n <- [1..400], esPractico3 n]

-- 92

-- (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

8 Comentarios

-- Legible pero cuadrático en `check`
factoriza :: ℤ → [(ℤ, Int)]
factoriza n = [(p, length ps) | ps@(p:_) ← group $ primeFactors n]

esPractico :: ℤ → Bool
esPractico = check ∘ reverse ∘ factoriza
  where check [          ] = True
        check [(p, _)    ] = p ≡ 2
        check ((p, _): ps) = check ps ∧ p ≤ 1 + ∏(combs ↥ ps)
                             where combs (p, z) = (p^(z + 1) - 1) ÷ (p - 1)



-- Críptico pero lineal en `check` (más eficiente, ej. `esPractico $ product [1..1000]`)
esPractico' :: ℤ → Bool
esPractico' = isJust ∘ check ∘ reverse ∘ preF
  where preF n = [(p, (p^(length ps + 1) - 1) ÷ (p - 1)) | ps@(p:_) ← group $ primeFactors n]
        check [          ] = η 1
        check [(p, c)    ] = guard (p ≡ 2) » η c
        check ((p, c): ps) = check ps ↪ λcc → guard (p ≤ 1 + cc) » η (c × cc)

-- Legible pero cuadrático en `check`

factoriza :: ℤ → [(ℤ, Int)]

factoriza n = [(p, length ps) | ps@(p:_) ← group $ primeFactors n]

esPractico :: ℤ → Bool

esPractico = check ∘ reverse ∘ factoriza

where check [ ] = True

check [(p, _) ] = p ≡ 2

check ((p, _): ps) = check ps ∧ p ≤ 1 + ∏(combs ↥ ps)

where combs (p, z) = (p^(z + 1) - 1) ÷ (p - 1)

-- Críptico pero lineal en `check` (más eficiente, ej. `esPractico $ product [1..1000]`)

esPractico' :: ℤ → Bool

esPractico' = isJust ∘ check ∘ reverse ∘ preF

where preF n = [(p, (p^(length ps + 1) - 1) ÷ (p - 1)) | ps@(p:_) ← group $ primeFactors n]

check [ ] = η 1

check [(p, c) ] = guard (p ≡ 2) » η c

check ((p, c): ps) = check ps ↪ λcc → guard (p ≤ 1 + cc) » η (c × cc)

Responder

import Data.Numbers.Primes (primeFactors)
import Data.List (group)

-- Aplicando la demostración de Stewart y Sierpiński
-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
esPractico :: Integer -> Bool
esPractico n = and $ zipWith (<=) (tail factores) productos
    where pss = group (primeFactors n)
          factores = [head ys - 1 | ys <- pss]
          productos = scanl1 (*) $ map product pss

import Data.Numbers.Primes (primeFactors)

import Data.List (group)

-- Aplicando la demostración de Stewart y Sierpiński

-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers

esPractico :: Integer -> Bool

esPractico n = and $ zipWith (<=) (tail factores) productos

where pss = group (primeFactors n)

factores = [head ys - 1 | ys <- pss]

productos = scanl1 (*) $ map product pss

Responder

No parece correcto (ej. el 1 sí es práctico, el 7 no, …) ¿no deberías considerar las potencias? (yo también he aplicado la misma relación). PD: los primeros prácticos son: 1, 2, 4, 6, 8, 12, 16, 18, 20, 24, 28, 30, 32, 36, 40, 42, 48, 54, 56, 60, 64, 66, 72, 78, 80, …

Responder

Muchas gracias por la corrección. Había leído demasiado rápido la propuesta de Stewart y Sierpiński. Aquí va la corrección:

import Data.Numbers.Primes (primeFactors)
import Data.List (group)

-- Aplicando la demostración de Stewart y Sierpiński
-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
esPractico :: Integer -> Bool
esPractico 1 = True
esPractico n = (head factores == 2) &&
               and (zipWith (<=) (tail factores) sumaDivisores)
    where pss = group (primeFactors n)
          factores = [head ys | ys <- pss]
          sumaDivisores = tail $ scanl (\acc xs -> acc + sum xs) 1 pss

import Data.Numbers.Primes (primeFactors)

import Data.List (group)

-- Aplicando la demostración de Stewart y Sierpiński

-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers

esPractico :: Integer -> Bool

esPractico 1 = True

esPractico n = (head factores == 2) &&

and (zipWith (<=) (tail factores) sumaDivisores)

where pss = group (primeFactors n)

factores = [head ys | ys <- pss]

sumaDivisores = tail $ scanl (\acc xs -> acc + sum xs) 1 pss

Responder

Abel Martín dice:

7-enero-2016 a las 18:15

Falla para algunos números: 28, 42, 66, 78,…

Responder
1. Chema Cortés dice:
  
  8-enero-2016 a las 09:55
  
  Tienes toda la razón. Añado en un nuevo mensaje una nueva revisión.

Traducción directa (aunque ineficiente).

import Data.List (sort, nub, subsequences)

esPractico :: Integer -> Bool
esPractico n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

import Data.List (sort, nub, subsequences)

esPractico :: Integer -> Bool

esPractico n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

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

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

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

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

Responder

-- Aplicando la propuesta de Stewart y Sierpiński
-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
esPractico :: Integer -> Bool
esPractico 1 = True
esPractico n = even n && and (zipWith (<=) (tail factores) sumaDivisores)
    where pss = group (primeFactors n)
          factores = [head ys | ys <- pss]
          -- suma progresión geométrica Sn = r^0 + r^1 + ... + r^n
          sumag xs = let r = head xs in (r * product xs - 1) `div` (r - 1)
          sumaDivisores = map (+1) $ scanl1 (*) (map sumag pss)

-- Aplicando la propuesta de Stewart y Sierpiński

-- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers

esPractico :: Integer -> Bool

esPractico 1 = True

esPractico n = even n && and (zipWith (<=) (tail factores) sumaDivisores)

where pss = group (primeFactors n)

factores = [head ys | ys <- pss]

-- suma progresión geométrica Sn = r^0 + r^1 + ... + r^n

sumag xs = let r = head xs in (r * product xs - 1) `div` (r - 1)

sumaDivisores = map (+1) $ scanl1 (*) (map sumag pss)

Responder

8 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Referencias

Se puede imprimir o compartir con

8 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico