Inicial

Números balanceados

PorJosé A. Alonso 19-febrero-202126-febrero-2021

Un número está balanceado si tiene un número par de divisores primos (contados con su multiplicidad). Por ejemplo, 60 es balanceado porque tiene 4 divisores primos (2, 2, 3 y 5).

Un balanceador del entero positivo k es par de enteros positivos (a,b) tales que a es menor que b y, para todo x entre 1 y k, el valor del polinomio P(x) = (x+a)*(x+b) es un número balanceado. Por ejemplo, (2,4) es un balanceador de 3 ya que

P(1) = (1+2)*(1+4) = 15 = 3*5     es balanceado
P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado
P(3) = (3+2)*(3+4) = 35 = 5*7     es balanceado

P(1) = (1+2)*(1+4) = 15 = 3*5 es balanceado

P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado

P(3) = (3+2)*(3+4) = 35 = 5*7 es balanceado

Definir la función

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

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

tal que (balanceadores k) es el conjunto de los balanceadores de k. Por ejemplo,

   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 4)
   [(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> head (balanceadores 19)
   (1325,2827)

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 4)

[(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> head (balanceadores 19)

(1325,2827)

Nota: Este ejercicio está basado en el problema N2 de la Olimpíada Internacional de Matemáticas (IMO) del 2009.

Soluciones

import Data.Numbers.Primes (primeFactors)

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

balanceadores :: Integer -> [(Integer,Integer)]
balanceadores k =
  [(a,b) | (a,b) <- pares
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,
--    esBalanceado 60  ==  True
--    esBalanceado 50  ==  False
esBalanceado :: Integer -> Bool
esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que
-- el segundo. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(2,3),(1,4),(2,4),(3,4),(1,5),(2,5),(3,5),(4,5)]
pares :: [(Integer,Integer)]
pares = [(a,b) | b <- [1..]
               , a <- [1..b-1]]

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

balanceadores2 :: Integer -> [(Integer,Integer)]
balanceadores2 1 = balanceadores 1
balanceadores2 k =
  [(a,b) | (a,b) <- balanceadores2 (k-1)
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- 3ª solución
-- ===========

balanceadores3 :: Integer -> [(Integer,Integer)]
balanceadores3 k =
  [(a,b) | (a,b) <- pares
         , and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

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

-- La comparación es
--    λ> head (balanceadores 17)
--    (189,282)
--    (0.53 secs, 1,227,921,384 bytes)
--    λ> head (balanceadores2 17)
--    (189,282)
--    (0.97 secs, 2,483,869,656 bytes)
--    λ> head (balanceadores3 17)
--    (189,282)
--    (0.36 secs, 983,881,264 bytes)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

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

balanceadores k =

[(a,b) | (a,b) <- pares

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,

-- esBalanceado 60 == True

-- esBalanceado 50 == False

esBalanceado :: Integer -> Bool

esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que

-- el segundo. Por ejemplo,

-- λ> take 10 pares

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

pares :: [(Integer,Integer)]

pares = [(a,b) | b <- [1..]

, a <- [1..b-1]]

-- 2ª solución

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

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

balanceadores2 1 = balanceadores 1

balanceadores2 k =

[(a,b) | (a,b) <- balanceadores2 (k-1)

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- 3ª solución

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

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

balanceadores3 k =

[(a,b) | (a,b) <- pares

, and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> head (balanceadores 17)

-- (189,282)

-- (0.53 secs, 1,227,921,384 bytes)

-- λ> head (balanceadores2 17)

-- (189,282)

-- (0.97 secs, 2,483,869,656 bytes)

-- λ> head (balanceadores3 17)

-- (189,282)

-- (0.36 secs, 983,881,264 bytes)

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Cantidad de números oblongos en un intervalo

PorJosé A. Alonso 16-febrero-202123-febrero-2021

Un número oblongo es un número que es el producto de dos números naturales consecutivos; es decir, n es un número oblongo si existe un número natural x tal que n = x(x+1). Por ejemplo, 42 es un número oblongo porque 42 = 6 x 7.

La sucesión de los números oblongos es

   0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

1	0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

En el intervalo [10,30] hay 3 números oblongos (el 12, el 20 y el 30).

Definir las funciones

   oblongos            :: [Integer]
   oblongosEnIntervalo :: Integer -> Integer -> Int

1 2	oblongos :: [Integer] oblongosEnIntervalo :: Integer -> Integer -> Int

tales que

oblongos es la sucesión de los números oblongos. Por ejemplo,

     take 15 oblongos   == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]
     oblongos !! 50     == 2550
     oblongos !! (10^5) == 10000100000
     oblongos !! (10^6) == 1000001000000
     oblongos !! (10^7) == 100000010000000

take 15 oblongos == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]

oblongos !! 50 == 2550

oblongos !! (10^5) == 10000100000

oblongos !! (10^6) == 1000001000000

oblongos !! (10^7) == 100000010000000

(oblongosEnIntervalo a b) es la cantidad de números oblongos en el intervalo [a,b]. Por ejemplo,

     oblongosEnIntervalo 10 30           ==  3
     oblongosEnIntervalo (10^3) (10^10)  ==  99968
     oblongosEnIntervalo (10^3) (10^12)  ==  999968
     oblongosEnIntervalo (10^3) (10^14)  ==  9999968

oblongosEnIntervalo 10 30 == 3

oblongosEnIntervalo (10^3) (10^10) == 99968

oblongosEnIntervalo (10^3) (10^12) == 999968

oblongosEnIntervalo (10^3) (10^14) == 9999968

Soluciones

-- 1ª definición de oblongos
oblongos1 :: [Integer]
oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos
oblongos2 :: [Integer]
oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos
oblongos3 :: [Integer]
oblongos3 = scanl1 (+) [0,2..]

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

--    λ> oblongos1 !! (10^7)
--    100000010000000
--    (3.05 secs, 1,840,112,008 bytes)
--    λ> oblongos2 !! (10^7)
--    100000010000000
--    (0.90 secs, 2,480,112,304 bytes)
--    λ> oblongos3 !! (10^7)
--    100000010000000
--    (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos
-- ======================

-- En lo que sigue, usaremos la 2ª.
oblongos :: [Integer]
oblongos = oblongos2

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int
oblongosEnIntervalo1 a b =
  length [x | x <- [a..b]
            , x `elem` takeWhile (<=b) oblongos]

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int
oblongosEnIntervalo2 a b =
  length (takeWhile (<=b) (dropWhile (< a) oblongos))

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

-- La comparación es
--    λ> oblongosEnIntervalo1 100 (10^5)
--    306
--    (2.43 secs, 1,784,537,632 bytes)
--    λ> oblongosEnIntervalo2 100 (10^5)
--    306
--    (0.01 secs, 119,112 bytes)

-- 1ª definición de oblongos

oblongos1 :: [Integer]

oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos

oblongos2 :: [Integer]

oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos

oblongos3 :: [Integer]

oblongos3 = scanl1 (+) [0,2..]

-- Comparación de eficiencia

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

-- λ> oblongos1 !! (10^7)

-- 100000010000000

-- (3.05 secs, 1,840,112,008 bytes)

-- λ> oblongos2 !! (10^7)

-- 100000010000000

-- (0.90 secs, 2,480,112,304 bytes)

-- λ> oblongos3 !! (10^7)

-- 100000010000000

-- (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos

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

-- En lo que sigue, usaremos la 2ª.

oblongos :: [Integer]

oblongos = oblongos2

-- 1ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int

oblongosEnIntervalo1 a b =

length [x | x <- [a..b]

, x `elem` takeWhile (<=b) oblongos]

-- 2ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int

oblongosEnIntervalo2 a b =

length (takeWhile (<=b) (dropWhile (< a) oblongos))

-- Comparación de eficiencia

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

-- La comparación es

-- λ> oblongosEnIntervalo1 100 (10^5)

-- 306

-- (2.43 secs, 1,784,537,632 bytes)

-- λ> oblongosEnIntervalo2 100 (10^5)

-- 306

-- (0.01 secs, 119,112 bytes)

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Ternas potencias de dos

PorJosé A. Alonso 10-febrero-202117-febrero-2021

Una terna (a,b,c) de números enteros positivos es especial si se verifica que ab-c, bc-a y ca-b son potencias de 2. Por ejemplo, (3,5,7) es especial ya que

   3 * 5 - 7 =  8 = 2^3
   5 * 7 - 3 = 32 = 2^5
   7 * 3 - 5 = 16 = 2^4

3 * 5 - 7 = 8 = 2^3

5 * 7 - 3 = 32 = 2^5

7 * 3 - 5 = 16 = 2^4

Definir las funciones

   esEspecial       :: (Integer,Integer,Integer) -> Bool
   ternasEspeciales :: [(Integer,Integer,Integer)]

1 2	esEspecial :: (Integer,Integer,Integer) -> Bool ternasEspeciales :: [(Integer,Integer,Integer)]

tales que

(esEspecial t) se verifica si t es una terna especial. Por ejemplo,

     esEspecial (3,5,7)  ==  True
     esEspecial (5,7,9)  ==  False

1 2	esEspecial (3,5,7) == True esEspecial (5,7,9) == False

ternasEspeciales es la lista de las ternasEspeciales ordenadas según su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

     λ> take 16 ternasEspeciales
     [(2,2,2),
      (2,2,3),(2,3,2),(3,2,2),
      (3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),
      (2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

λ> take 16 ternasEspeciales

[(2,2,2),

(2,2,3),(2,3,2),(3,2,2),

(3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),

(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

Comprobar con QuickCheck que sólo hay 16 ternas especiales; es decir, para toda terna t de enteros positivos, t pertenece a la lista de los 16 primeros elementos de ternasEspeciales o no es una terna especial.

Nota: Este ejercicio está basado en el problema N5 de la Olimpíada Internacional de Matemáticas (IMO) del 2015.

Soluciones

import Data.List (nub, permutations, sort)
import Data.Numbers.Primes (primeFactors)
import Data.Bits ((.&.))
import Test.QuickCheck (Property, (==>), quickCheck)

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

esEspecial1 :: (Integer,Integer,Integer) -> Bool
esEspecial1 (a,b,c) =
  all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por
-- ejemplo.
--    esPotenciaDeDos  8  == True
--    esPotenciaDeDos 32  == True
--    esPotenciaDeDos  0  == False
--    esPotenciaDeDos  1  == True
--    esPotenciaDeDos  2  == True
--    esPotenciaDeDos  6  == False
esPotenciaDeDos1 :: Integer -> Bool
esPotenciaDeDos1 n
    | n <= 0    = False
    | n <= 2    = True
    | even n    = esPotenciaDeDos1 (n `div` 2)
    | otherwise = False

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

esEspecial2 :: (Integer,Integer,Integer) -> Bool
esEspecial2 (a,b,c) =
  all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool
esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

esEspecial3 :: (Integer,Integer,Integer) -> Bool
esEspecial3 (a,b,c) =
  all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool
esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial
-- ===========================

esEspecial4 :: (Integer,Integer,Integer) -> Bool
esEspecial4 (a,b,c) =
  all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la
-- librería Data.Bits. Dicha función calcula el número correspondiente a
-- la conjunción de las representaciones binarias de sus argumentos. Por
-- ejemplo,
--    6 .&. 3 == 2
-- ya que
--    la representación binaria de 6 es     [1,1,0]
--    la representación binaria de 3 es       [1,1]
--    la conjunción es                        [1,0]
--    la representación decimal de [1,0] es   2
--
-- Otros ejemplos:
--    4 .&. 3 ==   [1,0,0] .&.   [1,1] == 0
--    8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0
esPotenciaDeDos4 :: Integer -> Bool
esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial
-- ===========================================================

-- La comparación es
--    λ> esEspecial1 (2^300000,2,0)
--    False
--    (3.05 secs, 5,765,728,296 bytes)
--    λ> esEspecial2 (2^300000,2,0)
--    False
--    (2.68 secs, 5,755,293,608 bytes)
--    λ> esEspecial3 (2^300000,2,0)
--    False
--    (2.45 secs, 5,758,527,232 bytes)
--    λ> esEspecial4 (2^300000,2,0)
--    False
--    (0.01 secs, 516,512 bytes)

-- Definición de esEspecial
-- ========================

-- En lo sucesivo usaremos la 4ª definición.
esEspecial :: (Integer,Integer,Integer) -> Bool
esEspecial = esEspecial4

-- Definición de ternasEspeciales
-- ==============================

--    λ> take 16 ternasEspeciales
--    [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),
--     (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]
ternasEspeciales :: [(Integer,Integer,Integer)]
ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden
-- descrito anteriormente. Por ejemplo,
--    λ> take 20 ternas
--    [(1,1,1),
--     (1,1,2),(1,2,1),(2,1,1),
--     (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
--     (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])


-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

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

-- La propiedad es
prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property
prop_ternasEspeciales (a,b,c) =
  a > 0 && b > 0 && c > 0 ==>
  (a,b,c) `elem` xs || not (esEspecial (a,b,c))
  where xs = take 16 ternasEspeciales

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

import Data.List (nub, permutations, sort)

import Data.Numbers.Primes (primeFactors)

import Data.Bits ((.&.))

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición de esEspecial

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

esEspecial1 :: (Integer,Integer,Integer) -> Bool

esEspecial1 (a,b,c) =

all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por

-- ejemplo.

-- esPotenciaDeDos 8 == True

-- esPotenciaDeDos 32 == True

-- esPotenciaDeDos 0 == False

-- esPotenciaDeDos 1 == True

-- esPotenciaDeDos 2 == True

-- esPotenciaDeDos 6 == False

esPotenciaDeDos1 :: Integer -> Bool

esPotenciaDeDos1 n

| n <= 0 = False

| n <= 2 = True

| even n = esPotenciaDeDos1 (n `div` 2)

| otherwise = False

-- 2ª definición de esEspecial

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

esEspecial2 :: (Integer,Integer,Integer) -> Bool

esEspecial2 (a,b,c) =

all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool

esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- 3ª definición de esEspecial

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

esEspecial3 :: (Integer,Integer,Integer) -> Bool

esEspecial3 (a,b,c) =

all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool

esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial

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

esEspecial4 :: (Integer,Integer,Integer) -> Bool

esEspecial4 (a,b,c) =

all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la

-- librería Data.Bits. Dicha función calcula el número correspondiente a

-- la conjunción de las representaciones binarias de sus argumentos. Por

-- ejemplo,

-- 6 .&. 3 == 2

-- ya que

-- la representación binaria de 6 es [1,1,0]

-- la representación binaria de 3 es [1,1]

-- la conjunción es [1,0]

-- la representación decimal de [1,0] es 2

-- Otros ejemplos:

-- 4 .&. 3 == [1,0,0] .&. [1,1] == 0

-- 8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool

esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial

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

-- La comparación es

-- λ> esEspecial1 (2^300000,2,0)

-- False

-- (3.05 secs, 5,765,728,296 bytes)

-- λ> esEspecial2 (2^300000,2,0)

-- False

-- (2.68 secs, 5,755,293,608 bytes)

-- λ> esEspecial3 (2^300000,2,0)

-- False

-- (2.45 secs, 5,758,527,232 bytes)

-- λ> esEspecial4 (2^300000,2,0)

-- False

-- (0.01 secs, 516,512 bytes)

-- Definición de esEspecial

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

-- En lo sucesivo usaremos la 4ª definición.

esEspecial :: (Integer,Integer,Integer) -> Bool

esEspecial = esEspecial4

-- Definición de ternasEspeciales

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

-- λ> take 16 ternasEspeciales

-- [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),

-- (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

ternasEspeciales :: [(Integer,Integer,Integer)]

ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden

-- descrito anteriormente. Por ejemplo,

-- λ> take 20 ternas

-- [(1,1,1),

-- (1,1,2),(1,2,1),(2,1,1),

-- (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),

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

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

-- Propiedad

-- =========

-- La propiedad es

prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property

prop_ternasEspeciales (a,b,c) =

a > 0 && b > 0 && c > 0 ==>

(a,b,c) `elem` xs || not (esEspecial (a,b,c))

where xs = take 16 ternasEspeciales

-- La comprobación es

-- λ> quickCheck prop_ternasEspeciales

-- +++ OK, passed 100 tests.

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Ordenación de ternas de enteros

PorJosé A. Alonso 9-febrero-202116-febrero-2021

Las ternas de números enteros positivos se pueden ordenar por su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

ternas de suma 3:

   (1,1,1)

(1,1,1)

ternas de suma 4:

   (1,1,2),(1,2,1),(2,1,1)

1	(1,1,2),(1,2,1),(2,1,1)

ternas de suma 5:

   (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)

1	(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)

ternas de suma 6

   (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

1	(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

y así sucesivamente.

Definir la función

   ternas :: [(integer,integer,integer)]

1	ternas :: [(integer,integer,integer)]

tal que ternas es la lista de las ternas de enteros positivos con el orden descrito anteriormente. por ejemplo,

   λ> take 20 ternas
   [(1,1,1),
    (1,1,2),(1,2,1),(2,1,1),
    (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
    (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]

λ> take 20 ternas

[(1,1,1),

(1,1,2),(1,2,1),(2,1,1),

(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),

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

Soluciones

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Listas obtenidas borrando k elementos

PorJosé A. Alonso 5-febrero-202112-febrero-2021

Definir la función

   borra :: Int -> [a] -> [[a]]

1	borra :: Int -> [a] -> [[a]]

tal que (borra n xs) es la lista de las listas obtenidas borrando n elementos de xs. Por ejemplo,

   borra 0 "abcd"  ==  ["abcd"]
   borra 1 "abcd"  ==  ["abc","abd","acd","bcd"]
   borra 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
   borra 3 "abcd"  ==  ["a","b","c","d"]
   borra 4 "abcd"  ==  [""]
   borra 5 "abcd"  ==  []
   borra 6 "abcd"  ==  []
   length (borra 2 [1..300])  ==  44850

borra 0 "abcd" == ["abcd"]

borra 1 "abcd" == ["abc","abd","acd","bcd"]

borra 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

borra 3 "abcd" == ["a","b","c","d"]

borra 4 "abcd" == [""]

borra 5 "abcd" == []

borra 6 "abcd" == []

length (borra 2 [1..300]) == 44850

Soluciones

import Data.List (nub, subsequences)

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

borra1 :: Eq a => Int -> [a] -> [[a]]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n

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

borra2 :: Eq a => Int -> [a] -> [[a]]
borra2 0 xs     = [xs]
borra2 n []     = []
borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª solución
-- ===========

borra3 :: Eq a => Int -> [a] -> [[a]]
borra3 n xs =
  nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la
-- lista no vacía xs de todas las formas posibles. Por ejemplo,
--    borraUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
borraUno :: [a] -> [[a]]
borraUno [x] = [[]]
borraUno (x:xs) = xs : map (x:) (borraUno xs)

--    borraUnoListas ["abc", "def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al
-- elemento x. Por ejmplo,
--    itera 3 (*2) 1   ==  8
--    itera 4 (+2) 10  ==  18
itera :: Eq a => Int -> (a -> a) -> a -> a
itera 0 _ x = x
itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera
itera2 :: Eq a => Int -> (a -> a) -> a -> a
itera2 0 _ = id
itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera
itera3 :: Eq a => Int -> (a -> a) -> a -> a
itera3 n f x = (iterate f x) !! n

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

-- La comparación es
--    λ> length (borra1 10 [1..11])
--    11
--    (0.03 secs, 527,712 bytes)
--    λ> length (borra2 10 [1..11])
--    11
--    (0.01 secs, 917,720 bytes)
--    λ> length (borra3 10 [1..11])
--    11
--    (22.32 secs, 20,104,455,496 bytes)
--
--    λ> length (borra1 25 [1..26])
--    26
--    (16.30 secs, 13,958,748,280 bytes)
--    λ> length (borra2 25 [1..26])
--    26
--    (36.36 secs, 25,769,904,744 bytes)
--
--    λ> length (borra1 2 [1..26])
--    325
--    (16.51 secs, 13,958,767,696 bytes)
--    λ> length (borra2 2 [1..26])
--    325
--    (0.01 secs, 168,272 bytes)
--    λ> length (borra3 2 [1..26])
--    325
--    (0.03 secs, 1,209,992 bytes)
--
--    λ> length (borra2 2 [1..100])
--    4950
--    (0.06 secs, 59,128,272 bytes)
--    λ> length (borra3 2 [1..100])
--    4950
--    (6.37 secs, 57,943,128 bytes)

import Data.List (nub, subsequences)

-- 1ª solución

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

borra1 :: Eq a => Int -> [a] -> [[a]]

borra1 n xs = [ys | ys <- subsequences xs, length ys == k]

where k = length xs - n

-- 2ª solución

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

borra2 :: Eq a => Int -> [a] -> [[a]]

borra2 0 xs = [xs]

borra2 n [] = []

borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª solución

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

borra3 :: Eq a => Int -> [a] -> [[a]]

borra3 n xs =

nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la

-- lista no vacía xs de todas las formas posibles. Por ejemplo,

-- borraUno "abcde" == ["bcde","acde","abde","abce","abcd"]

borraUno :: [a] -> [[a]]

borraUno [x] = [[]]

borraUno (x:xs) = xs : map (x:) (borraUno xs)

-- borraUnoListas ["abc", "def"] == ["bc","ac","ab","ef","df","de"]

borraUnoListas :: [[a]] -> [[a]]

borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al

-- elemento x. Por ejmplo,

-- itera 3 (*2) 1 == 8

-- itera 4 (+2) 10 == 18

itera :: Eq a => Int -> (a -> a) -> a -> a

itera 0 _ x = x

itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera

itera2 :: Eq a => Int -> (a -> a) -> a -> a

itera2 0 _ = id

itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera

itera3 :: Eq a => Int -> (a -> a) -> a -> a

itera3 n f x = (iterate f x) !! n

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (borra1 10 [1..11])

-- 11

-- (0.03 secs, 527,712 bytes)

-- λ> length (borra2 10 [1..11])

-- 11

-- (0.01 secs, 917,720 bytes)

-- λ> length (borra3 10 [1..11])

-- 11

-- (22.32 secs, 20,104,455,496 bytes)

-- λ> length (borra1 25 [1..26])

-- 26

-- (16.30 secs, 13,958,748,280 bytes)

-- λ> length (borra2 25 [1..26])

-- 26

-- (36.36 secs, 25,769,904,744 bytes)

-- λ> length (borra1 2 [1..26])

-- 325

-- (16.51 secs, 13,958,767,696 bytes)

-- λ> length (borra2 2 [1..26])

-- 325

-- (0.01 secs, 168,272 bytes)

-- λ> length (borra3 2 [1..26])

-- 325

-- (0.03 secs, 1,209,992 bytes)

-- λ> length (borra2 2 [1..100])

-- 4950

-- (0.06 secs, 59,128,272 bytes)

-- λ> length (borra3 2 [1..100])

-- 4950

-- (6.37 secs, 57,943,128 bytes)

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Números balanceados

Soluciones

Nuevas soluciones

Cantidad de números oblongos en un intervalo

Soluciones

Nuevas soluciones

Ternas potencias de dos

Soluciones

Nuevas soluciones

Ordenación de ternas de enteros

Soluciones

Nuevas soluciones

Listas obtenidas borrando k elementos

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico