febrero 2021 – Página 3

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>

Mayor número borrando k dígitos

PorJosé A. Alonso 8-febrero-202115-febrero-2021

Definir la función

   mayorBorrando :: Int -> Integer -> Integer

1	mayorBorrando :: Int -> Integer -> Integer

tal que (mayorBorrando k n) es el mayor número obtenido borrando k dígitos de n (se supone que n tiene más de k dígitos). Por ejemplo,

   mayorBorrando 1 6782334  ==  782334
   mayorBorrando 3 6782334  ==  8334
   mayorBorrando 3 10020    ==  20
   mayorBorrando 1000000 (4256 + 10^1000004) == 14256

mayorBorrando 1 6782334 == 782334

mayorBorrando 3 6782334 == 8334

mayorBorrando 3 10020 == 20

mayorBorrando 1000000 (4256 + 10^1000004) == 14256

Soluciones

import Data.List (subsequences)

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

mayorBorrando :: Int -> Integer -> Integer
mayorBorrando k n = read (mayorBorrandoLista1 k (show n))

-- (mayorBorrandoLista1 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista1 1 "6782334"  ==  "782334"
--    mayorBorrandoLista1 3 "6782334"  ==  "8334"
mayorBorrandoLista1 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista1 k xs = maximum (borra1 k xs)

-- (borra1 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra1 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra1 2 "abcd"  ==  ["ab","ac","bc","ad","bd","cd"]
--    borra1 3 "abcd"  ==  ["a","b","c","d"]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n

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

mayorBorrando2 :: Int -> Integer -> Integer
mayorBorrando2 k n = read (mayorBorrandoLista2 k (show n))

-- (mayorBorrandoLista2 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista2 1 "6782334"  ==  "782334"
--    mayorBorrandoLista2 3 "6782334"  ==  "8334"
mayorBorrandoLista2 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista2 k xs = maximum (borra2 k xs)

-- (borra2 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra2 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra2 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
--    borra2 3 "abcd"  ==  ["a","b","c","d"]
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ª definición
-- =============

mayorBorrando3 :: Int -> Integer -> Integer
mayorBorrando3 k n = read (mayorBorrandoLista3 k (show n))

-- (mayorBorrandoLista3 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista3 1 "6782334"  ==  "782334"
--    mayorBorrandoLista3 3 "6782334"  ==  "8334"
mayorBorrandoLista3 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista3 k xs = maximum (itera k borraUnoListas [xs])

-- (borraUnoListas xss) es la lista obtenida borrando un elemento (de
-- todas las formas posibles de la lista de listas no vacías xss. Por
-- ejemplo,
--    borraUnoListas ["abc","def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno

-- (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)

-- (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)

-- 4ª definición
-- =============

mayorBorrando4 :: Int -> Integer -> Integer
mayorBorrando4 k n = read (mayorBorrandoLista4 k (show n))

-- (mayorBorrandoLista4 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista4 1 "6782334"  ==  "782334"
--    mayorBorrandoLista4 3 "6782334"  ==  "8334"
mayorBorrandoLista4 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista4 k = itera k mayorBorraUno

-- (mayorBorraUno xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno "6782334"  ==  "782334"
--    mayorBorraUno "782334"   ==  "82334"
--    mayorBorraUno "82334"    ==  "8334"
mayorBorraUno :: Ord a => [a] -> [a]
mayorBorraUno = maximum . borraUno

-- 5ª definición
-- =============

mayorBorrando5 :: Int -> Integer -> Integer
mayorBorrando5 k n = read (mayorBorrandoLista5 k (show n))

-- (mayorBorrandoLista5 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista5 1 "6782334"  ==  "782334"
--    mayorBorrandoLista5 3 "6782334"  ==  "8334"
mayorBorrandoLista5 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista5 k = itera k mayorBorraUno2

-- (mayorBorraUno2 xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno2 "6782334"  ==  "782334"
--    mayorBorraUno2 "782334"   ==  "82334"
--    mayorBorraUno2 "82334"    ==  "8334"
mayorBorraUno2 :: Ord a => [a] -> [a]
mayorBorraUno2 [x]      = []
mayorBorraUno2 (x:y:xs) | x < y     = y:xs
                        | otherwise = x : mayorBorraUno2 (y:xs)

-- 6ª definición
-- =============

mayorBorrando6 :: Int -> Integer -> Integer
mayorBorrando6 k n = read (mayorBorrandoLista6 k (show n))

-- (mayorBorrandoLista6 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista6 1 "6782334"  ==  "782334"
--    mayorBorrandoLista6 3 "6782334"  ==  "8334"
mayorBorrandoLista6 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista6 k xs = aux k [] xs

aux 0 ys     xs     = reverse ys ++ xs
aux k ys     []     = reverse (drop k ys)
aux k []     (x:xs) = aux k [x] xs
aux k (y:ys) (x:xs) | y >= x    = aux k     (x:y:ys) xs
                    | otherwise = aux (k-1) ys       (x:xs)

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

-- La comparación es
--    λ> mayorBorrando 6 (product [1..18])
--    7705728000
--    (0.06 secs, 15,165,496 bytes)
--    λ> mayorBorrando2 6 (product [1..18])
--    7705728000
--    (0.04 secs, 19,662,816 bytes)
--    λ> mayorBorrando3 6 (product [1..18])
--    7705728000
--    (6.93 secs, 5,143,807,064 bytes)
--    λ> mayorBorrando4 6 (product [1..18])
--    7705728000
--    (0.01 secs, 183,728 bytes)
--    λ> mayorBorrando5 6 (product [1..18])
--    7705728000
--    (0.01 secs, 118,984 bytes)
--    λ> mayorBorrando6 6 (product [1..18])
--    7705728000
--
--    λ> mayorBorrando 17 (product [1..25])
--    998400000
--    (19.09 secs, 14,516,359,464 bytes)
--    λ> mayorBorrando2 17 (product [1..25])
--    998400000
--    (47.39 secs, 30,066,413,608 bytes)
--    λ> mayorBorrando4 17 (product [1..25])
--    998400000
--    (0.01 secs, 458,320 bytes)
--    λ> mayorBorrando5 17 (product [1..25])
--    998400000
--    (0.01 secs, 134,424 bytes)
--    λ> mayorBorrando6 17 (product [1..25])
--    984000000
--    (0.01 secs, 124,600 bytes)
--
--    λ> mayorBorrando4 600 (product [1..300])
--    999999999999999
--    (3.29 secs, 4,421,841,944 bytes)
--    λ> mayorBorrando5 600 (product [1..300])
--    999999999999999
--    (0.03 secs, 6,690,440 bytes)
--    λ> mayorBorrando6 600 (product [1..300])
--    960000000000000
--    (0.01 secs, 593,864 bytes)
--
--    λ> mayorBorrando5 10000 (4256 + 10^10004)
--    14256
--    (16.04 secs, 18,221,784,872 bytes)
--    λ> mayorBorrando6 10000 (4256 + 10^10004)
--    14256
--    (0.02 secs, 6,669,592 bytes)
--
--    λ> mayorBorrando6 1000000 (4256 + 10^1000004)
--    14256
--    (1.04 secs, 655,561,656 bytes)

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

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

import Data.List (subsequences)

-- 1ª definición

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

mayorBorrando :: Int -> Integer -> Integer

mayorBorrando k n = read (mayorBorrandoLista1 k (show n))

-- (mayorBorrandoLista1 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista1 1 "6782334" == "782334"

-- mayorBorrandoLista1 3 "6782334" == "8334"

mayorBorrandoLista1 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista1 k xs = maximum (borra1 k xs)

-- (borra1 k xs) es la lista de las listas obtenidas borrando k elementos

-- de xs. Por ejemplo,

-- borra1 1 "abcd" == ["abc","abd","acd","bcd"]

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

-- borra1 3 "abcd" == ["a","b","c","d"]

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

where k = length xs - n

-- 2ª definición

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

mayorBorrando2 :: Int -> Integer -> Integer

mayorBorrando2 k n = read (mayorBorrandoLista2 k (show n))

-- (mayorBorrandoLista2 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista2 1 "6782334" == "782334"

-- mayorBorrandoLista2 3 "6782334" == "8334"

mayorBorrandoLista2 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista2 k xs = maximum (borra2 k xs)

-- (borra2 k xs) es la lista de las listas obtenidas borrando k elementos

-- de xs. Por ejemplo,

-- borra2 1 "abcd" == ["abc","abd","acd","bcd"]

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

-- borra2 3 "abcd" == ["a","b","c","d"]

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ª definición

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

mayorBorrando3 :: Int -> Integer -> Integer

mayorBorrando3 k n = read (mayorBorrandoLista3 k (show n))

-- (mayorBorrandoLista3 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista3 1 "6782334" == "782334"

-- mayorBorrandoLista3 3 "6782334" == "8334"

mayorBorrandoLista3 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista3 k xs = maximum (itera k borraUnoListas [xs])

-- (borraUnoListas xss) es la lista obtenida borrando un elemento (de

-- todas las formas posibles de la lista de listas no vacías xss. Por

-- ejemplo,

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

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

borraUnoListas = concatMap borraUno

-- (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)

-- (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)

-- 4ª definición

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

mayorBorrando4 :: Int -> Integer -> Integer

mayorBorrando4 k n = read (mayorBorrandoLista4 k (show n))

-- (mayorBorrandoLista4 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista4 1 "6782334" == "782334"

-- mayorBorrandoLista4 3 "6782334" == "8334"

mayorBorrandoLista4 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista4 k = itera k mayorBorraUno

-- (mayorBorraUno xs) es la mayor lista obtenida eliminando un elemento de

-- xs. Por ejemplo,

-- mayorBorraUno "6782334" == "782334"

-- mayorBorraUno "782334" == "82334"

-- mayorBorraUno "82334" == "8334"

mayorBorraUno :: Ord a => [a] -> [a]

mayorBorraUno = maximum . borraUno

-- 5ª definición

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

mayorBorrando5 :: Int -> Integer -> Integer

mayorBorrando5 k n = read (mayorBorrandoLista5 k (show n))

-- (mayorBorrandoLista5 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista5 1 "6782334" == "782334"

-- mayorBorrandoLista5 3 "6782334" == "8334"

mayorBorrandoLista5 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista5 k = itera k mayorBorraUno2

-- (mayorBorraUno2 xs) es la mayor lista obtenida eliminando un elemento de

-- xs. Por ejemplo,

-- mayorBorraUno2 "6782334" == "782334"

-- mayorBorraUno2 "782334" == "82334"

-- mayorBorraUno2 "82334" == "8334"

mayorBorraUno2 :: Ord a => [a] -> [a]

mayorBorraUno2 [x] = []

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

| otherwise = x : mayorBorraUno2 (y:xs)

-- 6ª definición

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

mayorBorrando6 :: Int -> Integer -> Integer

mayorBorrando6 k n = read (mayorBorrandoLista6 k (show n))

-- (mayorBorrandoLista6 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista6 1 "6782334" == "782334"

-- mayorBorrandoLista6 3 "6782334" == "8334"

mayorBorrandoLista6 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista6 k xs = aux k [] xs

aux 0 ys xs = reverse ys ++ xs

aux k ys [] = reverse (drop k ys)

aux k [] (x:xs) = aux k [x] xs

aux k (y:ys) (x:xs) | y >= x = aux k (x:y:ys) xs

| otherwise = aux (k-1) ys (x:xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorBorrando 6 (product [1..18])

-- 7705728000

-- (0.06 secs, 15,165,496 bytes)

-- λ> mayorBorrando2 6 (product [1..18])

-- 7705728000

-- (0.04 secs, 19,662,816 bytes)

-- λ> mayorBorrando3 6 (product [1..18])

-- 7705728000

-- (6.93 secs, 5,143,807,064 bytes)

-- λ> mayorBorrando4 6 (product [1..18])

-- 7705728000

-- (0.01 secs, 183,728 bytes)

-- λ> mayorBorrando5 6 (product [1..18])

-- 7705728000

-- (0.01 secs, 118,984 bytes)

-- λ> mayorBorrando6 6 (product [1..18])

-- 7705728000

-- λ> mayorBorrando 17 (product [1..25])

-- 998400000

-- (19.09 secs, 14,516,359,464 bytes)

-- λ> mayorBorrando2 17 (product [1..25])

-- 998400000

-- (47.39 secs, 30,066,413,608 bytes)

-- λ> mayorBorrando4 17 (product [1..25])

-- 998400000

-- (0.01 secs, 458,320 bytes)

-- λ> mayorBorrando5 17 (product [1..25])

-- 998400000

-- (0.01 secs, 134,424 bytes)

-- λ> mayorBorrando6 17 (product [1..25])

-- 984000000

-- (0.01 secs, 124,600 bytes)

-- λ> mayorBorrando4 600 (product [1..300])

-- 999999999999999

-- (3.29 secs, 4,421,841,944 bytes)

-- λ> mayorBorrando5 600 (product [1..300])

-- 999999999999999

-- (0.03 secs, 6,690,440 bytes)

-- λ> mayorBorrando6 600 (product [1..300])

-- 960000000000000

-- (0.01 secs, 593,864 bytes)

-- λ> mayorBorrando5 10000 (4256 + 10^10004)

-- 14256

-- (16.04 secs, 18,221,784,872 bytes)

-- λ> mayorBorrando6 10000 (4256 + 10^10004)

-- 14256

-- (0.02 secs, 6,669,592 bytes)

-- λ> mayorBorrando6 1000000 (4256 + 10^1000004)

-- 14256

-- (1.04 secs, 655,561,656 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>

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>

Pares con múltiplos con igual número de divisores

PorJosé A. Alonso 4-febrero-202111-febrero-2021

Definir la función

   paresNoDivisible :: [(Integer, Integer)]

1	paresNoDivisible :: [(Integer, Integer)]

tal que paresNoDivisible es la lista de los pares (n,k) tales que n < k y k no es divisible por n. Por ejemplo,

   λ> take 10 paresNoDivisible
   [(2,3),(3,4),(2,5),(3,5),(4,5),(4,6),(5,6),(2,7),(3,7),(4,7)]

1 2	λ> take 10 paresNoDivisible [(2,3),(3,4),(2,5),(3,5),(4,5),(4,6),(5,6),(2,7),(3,7),(4,7)]

Se observa que en el resultado los pares se ordenan primero según su segundo elemento y los que tienen el mismo segundo elemento se ordenan por el primer elemento.

Un par especial es un par de enteros positivos (n,k) tales que existe algún s tal que $s \times n$ y $s \times k$ tienen el mismo número de divisores. Por ejemplo, (3,4) es un par especial ya que $2 \times 3$ y $2 \times 4$ tienen 4 divisores.

Comprobar con QuickCheck todos los elementos de paresNoDivisible son pares especiales.

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

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Property, (==>), quickCheck)

-- Definición de paresNoDivisible
-- ==============================

paresNoDivisible :: [(Integer, Integer)]
paresNoDivisible =
  filter parNoDivisible pares

-- pares es la lista de los pares de enteros positivos ordenados primero
-- según su segundo elemento y los que tienen el mismo segundo elemento
-- están ordenados por el primer elemento. 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 =
  [(n,k) | k <- [1..]
         , n <- [1..k-1]]

-- (parNoDivisible (n,k)) se verifica si n < k y k no es divisible por
-- n. Por ejemplo,
--    parNoDivisible (2,3)  ==  True
--    parNoDivisible (2,4)  ==  False
--    parNoDivisible (3,2)  ==  False
parNoDivisible :: (Integer, Integer) -> Bool
parNoDivisible (n,k) =
  n < k &&
  k `mod` n  /= 0

-- Definiciones de parEspecial
-- ===========================

-- Para expresar la propiedad se define la función
--    parEspecial :: (Integer, Integer) -> Bool
-- tal que (parEspecial (n,k)) se verifica si existe algún s tal que s*n
-- y s*k tienen el mismo número de divisores. Por ejemplo, {-# SCC "" #-}
--    parEspecial (3,4)  ==  True
--
-- Nota: La función parEspecial es una función parcial ya que sólo
-- termina para los pares especiales.

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

parEspecial1 :: (Integer, Integer) -> Bool
parEspecial1 (n,k) =
  n < k && not (null [s | s <- [1..]
                       , numeroDivisores (s * n) ==
                         numeroDivisores (s * k)])

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Integer -> Integer
numeroDivisores n =
  genericLength [x | x <- [1..n]
                   , n `mod` x == 0]

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

parEspecial2 :: (Integer, Integer) -> Bool
parEspecial2 (n,k) =
  n < k && not (null [s | s <- [1..]
                       , numeroDivisores2 (s * n) ==
                         numeroDivisores2 (s * k)])

-- (numeroDivisores2 n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores2 12  ==  6
--    numeroDivisores2 14  ==  4
numeroDivisores2 :: Integer -> Integer
numeroDivisores2 =
  product . map ((+1) . genericLength) . group . primeFactors

-- Comparación de eficiencia de definiciones de parEspecial
-- --------------------------------------------------------

-- La comparación es
--    λ> parEspecial1 (9,30)
--    True
--    (28.24 secs, 15,625,373,696 bytes)
--    λ> parEspecial2 (9,30)
--    True
--    (0.06 secs, 58,698,264 bytes)

-- En lo que sigue, usaremos la 2ª definición
parEspecial :: (Integer, Integer) -> Bool
parEspecial = parEspecial2

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

-- La propiedad es
prop_paresNoDivisible :: Int -> Property
prop_paresNoDivisible i =
  i >= 0 ==>
  parEspecial (paresNoDivisible !! i)

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

100

101

102

103

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

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

-- Definición de paresNoDivisible

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

paresNoDivisible :: [(Integer, Integer)]

paresNoDivisible =

filter parNoDivisible pares

-- pares es la lista de los pares de enteros positivos ordenados primero

-- según su segundo elemento y los que tienen el mismo segundo elemento

-- están ordenados por el primer elemento. 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 =

[(n,k) | k <- [1..]

, n <- [1..k-1]]

-- (parNoDivisible (n,k)) se verifica si n < k y k no es divisible por

-- n. Por ejemplo,

-- parNoDivisible (2,3) == True

-- parNoDivisible (2,4) == False

-- parNoDivisible (3,2) == False

parNoDivisible :: (Integer, Integer) -> Bool

parNoDivisible (n,k) =

n < k &&

k `mod` n /= 0

-- Definiciones de parEspecial

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

-- Para expresar la propiedad se define la función

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

-- tal que (parEspecial (n,k)) se verifica si existe algún s tal que s*n

-- y s*k tienen el mismo número de divisores. Por ejemplo, {-# SCC "" #-}

-- parEspecial (3,4) == True

-- Nota: La función parEspecial es una función parcial ya que sólo

-- termina para los pares especiales.

-- 1ª definición de parEspecial

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

parEspecial1 :: (Integer, Integer) -> Bool

parEspecial1 (n,k) =

n < k && not (null [s | s <- [1..]

, numeroDivisores (s * n) ==

numeroDivisores (s * k)])

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores 12 == 6

-- numeroDivisores 14 == 4

numeroDivisores :: Integer -> Integer

numeroDivisores n =

genericLength [x | x <- [1..n]

, n `mod` x == 0]

-- 2ª definición de parEspecial

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

parEspecial2 :: (Integer, Integer) -> Bool

parEspecial2 (n,k) =

n < k && not (null [s | s <- [1..]

, numeroDivisores2 (s * n) ==

numeroDivisores2 (s * k)])

-- (numeroDivisores2 n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores2 12 == 6

-- numeroDivisores2 14 == 4

numeroDivisores2 :: Integer -> Integer

numeroDivisores2 =

product . map ((+1) . genericLength) . group . primeFactors

-- Comparación de eficiencia de definiciones de parEspecial

-- --------------------------------------------------------

-- La comparación es

-- λ> parEspecial1 (9,30)

-- True

-- (28.24 secs, 15,625,373,696 bytes)

-- λ> parEspecial2 (9,30)

-- True

-- (0.06 secs, 58,698,264 bytes)

-- En lo que sigue, usaremos la 2ª definición

parEspecial :: (Integer, Integer) -> Bool

parEspecial = parEspecial2

-- Propiedad

-- =========

-- La propiedad es

prop_paresNoDivisible :: Int -> Property

prop_paresNoDivisible i =

i >= 0 ==>

parEspecial (paresNoDivisible !! i)

-- La comprobación es

-- λ> quickCheck prop_paresNoDivisible

-- +++ 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>

Meses: febrero 2021

Ternas potencias de dos

Soluciones

Nuevas soluciones

Ordenación de ternas de enteros

Soluciones

Nuevas soluciones

Mayor número borrando k dígitos

Soluciones

Nuevas soluciones

Listas obtenidas borrando k elementos

Soluciones

Nuevas soluciones

Pares con múltiplos con igual número de divisores

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico