length – Página 4

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 23-marzo-201825-abril-2021

Definir la función

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

1	longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tal que (longitudMayorSublistaCreciente xs) es la el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente xs
   61

λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]

λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]

λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> longitudMayorSublistaCreciente xs

Soluciones

import Data.List  (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes []  = [[]]
sublistasCrecientes (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes xs

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 xs =
  longitudSCM xs (sort (nub xs))
  
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
  
-- 3ª solución
-- ===========

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud
-- de la sucesión más larga que termina en el elemento i-ésimo de
-- xs. Por ejemplo,  
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

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

--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 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

import Data.List (nub, sort)

import Data.Array (Array, (!), array, elems, listArray)

-- 1ª solución

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

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

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs

-- de mayor longitud. Por ejemplo,

-- λ> mayoresCrecientes [3,2,6,4,5,1]

-- [[3,4,5],[2,4,5]]

-- λ> mayoresCrecientes [3,2,3,2,3,1]

-- [[2,3],[2,3],[2,3]]

-- λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

-- [[10,22,33,50,60,80],[10,22,33,41,60,80]]

-- λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

-- [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

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

mayoresCrecientes xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes [] = [[]]

sublistasCrecientes (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes xs

-- 2ª solución

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

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

longitudMayorSublistaCreciente2 xs =

longitudSCM xs (sort (nub xs))

-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e

-- ys. Por ejemplo,

-- longitudSCM "amapola" "matamoscas" == 4

-- longitudSCM "atamos" "matamoscas" == 6

-- longitudSCM "aaa" "bbbb" == 0

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

longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)

where n = length xs

m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n

-- y m son los números de elementos de xs e ys, respectivamente) tal que

-- el valor en la posición (i,j) es la longitud de la SCM de los i

-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,

-- λ> elems (matrizLongitudSCM "amapola" "matamoscas")

-- [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,

-- 0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,

-- 0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]

-- Gráficamente,

-- m a t a m o s c a s

-- [0,0,0,0,0,0,0,0,0,0,0,

-- a 0,0,1,1,1,1,1,1,1,1,1,

-- m 0,1,1,1,1,2,2,2,2,2,2,

-- a 0,1,2,2,2,2,2,2,2,3,3,

-- p 0,1,2,2,2,2,2,2,2,3,3,

-- o 0,1,2,2,2,2,3,3,3,3,3,

-- l 0,1,2,2,2,2,3,3,3,3,3,

-- a 0,1,2,2,3,3,3,3,3,4,4]

matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]

where f 0 _ = 0

f _ 0 = 0

f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)

| otherwise = max (q ! (i-1,j)) (q ! (i,j-1))

-- 3ª solución

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

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

longitudMayorSublistaCreciente3 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n

-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud

-- de la sucesión más larga que termina en el elemento i-ésimo de

-- xs. Por ejemplo,

-- λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]

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

vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int

vectorlongitudMayorSublistaCreciente xs = v

where v = array (1,n) [(i,f i) | i <- [1..n]]

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

-- Comparación de eficiencia

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

-- λ> longitudMayorSublistaCreciente1 [1..20]

-- 20

-- (4.60 secs, 597,014,240 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..20]

-- 20

-- (0.03 secs, 361,384 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..20]

-- 20

-- (0.03 secs, 253,944 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..2000]

-- 2000

-- (8.00 secs, 1,796,495,488 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..2000]

-- 2000

-- (5.12 secs, 1,137,667,496 bytes)

-- λ> longitudMayorSublistaCreciente1 [1000,999..1]

-- 1

-- (0.95 secs, 97,029,328 bytes)

-- λ> longitudMayorSublistaCreciente2 [1000,999..1]

-- 1

-- (7.48 secs, 1,540,857,208 bytes)

-- λ> longitudMayorSublistaCreciente3 [1000,999..1]

-- 1

-- (0.86 secs, 160,859,128 bytes)

-- λ> longitudMayorSublistaCreciente1 (show (2^300))

-- 10

-- (7.90 secs, 887,495,368 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^300))

-- 10

-- (0.04 secs, 899,152 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^300))

-- 10

-- (0.04 secs, 1,907,936 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^6000))

-- 10

-- (0.06 secs, 9,950,592 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^6000))

-- 10

-- (3.46 secs, 686,929,744 bytes)

-- λ> import System.Random

-- (0.00 secs, 0 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.02 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 61

-- (7.73 secs, 1,538,771,392 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 61

-- (1.04 secs, 212,538,648 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.03 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 57

-- (7.56 secs, 1,538,573,680 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 57

-- (1.05 secs, 212,293,984 bytes)

Mayores sublistas crecientes

PorJosé A. Alonso 22-marzo-201830-marzo-2018

Definir la función

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

1	mayoresCrecientes :: Ord a => [a] -> [[a]]

tal que (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs de mayor longitud. Por ejemplo,

   λ> mayoresCrecientes [3,2,6,4,5,1]
   [[3,4,5],[2,4,5]]
   λ> mayoresCrecientes [3,2,3,2,3,1]
   [[2,3],[2,3],[2,3]]
   λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
   [[10,22,33,50,60,80],[10,22,33,41,60,80]]
   λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
   λ> length (head (mayoresCrecientes (show (2^300))))
   10

λ> mayoresCrecientes [3,2,6,4,5,1]

[[3,4,5],[2,4,5]]

λ> mayoresCrecientes [3,2,3,2,3,1]

[[2,3],[2,3],[2,3]]

λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

[[10,22,33,50,60,80],[10,22,33,41,60,80]]

λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

[[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

λ> length (head (mayoresCrecientes (show (2^300))))

Soluciones

import Data.List (subsequences)

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

mayoresCrecientes1 :: Ord a => [a] -> [[a]]
mayoresCrecientes1 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[],[3],[2],[5],[3,5],[2,5]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes xs =
  [ys | ys <- subsequences xs
      , esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por
-- ejemplo,  
--    esCreciente [2,3,5]  ==  True
--    esCreciente [2,3,1]  ==  False
--    esCreciente [2,3,3]  ==  False
esCreciente :: Ord a => [a] -> Bool
esCreciente (x:y:zs) = x < y && esCreciente (y:zs)
esCreciente _        = True

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

mayoresCrecientes2 :: Ord a => [a] -> [[a]]
mayoresCrecientes2 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes2 xs
        m   = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes2 [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes2 :: Ord a => [a] -> [[a]]
sublistasCrecientes2 []  = [[]]
sublistasCrecientes2 (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes2 xs

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

--    λ> length (head (mayoresCrecientes1 (show (2^70))))
--    5
--    (10.93 secs, 1,958,822,896 bytes)
--    λ> length (head (mayoresCrecientes2 (show (2^70))))
--    5
--    (0.02 secs, 0 bytes)

import Data.List (subsequences)

-- 1ª solución

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

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

mayoresCrecientes1 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[],[3],[2],[5],[3,5],[2,5]]

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

sublistasCrecientes xs =

[ys | ys <- subsequences xs

, esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por

-- ejemplo,

-- esCreciente [2,3,5] == True

-- esCreciente [2,3,1] == False

-- esCreciente [2,3,3] == False

esCreciente :: Ord a => [a] -> Bool

esCreciente (x:y:zs) = x < y && esCreciente (y:zs)

esCreciente _ = True

-- 2ª solución

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

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

mayoresCrecientes2 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes2 xs

m = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes2 [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes2 [] = [[]]

sublistasCrecientes2 (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes2 xs

-- Comparación de eficiencia

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

-- λ> length (head (mayoresCrecientes1 (show (2^70))))

-- 5

-- (10.93 secs, 1,958,822,896 bytes)

-- λ> length (head (mayoresCrecientes2 (show (2^70))))

-- 5

-- (0.02 secs, 0 bytes)

Conjetura de Goldbach

PorJosé A. Alonso 21-marzo-201826-marzo-2022

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

1 2	indiceGoldbach :: Int -> Int graficaGoldbach :: Int -> IO ()

tales que

(indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,

     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3

indiceGoldbach 2 == 1

indiceGoldbach 4 == 2

indiceGoldbach 27 == 3

sum (map indiceGoldbach [2..5000]) == 10619

maximum (map indiceGoldbach [2..5000]) == 3

(graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

import Data.Array
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple
import Test.QuickCheck


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

indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))

particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

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

indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

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

indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

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

--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)

-- Gráfica
-- =======

graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach
-- ========================================

-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4

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

100

101

102

103

104

105

106

107

import Data.Array

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

indiceGoldbach :: Int -> Int

indiceGoldbach n =

minimum (map length (particiones n))

particiones :: Int -> [[Int]]

particiones n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- 2ª definición

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

indiceGoldbach2 :: Int -> Int

indiceGoldbach2 x =

head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n

-- primos. Por ejemplo,

-- esSumaDe 2 1 == True

-- esSumaDe 4 1 == False

-- esSumaDe 4 2 == True

-- esSumaDe 27 2 == False

-- esSumaDe 27 3 == True

esSumaDe :: Int -> Int -> Bool

esSumaDe x 1 = isPrime x

esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

-- 3ª definición

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

indiceGoldbach3 :: Int -> Int

indiceGoldbach3 x =

head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool

esSumaDe3 x n = a ! (x,n) where

a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]

f i 1 = isPrime i

f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

-- 4ª definición

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

indiceGoldbach4 :: Int -> Int

indiceGoldbach4 n = v ! n where

v = array (2,n) [(i,f i) | i <- [2..n]]

f i | isPrime i = 1

| otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

-- Comparación de eficiencia

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

-- λ> sum (map indiceGoldbach [2..80])

-- 142

-- (2.66 secs, 1,194,330,496 bytes)

-- λ> sum (map indiceGoldbach2 [2..80])

-- 142

-- (0.01 secs, 1,689,944 bytes)

-- λ> sum (map indiceGoldbach3 [2..80])

-- 142

-- (0.03 secs, 27,319,296 bytes)

-- λ> sum (map indiceGoldbach4 [2..80])

-- 142

-- (0.03 secs, 47,823,656 bytes)

-- λ> sum (map indiceGoldbach2 [2..1000])

-- 2030

-- (0.10 secs, 200,140,264 bytes)

-- λ> sum (map indiceGoldbach3 [2..1000])

-- 2030

-- (3.10 secs, 4,687,467,664 bytes)

-- Gráfica

-- =======

graficaGoldbach :: Int -> IO ()

graficaGoldbach n =

plotList [ Key Nothing

, XRange (2,fromIntegral n)

, PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")

]

[indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach

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

-- La propiedad es

prop_Goldbach :: Int -> Property

prop_Goldbach x =

x >= 2 ==> indiceGoldbach2 x < 4

-- La comprobación es

-- λ> quickCheck prop_Goldbach

-- +++ OK, passed 100 tests.

La conjetura de Levy

PorJosé A. Alonso 12-marzo-201825-abril-2021

Hyman Levy observó que

    7 = 3 + 2 x 2
    9 = 3 + 2 x 3 =  5 + 2 x 2
   11 = 5 + 2 x 3 =  7 + 2 x 2
   13 = 3 + 2 x 5 =  7 + 2 x 3
   15 = 3 + 2 x 5 = 11 + 2 x 2
   17 = 3 + 2 x 7 =  7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2
   19 = 5 + 2 x 7 = 13 + 2 x 3

7 = 3 + 2 x 2

9 = 3 + 2 x 3 = 5 + 2 x 2

11 = 5 + 2 x 3 = 7 + 2 x 2

13 = 3 + 2 x 5 = 7 + 2 x 3

15 = 3 + 2 x 5 = 11 + 2 x 2

17 = 3 + 2 x 7 = 7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2

19 = 5 + 2 x 7 = 13 + 2 x 3

y conjeturó que todos los número impares mayores o iguales que 7 se pueden escribir como la suma de un primo y el doble de un primo. El objetivo de los siguientes ejercicios es comprobar la conjetura de Levy.

Definir las siguientes funciones

   descomposicionesLevy :: Integer -> [(Integer,Integer)]
   graficaLevy          :: Integer -> IO ()

1 2	descomposicionesLevy :: Integer -> [(Integer,Integer)] graficaLevy :: Integer -> IO ()

tales que

(descomposicionesLevy x) es la lista de pares de primos (p,q) tales que x = p + 2q. Por ejemplo,

     descomposicionesLevy  7  ==  [(3,2)]
     descomposicionesLevy  9  ==  [(3,3),(5,2)]
     descomposicionesLevy 17  ==  [(3,7),(7,5),(11,3),(13,2)]

descomposicionesLevy 7 == [(3,2)]

descomposicionesLevy 9 == [(3,3),(5,2)]

descomposicionesLevy 17 == [(3,7),(7,5),(11,3),(13,2)]

(graficaLevy n) dibuja los puntos (x,y) tales que x pertenece a [7,9..7+2x(n-1)] e y es el número de descomposiciones de Levy de x. Por ejemplo, (graficaLevy 200) dibuja

Comprobar con QuickCheck la conjetura de Levy.

Soluciones

[schedule on=’2018-03-19′ at=»06:00″]

import Data.Numbers.Primes
import Test.QuickCheck
import Graphics.Gnuplot.Simple

descomposicionesLevy :: Integer -> [(Integer,Integer)]
descomposicionesLevy x =
  [(p,q) | p <- takeWhile (< x) (tail primes)
         , let q = (x - p) `div` 2
         , isPrime q]

-- graficaLevy 300
graficaLevy :: Integer -> IO ()
graficaLevy n =
  plotList [ Key Nothing
           , XRange (7,fromIntegral (7+2*(n-1)))
           , PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")
           ]
           [(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]] 

-- La propiedad es
prop_Levy :: Integer -> Bool
prop_Levy x =
  not (null (descomposicionesLevy (7 + 2 * abs x)))

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

import Data.Numbers.Primes

import Test.QuickCheck

import Graphics.Gnuplot.Simple

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

descomposicionesLevy x =

[(p,q) | p <- takeWhile (< x) (tail primes)

, let q = (x - p) `div` 2

, isPrime q]

-- graficaLevy 300

graficaLevy :: Integer -> IO ()

graficaLevy n =

plotList [ Key Nothing

, XRange (7,fromIntegral (7+2*(n-1)))

, PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")

]

[(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]]

-- La propiedad es

prop_Levy :: Integer -> Bool

prop_Levy x =

not (null (descomposicionesLevy (7 + 2 * abs x)))

-- La comprobación es

-- λ> quickCheck prop_Levy

-- +++ OK, passed 100 tests.

Cruce de listas

PorJosé A. Alonso 5-marzo-201812-marzo-2018

Definir la función

   cruce :: Eq a => [a] -> [a] -> [[a]]

1	cruce :: Eq a => [a] -> [a] -> [[a]]

tal que (cruce xs ys) es la lista de las listas obtenidas uniendo las listas de xs sin un elemento con las de ys sin un elemento. Por ejemplo,

   ghci> cruce [1,5,3] [2,4]
   [[5,3,4],[5,3,2],[1,3,4],[1,3,2],[1,5,4],[1,5,2]]
   ghci> cruce [1,5,3] [2,4,6]
   [[5,3,4,6],[5,3,2,6],[5,3,2,4],[1,3,4,6],[1,3,2,6],
    [1,3,2,4],[1,5,4,6],[1,5,2,6],[1,5,2,4]]

ghci> cruce [1,5,3] [2,4]

[[5,3,4],[5,3,2],[1,3,4],[1,3,2],[1,5,4],[1,5,2]]

ghci> cruce [1,5,3] [2,4,6]

[[5,3,4,6],[5,3,2,6],[5,3,2,4],[1,3,4,6],[1,3,2,6],

[1,3,2,4],[1,5,4,6],[1,5,2,6],[1,5,2,4]]

Comprobar con QuickCheck que el número de elementos de (cruce xs ys) es el producto de los números de elementos de xs y de ys.

Soluciones

import Data.List (delete)
import Test.QuickCheck

cruce :: Eq a => [a] -> [a] -> [[a]]
cruce xs ys = [(delete x xs) ++ (delete y ys) | x <- xs, y <- ys]

-- La propiedad es
prop_cruce :: Eq a => [a] -> [a] -> Bool
prop_cruce xs ys =
  length (cruce xs ys) == length xs * length ys

-- La comprobación es
--    ghci> quickCheck prop_cruce
--    +++ OK, passed 100 tests.

import Data.List (delete)

import Test.QuickCheck

cruce :: Eq a => [a] -> [a] -> [[a]]

cruce xs ys = [(delete x xs) ++ (delete y ys) | x <- xs, y <- ys]

-- La propiedad es

prop_cruce :: Eq a => [a] -> [a] -> Bool

prop_cruce xs ys =

length (cruce xs ys) == length xs * length ys

-- La comprobación es

-- ghci> quickCheck prop_cruce

-- +++ OK, passed 100 tests.

Matrices dispersas

PorJosé A. Alonso 19-febrero-201826-febrero-2018

Una matriz es dispersa si la mayoriá de sus elementos son ceros. Por ejemplo, la primera de las siguientes matrices es dispersa y la segunda no lo es

   ( 0 0 4 )   ( 0 1 4 )
   ( 0 5 0 )   ( 0 5 1 )
   ( 0 0 0 )

( 0 0 4 ) ( 0 1 4 )

( 0 5 0 ) ( 0 5 1 )

( 0 0 0 )

Usando la librería Data.Matrix, las anteriores matrices se pueden definir por

   ej1, ej2 :: Matrix Int
   ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
   ej2 = fromList 2 3 [0,1,4,0,5,1]

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

La dispersión de una matriz es el cociente entre el número de ceros de la matriz y el producto de sus números de filas y de columnas.

Definir las siguientes funciones

   dispersion :: (Num a, Eq a) => Matrix a -> Double
   esDispersa :: (Num a, Eq a) => Matrix a -> Bool

1 2	dispersion :: (Num a, Eq a) => Matrix a -> Double esDispersa :: (Num a, Eq a) => Matrix a -> Bool

tales que

(dispersion p) es la dispersión de la matriz p. Por ejemplo,

     dispersion ej1              ==  0.7777777777777778
     dispersion ej2              ==  0.3333333333333333
     dispersion (fmap (+1) ej1)  ==  0.0
     dispersion (identity 3)     ==  0.6666666666666666
     dispersion (zero 9 9)       ==  1.0

dispersion ej1 == 0.7777777777777778

dispersion ej2 == 0.3333333333333333

dispersion (fmap (+1) ej1) == 0.0

dispersion (identity 3) == 0.6666666666666666

dispersion (zero 9 9) == 1.0

(esDispersa p) se verifica si la matriz p es dispersa. Por ejemplo,

     esDispersa ej1              ==  True
     esDispersa ej2              ==  False
     esDispersa (fmap (+1) ej1)  ==  False
     esDispersa (identity 3)     ==  True
     esDispersa (zero 9 9)       ==  True

esDispersa ej1 == True

esDispersa ej2 == False

esDispersa (fmap (+1) ej1) == False

esDispersa (identity 3) == True

esDispersa (zero 9 9) == True

Soluciones

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int
ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double
dispersion p =
  fi nCeros / (fi nrows * fi ncols)
  where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,
--    nCeros ej1  ==  7
--    nCeros ej2  ==  2
nCeros :: (Num a, Eq a) => Matrix a -> Int
nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:
nCeros2 :: (Num a, Eq a) => Matrix a -> Int
nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool
esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:
esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool
esDispersa2 = (> 0.5) . dispersion

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double

dispersion p =

fi nCeros / (fi nrows * fi ncols)

where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,

-- nCeros ej1 == 7

-- nCeros ej2 == 2

nCeros :: (Num a, Eq a) => Matrix a -> Int

nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:

nCeros2 :: (Num a, Eq a) => Matrix a -> Int

nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool

esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:

esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool

esDispersa2 = (> 0.5) . dispersion

Árboles binarios completos

PorJosé A. Alonso 14-febrero-201821-febrero-2018

Un árbol binario completo es un árbol en el que cada nodo tiene cero o dos hijos. Por ejemplo, el primero de los siguientes árboles es un árbol binario completo pero los otros no lo son

           1              1            1    
         /   \          /   \        / | \ 
        2     3        2     3      2  7  3
       / \            /            / \      
      4   5          4            4   5

1 1 1

/ \ / \ / | \

2 3 2 3 2 7 3

/ \ / / \

4 5 4 4 5

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles los árboles anteriores se puede representar por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N 2 [N 4 []], N 3 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   esBinarioCompleto :: Arbol t -> Bool

1	esBinarioCompleto :: Arbol t -> Bool

tal que (esBinarioCompleto a) se verifica si a es un árbol binario completo. Por ejemplo,

   esBinarioCompleto ej1  ==  True
   esBinarioCompleto ej2  ==  False
   esBinarioCompleto ej3  ==  False

esBinarioCompleto ej1 == True

esBinarioCompleto ej2 == False

esBinarioCompleto ej3 == False

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N 2 [N 4 []], N 3 []]
ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]
          
esBinarioCompleto :: Arbol t -> Bool
esBinarioCompleto (N _ []) = True
esBinarioCompleto (N x as) = length as `elem` [0,2] 
                             && all esBinarioCompleto as

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

esBinarioCompleto :: Arbol t -> Bool

esBinarioCompleto (N _ []) = True

esBinarioCompleto (N x as) = length as `elem` [0,2]

&& all esBinarioCompleto as

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

Los primeros términos de la sucesión de Fibonacci son

   0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

1	0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

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

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

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

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Huecos binarios

PorJosé A. Alonso 7-febrero-201814-febrero-2018

Los huecos binarios de un número natural n son las listas de cer0 entre dos unos en la representación binaria de n. Por ejemplo, puesto que la representación binaria de 20 es 10100 tiene dos huecos binarios de longitudes 1 y 2. La longitud del mayor hueco binario de 529 es 4 ya que la representación binaria de 529 es 1000010001.

Definir las funciones

   longMayorHuecoBinario        :: Int -> Int
   graficaLongMayorHuecoBinario :: Int -> IO ()

1 2	longMayorHuecoBinario :: Int -> Int graficaLongMayorHuecoBinario :: Int -> IO ()

tales que

(longMayorHuecoBinario n) es la longitud del mayor hueco binario de n. Por ejemplo,

     longMayorHuecoBinario 20    ==  2
     longMayorHuecoBinario 529   ==  4
     longMayorHuecoBinario 2018  ==  3

longMayorHuecoBinario 20 == 2

longMayorHuecoBinario 529 == 4

longMayorHuecoBinario 2018 == 3

(graficaLongMayorHuecoBinario n) dibuja la gráfica de las longitudes de los mayores huecos binarios de los n primeros números naturales. Por ejemplo, (graficaLongMayorHuecoBinario 200) dibuja

Soluciones

import Data.List (group)
import Graphics.Gnuplot.Simple

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

longMayorHuecoBinario :: Int -> Int
longMayorHuecoBinario n =
  maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por
-- ejemplo, 
--    decimalAbinario 20   ==  [0,0,1,0,1]
--    decimalAbinario 529  ==  [1,0,0,0,1,0,0,0,0,1] 
decimalAbinario :: Int -> [Int]
decimalAbinario x
  | x < 2     = [x]
  | otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre
-- dos elementos distintos de cero. Por ejemplo,
--    huecosBinarios [0,0,1,0,1]            ==  [[0,0],[0]]
--    huecosBinarios [1,0,0,0,1,0,0,0,0,1]  ==  [[0,0,0],[0,0,0,0]]
huecosBinarios :: [Int] -> [[Int]]
huecosBinarios xs =
  [ys | ys <- group xs, 0 `elem` ys]

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

longMayorHuecoBinario2 :: Int -> Int
longMayorHuecoBinario2 =
  maximum . (0 :) . map length . huecosBinarios . decimalAbinario

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

longMayorHuecoBinario3 :: Int -> Int
longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos
-- binarios de n. Por ejemplo,
--    longHuecosBinarios 20  ==  [2,1,0]
--    longHuecosBinarios 529  ==  [3,4,0]
longHuecosBinarios :: Int -> [Int]
longHuecosBinarios 1 = [0]
longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)
                     | mod n 4 == 2 = 1 : h : t
                     | otherwise = 1 + h : t
  where (h : t) = longHuecosBinarios (div n 2)

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

--    λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]
--    16
--    (5.51 secs, 941,090,272 bytes)
--    λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]
--    16
--    (5.54 secs, 933,093,168 bytes)
--    λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]
--    16
--    (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()
graficaLongMayorHuecoBinario n =
  plotList [ Key Nothing
           , Title ("graficaLongMayorHuecoBinario " ++ show n)
           , PNG ("Huecos_binarios_" ++ show n ++ ".png")
           ]
           [longMayorHuecoBinario k | k <- [0..n-1]]

import Data.List (group)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

longMayorHuecoBinario :: Int -> Int

longMayorHuecoBinario n =

maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por

-- ejemplo,

-- decimalAbinario 20 == [0,0,1,0,1]

-- decimalAbinario 529 == [1,0,0,0,1,0,0,0,0,1]

decimalAbinario :: Int -> [Int]

decimalAbinario x

| x < 2 = [x]

| otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre

-- dos elementos distintos de cero. Por ejemplo,

-- huecosBinarios [0,0,1,0,1] == [[0,0],[0]]

-- huecosBinarios [1,0,0,0,1,0,0,0,0,1] == [[0,0,0],[0,0,0,0]]

huecosBinarios :: [Int] -> [[Int]]

huecosBinarios xs =

[ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución

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

longMayorHuecoBinario2 :: Int -> Int

longMayorHuecoBinario2 =

maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución

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

longMayorHuecoBinario3 :: Int -> Int

longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos

-- binarios de n. Por ejemplo,

-- longHuecosBinarios 20 == [2,1,0]

-- longHuecosBinarios 529 == [3,4,0]

longHuecosBinarios :: Int -> [Int]

longHuecosBinarios 1 = [0]

longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)

| mod n 4 == 2 = 1 : h : t

| otherwise = 1 + h : t

where (h : t) = longHuecosBinarios (div n 2)

-- Comparación de eficiencia

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

-- λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]

-- 16

-- (5.51 secs, 941,090,272 bytes)

-- λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]

-- 16

-- (5.54 secs, 933,093,168 bytes)

-- λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]

-- 16

-- (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()

graficaLongMayorHuecoBinario n =

plotList [ Key Nothing

, Title ("graficaLongMayorHuecoBinario " ++ show n)

, PNG ("Huecos_binarios_" ++ show n ++ ".png")

]

[longMayorHuecoBinario k | k <- [0..n-1]]

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

   1, 2, 3, 4
   5, 6, 7, 8
   9,10,11,12
  13,14,15,16

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

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

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Exponentes de Hamming

PorJosé A. Alonso 1-febrero-20188-febrero-2018

Los números de Hamming forman una sucesión estrictamente creciente de números que cumplen las siguientes condiciones:

El número 1 está en la sucesión.
Si x está en la sucesión, entonces 2x, 3x y 5x también están.
Ningún otro número está en la sucesión.

Los primeros números de Hamming son 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, …

Los exponentes de un número de Hamming n es una terna (x,y,z) tal que n = 2^x*3^y*5^z. Por ejemplo, los exponentes de 600 son (3,1,2) ya que 600 = 2^x*3^1*5^z.

Definir la sucesión

   sucExponentesHamming :: [(Int,Int,Int)]

1	sucExponentesHamming :: [(Int,Int,Int)]

cuyos elementos son los exponentes de los números de Hamming. Por ejemplo,

   λ> take 21 sucExponentesHamming
   [(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),
    (0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),
    (3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]
   λ> sucExponentesHamming !! (5*10^5)
   (74,82,7)

λ> take 21 sucExponentesHamming

[(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),

(0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),

(3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]

λ> sucExponentesHamming !! (5*10^5)

(74,82,7)

Soluciones

import Data.Numbers.Primes (primeFactors)

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

sucExponentesHamming :: [(Int,Int,Int)]
sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por
-- ejemplo, 
--    exponentes 600  ==  (3,1,2)
exponentes :: Integer -> (Int,Int,Int)
exponentes x = (length as, length cs, length ds)
  where xs = primeFactors x
        (as,bs) = span (==2) xs
        (cs,ds) = span (==3) bs

-- hamming es la sucesión de los números de Hamming. Por ejemplo,
--    λ> take 21 hamming
--    [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]
hamming :: [Integer]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]  ==  [2,3,4,5,6,8,9,10,12]
mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs e ys y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla2 [2,4,6,8,10,12] [3,6,9,12]  ==  [2,3,4,6,8,9,10,12]
mezcla2 :: Ord a => [a] -> [a] -> [a] 
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs

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

sucExponentesHamming2 :: [(Int,Int,Int)]
sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)
exponentes2 = aux (0,0,0)
  where aux (a,b,c) 1 = (a,b,c)
        aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)
                      | mod x 3 == 0 = aux (a,b+1,c) (div x 3)
                      | otherwise    = aux (a,b,c+1) (div x 5)

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

sucExponentesHamming3 :: [(Int,Int,Int)]
sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)
exponentes3 1 = (0,0,0)
exponentes3 x
  | x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))
  | x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))
  | otherwise      = suma (0,0,1) (descomposicion (x `div` 5))
  where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

-- 4ª solución
-- ===========

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]
sucExponentesHamming4 =
  (0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]
 
mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]
mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]
mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)
  | x < y     = (i,j,k) : mezclaT2 xs ts2
  | x > y     = (a,b,c) : mezclaT2 ts1 ys
  | otherwise = (i,j,k) : mezclaT2 xs ys
  where x = 2^i*3^j*5^k
        y = 2^a*3^b*5^c

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

sucExponentesHamming :: [(Int,Int,Int)]

sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por

-- ejemplo,

-- exponentes 600 == (3,1,2)

exponentes :: Integer -> (Int,Int,Int)

exponentes x = (length as, length cs, length ds)

where xs = primeFactors x

(as,bs) = span (==2) xs

(cs,ds) = span (==3) bs

-- hamming es la sucesión de los números de Hamming. Por ejemplo,

-- λ> take 21 hamming

-- [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]

hamming :: [Integer]

hamming = 1 : mezcla3 [2*i | i <- hamming]

[3*i | i <- hamming]

[5*i | i <- hamming]

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo,

-- mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10] == [2,3,4,5,6,8,9,10,12]

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

mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs e ys y eliminando los elementos duplicados. Por ejemplo,

-- mezcla2 [2,4,6,8,10,12] [3,6,9,12] == [2,3,4,6,8,9,10,12]

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

mezcla2 p@(x:xs) q@(y:ys) | x < y = x:mezcla2 xs q

| x > y = y:mezcla2 p ys

| otherwise = x:mezcla2 xs ys

mezcla2 [] ys = ys

mezcla2 xs [] = xs

-- 2ª solución

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

sucExponentesHamming2 :: [(Int,Int,Int)]

sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)

exponentes2 = aux (0,0,0)

where aux (a,b,c) 1 = (a,b,c)

aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)

| mod x 3 == 0 = aux (a,b+1,c) (div x 3)

| otherwise = aux (a,b,c+1) (div x 5)

-- 3ª solución

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

sucExponentesHamming3 :: [(Int,Int,Int)]

sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)

exponentes3 1 = (0,0,0)

exponentes3 x

| x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))

| x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))

| otherwise = suma (0,0,1) (descomposicion (x `div` 5))

where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

-- 4ª solución

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

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]

sucExponentesHamming4 =

(0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]

mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]

mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]

mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)

| x < y = (i,j,k) : mezclaT2 xs ts2

| x > y = (a,b,c) : mezclaT2 ts1 ys

| otherwise = (i,j,k) : mezclaT2 xs ys

where x = 2^i*3^j*5^k

y = 2^a*3^b*5^c

Relaciones arbóreas

PorJosé A. Alonso 30-enero-20186-febrero-2018

Como se explica en el ejercicio Relación definida por un árbol, cada árbol binario define una relación binaria donde un elemento x está relacionado con y si x es el padre de y.

Una relación binaria es arbórea si

hay exactamente un elemento que no tiene ningún (la raíz del árbol) y
todos los elementos tienen dos hijos (los nodos internos) o ninguno (las hojas del árbol).

Definir la función

   arborea :: Eq a => [(a,a)] -> Bool

1	arborea :: Eq a => [(a,a)] -> Bool

tal que (arborea r) se verifica si la relación r es arbórea. Por ejemplo,

   arborea [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]  ==  True
   arborea [(8,3),(8,5),(10,2),(2,2),(2,0)]         ==  False
   arborea [(10,8),(8,3),(8,5),(10,2),(8,2),(2,0)]  ==  False

arborea [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] == True

arborea [(8,3),(8,5),(10,2),(2,2),(2,0)] == False

arborea [(10,8),(8,3),(8,5),(10,2),(8,2),(2,0)] == False

Soluciones

import Data.List ((\\), elemIndices, isPrefixOf, nub, sort)

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

arborea :: Eq a => [(a,a)] -> Bool
arborea r =
  length [x | x <- nodos r, null (padres r x)] == 1 &&
  all (`elem` [0,2]) [length (hijos r x) | x <- nodos r]

-- (nodos r) es el conjunto de los nodos de la relación r. Por ejemplo,   
--    λ> nodos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]
--    [10,8,3,5,2,0]
nodos :: Eq a => [(a,a)] -> [a]
nodos r = nub (concat [[x,y] | (x,y) <- r])

-- (padres r x) es la lista de los padres de x en la relación r. Por
-- ejemplo, 
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 8   ==  [10]
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  []
padres :: Eq a => [(a,a)] -> a -> [a]
padres r x = [y | (y,x') <- r, x' == x]

-- (hijos r x) es la lista de los hijos de x en la relación r. Por
-- ejemplo, 
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  [8,2]
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 5   ==  []
hijos :: Eq a => [(a,a)] -> a -> [a]
hijos r x = [y | (x',y) <- r, x' == x]

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

arborea2 :: Eq a => [(a,a)] -> Bool
arborea2 xs =  length (nub padres \\ nub hijos) == 1
            && and [cuenta x padres == 2 | x <- nub padres]
  where
    (padres, hijos) = unzip xs

-- (cuenta x ys) es el número de ocurrencias de x en ys. Por ejemplo,
--    cuenta 7 [7,2,7,7,5]  ==  3
cuenta :: Eq a => a -> [a] -> Int
cuenta i = length . elemIndices i

import Data.List ((\\), elemIndices, isPrefixOf, nub, sort)

-- 1ª solución

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

arborea :: Eq a => [(a,a)] -> Bool

arborea r =

length [x | x <- nodos r, null (padres r x)] == 1 &&

all (`elem` [0,2]) [length (hijos r x) | x <- nodos r]

-- (nodos r) es el conjunto de los nodos de la relación r. Por ejemplo,

-- λ> nodos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]

-- [10,8,3,5,2,0]

nodos :: Eq a => [(a,a)] -> [a]

nodos r = nub (concat [[x,y] | (x,y) <- r])

-- (padres r x) es la lista de los padres de x en la relación r. Por

-- ejemplo,

-- padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 8 == [10]

-- padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10 == []

padres :: Eq a => [(a,a)] -> a -> [a]

padres r x = [y | (y,x') <- r, x' == x]

-- (hijos r x) es la lista de los hijos de x en la relación r. Por

-- ejemplo,

-- hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10 == [8,2]

-- hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 5 == []

hijos :: Eq a => [(a,a)] -> a -> [a]

hijos r x = [y | (x',y) <- r, x' == x]

-- 2ª solución

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

arborea2 :: Eq a => [(a,a)] -> Bool

arborea2 xs = length (nub padres \\ nub hijos) == 1

&& and [cuenta x padres == 2 | x <- nub padres]

where

(padres, hijos) = unzip xs

-- (cuenta x ys) es el número de ocurrencias de x en ys. Por ejemplo,

-- cuenta 7 [7,2,7,7,5] == 3

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

cuenta i = length . elemIndices i

Sucesión de Lichtenberg

PorJosé A. Alonso 25-enero-20181-febrero-2018

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Alternada ..... Lichtenberg

0 ....................... 0

1 ....................... 1

10 ...................... 2

101 ..................... 5

1010 ................... 10

10101 .................. 21

101010 ................. 42

1010101 ................ 85

10101010 .............. 170

101010101 ............. 341

1010101010 ............ 682

10101010101 .......... 1365

101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

1 2	lichtenberg :: [Integer] graficaLichtenberg :: Int -> IO ()

tales que

lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,

     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

1 2	λ> take 17 lichtenberg [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

(graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)

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

lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
  
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 

-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))

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

graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

lichtenberg1 :: [Integer]

lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la

-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

-- λ> take 7 sucAlternada

-- ["0","1","10","101","1010","10101","101010"]

sucAlternada :: [String]

sucAlternada =

['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y

-- 0. Por ejemplo,

-- take 20 cadenaAlternada == "10101010101010101010"

cadenaAlternada :: String

cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número

-- binario cuya cadena de dígitos es cs. Por ejemplo,

-- binarioAdecimal "11101" == 29

binarioAdecimal :: String -> Integer

binarioAdecimal =

foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0

-- 2ª solución

lichtenberg2 :: [Integer]

lichtenberg2 = map a [0..]

where a 0 = 0

a 1 = 1

a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución

lichtenberg3 :: [Integer]

lichtenberg3 =

0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3))

-- Comprobación de eficiencia

-- λ> length (show (lichtenberg1 !! 27))

-- 8

-- (0.02 secs, 155,384 bytes)

-- λ> length (show (lichtenberg2 !! 27))

-- 8

-- (2.22 secs, 311,157,760 bytes)

-- λ> length (show (lichtenberg1 !! (8*10^4)))

-- 24083

-- (1.28 secs, 664,207,040 bytes)

-- λ> length (show (lichtenberg3 !! (8*10^4)))

-- 24083

-- (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es

propLichtenberg :: Int -> Property

propLichtenberg n =

n > 4 ==> not (isPrime (lichtenberg1 !! n))

-- La comprobación es

-- λ> quickCheck propLichtenberg

-- +++ OK, passed 100 tests.

graficaLichtenberg :: Int -> IO ()

graficaLichtenberg n =

plotList [ Key Nothing

, Title "Numero de digitos de la sucesion de Lichtenberg"

, PNG "Sucesion_de_Lichtenberg.png"

]

(take n (map (length . show) lichtenberg1))

Números somirp

PorJosé A. Alonso 10-enero-201819-febrero-2018

Un número omirp es un número primo que forma un primo distinto al invertir el orden de sus dígitos.

Definir las funciones

  esOmirp            :: Integer -> Bool
  omirps             :: [Integer]
  nOmirpsIntermedios :: Int -> Int

esOmirp :: Integer -> Bool

omirps :: [Integer]

nOmirpsIntermedios :: Int -> Int

tales que

(esOmirp n) se verifica si n es un número omirp. Por ejemplo,

     esOmirp 13      ==  True
     esOmirp 11      ==  False
     esOmirp 112207  ==  True

esOmirp 13 == True

esOmirp 11 == False

esOmirp 112207 == True

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

     take 15 omirps  ==  [13,17,31,37,71,73,79,97,107,113]
     omirps !! 2000  ==  112207

1 2	take 15 omirps == [13,17,31,37,71,73,79,97,107,113] omirps !! 2000 == 112207

(nOmirpsIntermedios n) es la cantidad de números omirps entre el n-ésimo número omirp y el obtenido al invertir el orden de sus dígitos. Por ejemplo,

     nOmirpsIntermedios 2000  ==  4750

1	nOmirpsIntermedios 2000 == 4750

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool
esOmirp n = n /= rn && isPrime rn
  where rn = read . reverse . show $ n

omirps :: [Integer]
omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int
nOmirpsIntermedios n =
  length
  . filter esOmirp
  . takeWhile (< rx)
  . dropWhile (<= x) $ primes
  where x  = omirps !! n
        rx = read . reverse . show $ x

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool

esOmirp n = n /= rn && isPrime rn

where rn = read . reverse . show $ n

omirps :: [Integer]

omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int

nOmirpsIntermedios n =

length

. filter esOmirp

. takeWhile (< rx)

. dropWhile (<= x) $ primes

where x = omirps !! n

rx = read . reverse . show $ x

El problema 3SUM

PorJosé A. Alonso 2-enero-201819-febrero-2018

El problem 3SUM consiste en dado una lista xs, decidir si xs posee tres elementos cuya suma sea cero. Por ejemplo, en [7,5,-9,5,2] se pueden elegir los elementos 7, -9 y 2 que suman 0.

Definir las funciones

   sols3Sum :: [Int] -> [[Int]]
   pb3Sum :: [Int] -> Bool

1 2	sols3Sum :: [Int] -> [[Int]] pb3Sum :: [Int] -> Bool

tales que
+ (sols3Sum xs) son las listas de tres elementos de xs cuya suma sea cero. Por ejemplo,

      sols3Sum [8,10,-10,-7,2,-3]   ==  [[-10,2,8],[-7,-3,10]]
      sols3Sum [-2..3]              ==  [[-2,-1,3],[-2,0,2],[-1,0,1]]
      sols3Sum [1,-2]               ==  []
      sols3Sum [-2,1]               ==  []
      sols3Sum [1,-2,1]             ==  [[-2,1,1]]
      length (sols3Sum [-100..100]) ==  5000

sols3Sum [8,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

sols3Sum [-2..3] == [[-2,-1,3],[-2,0,2],[-1,0,1]]

sols3Sum [1,-2] == []

sols3Sum [-2,1] == []

sols3Sum [1,-2,1] == [[-2,1,1]]

length (sols3Sum [-100..100]) == 5000

(pb3Sum xs) se verifica si xs posee tres elementos cuya suma sea cero. Por ejemplo,

     pb3Sum [8,10,-10,-7,2,-3]  ==  True
     pb3Sum [1,-2]              ==  False
     pb3Sum [-2,1]              ==  False
     pb3Sum [1,-2,1]            ==  True
     pb3Sum [1..400]            ==  False

pb3Sum [8,10,-10,-7,2,-3] == True

pb3Sum [1,-2] == False

pb3Sum [-2,1] == False

pb3Sum [1,-2,1] == True

pb3Sum [1..400] == False

Soluciones

import Data.List

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

sols3Sum1 :: [Int] -> [[Int]]
sols3Sum1 = normaliza . sols3Sum1Aux 

sols3Sum1Aux :: [Int] -> [[Int]]
sols3Sum1Aux xs =
  [ys | ys <- subsequences xs
      , length ys == 3
      , sum ys == 0]

normaliza :: [[Int]] -> [[Int]]
normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool
pb3Sum1 = not . null . sols3Sum1Aux


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

sols3Sum2 :: [Int] -> [[Int]]
sols3Sum2 = normaliza . sols3Sum2Aux 

sols3Sum2Aux :: [Int] -> [[Int]]
sols3Sum2Aux xs =
  [[a,b,c] | (a:bs) <- tails xs
           , (b:cs) <- tails bs
           , c <- cs
           , a + b + c == 0]
  
pb3Sum2 :: [Int] -> Bool
pb3Sum2 = not . null . sols3Sum2Aux

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

sols3Sum3 :: [Int] -> [[Int]]
sols3Sum3 = normaliza . sols3Sum3Aux 

sols3Sum3Aux :: [Int] -> [[Int]]
sols3Sum3Aux xs =
  [[a,b,-a-b] | (a:bs) <- tails xs
              , b <- bs
              , (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool
pb3Sum3 = not . null . sols3Sum3Aux

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

--    λ> pb3Suma [1..23]
--    False
--    (2.61 secs, 1,812,734,176 bytes)
--    λ> pb3Sumb [1..23]
--    False
--    (0.01 secs, 554,496 bytes)
--    λ> pb3Sumc [1..23]
--    False
--    (0.01 secs, 584,344 bytes)
--    λ> pb3Suma ([1..23] ++ [-3]) 
--    True
--    (2.54 secs, 1,812,735,784 bytes)
--    λ> pb3Sumb ([1..23] ++ [-3]) 
--    True
--    (0.01 secs, 148,904 bytes)
--    λ> pb3Sumc ([1..23] ++ [-3]) 
--    True
--    (0.00 secs, 145,320 bytes)
--
--    λ> pb3Sumb [1..300]
--    False
--    (1.66 secs, 933,699,824 bytes)
--    λ> pb3Sumc [1..300]
--    False
--    (0.41 secs, 873,168,120 bytes)

import Data.List

-- 1ª solución

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

sols3Sum1 :: [Int] -> [[Int]]

sols3Sum1 = normaliza . sols3Sum1Aux

sols3Sum1Aux :: [Int] -> [[Int]]

sols3Sum1Aux xs =

[ys | ys <- subsequences xs

, length ys == 3

, sum ys == 0]

normaliza :: [[Int]] -> [[Int]]

normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool

pb3Sum1 = not . null . sols3Sum1Aux

-- 2ª solución

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

sols3Sum2 :: [Int] -> [[Int]]

sols3Sum2 = normaliza . sols3Sum2Aux

sols3Sum2Aux :: [Int] -> [[Int]]

sols3Sum2Aux xs =

[[a,b,c] | (a:bs) <- tails xs

, (b:cs) <- tails bs

, c <- cs

, a + b + c == 0]

pb3Sum2 :: [Int] -> Bool

pb3Sum2 = not . null . sols3Sum2Aux

-- 3ª solución

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

sols3Sum3 :: [Int] -> [[Int]]

sols3Sum3 = normaliza . sols3Sum3Aux

sols3Sum3Aux :: [Int] -> [[Int]]

sols3Sum3Aux xs =

[[a,b,-a-b] | (a:bs) <- tails xs

, b <- bs

, (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool

pb3Sum3 = not . null . sols3Sum3Aux

-- Comparación de eficiencia

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

-- λ> pb3Suma [1..23]

-- False

-- (2.61 secs, 1,812,734,176 bytes)

-- λ> pb3Sumb [1..23]

-- False

-- (0.01 secs, 554,496 bytes)

-- λ> pb3Sumc [1..23]

-- False

-- (0.01 secs, 584,344 bytes)

-- λ> pb3Suma ([1..23] ++ [-3])

-- True

-- (2.54 secs, 1,812,735,784 bytes)

-- λ> pb3Sumb ([1..23] ++ [-3])

-- True

-- (0.01 secs, 148,904 bytes)

-- λ> pb3Sumc ([1..23] ++ [-3])

-- True

-- (0.00 secs, 145,320 bytes)

-- λ> pb3Sumb [1..300]

-- False

-- (1.66 secs, 933,699,824 bytes)

-- λ> pb3Sumc [1..300]

-- False

-- (0.41 secs, 873,168,120 bytes)

Sucesión de raíces enteras de los números primos

PorJosé A. Alonso 26-diciembre-201719-febrero-2018

Definir las siguientes funciones

   raicesEnterasPrimos :: [Integer]
   posiciones :: Integer -> (Int,Int)
   frecuencia :: Integer -> Int
   grafica_raicesEnterasPrimos :: Int -> IO ()
   grafica_posicionesIniciales :: Integer -> IO ()
   grafica_frecuencias :: Integer -> IO ()

raicesEnterasPrimos :: [Integer]

posiciones :: Integer -> (Int,Int)

frecuencia :: Integer -> Int

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_posicionesIniciales :: Integer -> IO ()

grafica_frecuencias :: Integer -> IO ()

tales que

raicesEnterasPrimos es la sucesión de las raíces enteras (por defecto) de los números primos. Por ejemplo,

     λ> take 20 raicesEnterasPrimos
     [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8]
     λ> raicesEnterasPrimos !! 2500000
     6415

λ> take 20 raicesEnterasPrimos

[1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8]

λ> raicesEnterasPrimos !! 2500000

6415

(posiciones x) es el par formado por la menor y la mayor posición de x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      posiciones 2     ==  (2,3)
      posiciones 4     ==  (6,8)
      posiciones 2017  ==  (287671,287931)
      posiciones 2018  ==  (287932,288208)

posiciones 2 == (2,3)

posiciones 4 == (6,8)

posiciones 2017 == (287671,287931)

posiciones 2018 == (287932,288208)

(frecuencia x) es el número de veces que aparece x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      frecuencia 2     ==  2
      frecuencia 4     ==  3
      frecuencia 2017  ==  261
      frecuencia 2018  ==  277

frecuencia 2 == 2

frecuencia 4 == 3

frecuencia 2017 == 261

frecuencia 2018 == 277

(grafica_raicesEnterasPrimos n) dibuja la gráfica de los n primeros términos de la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_raicesEnterasPrimos 200) dibuja
(grafica_posicionesIniciales n) dibuja la gráfica de las menores posiciones de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_posicionesIniciales 200) dibuja
(grafica_frecuencia n) dibuja la gráfica de las frecuencia de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_frecuencia 200) dibuja

Soluciones

import Data.Numbers.Primes (primes)
import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]
raicesEnterasPrimos = map raizEntera primes                       

raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)
posiciones x = (n,n+m-1)
  where (as,bs) = span (<x) raicesEnterasPrimos
        cs      = takeWhile (==x) bs 
        n       = length as
        m       = length cs

frecuencia :: Integer -> Int
frecuencia x =
  ( length
  . takeWhile (==x)
  . dropWhile (<x)
  ) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()
grafica_raicesEnterasPrimos n = 
  plotList [ Title "Raices enteras de primos"
           , XLabel "Posiciones de numeros primos"
           , YLabel "Raiz entera del n-esimo primo"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_1.png"
           ]
           (take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()
grafica_posicionesIniciales n = 
  plotList [ Title "Posiciones iniciales en raices enteras de primos"
           , XLabel "Numeros enteros"
           , YLabel "Posicion del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_2.png"
           ]
           (map (fst . posiciones) [1..n])

grafica_frecuencias :: Integer -> IO ()
grafica_frecuencias n = 
  plotList [ Title "Frecuencias en raices enteras de primos"
           , XLabel "Numeros enteros n"
           , YLabel "Frecuencia del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_3.png"
           ]
           (map frecuencia [1..n])

import Data.Numbers.Primes (primes)

import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]

raicesEnterasPrimos = map raizEntera primes

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)

posiciones x = (n,n+m-1)

where (as,bs) = span (<x) raicesEnterasPrimos

cs = takeWhile (==x) bs

n = length as

m = length cs

frecuencia :: Integer -> Int

frecuencia x =

( length

. takeWhile (==x)

. dropWhile (<x)

) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_raicesEnterasPrimos n =

plotList [ Title "Raices enteras de primos"

, XLabel "Posiciones de numeros primos"

, YLabel "Raiz entera del n-esimo primo"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_1.png"

]

(take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()

grafica_posicionesIniciales n =

plotList [ Title "Posiciones iniciales en raices enteras de primos"

, XLabel "Numeros enteros"

, YLabel "Posicion del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_2.png"

]

(map (fst . posiciones) [1..n])

grafica_frecuencias :: Integer -> IO ()

grafica_frecuencias n =

plotList [ Title "Frecuencias en raices enteras de primos"

, XLabel "Numeros enteros n"

, YLabel "Frecuencia del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_3.png"

]

(map frecuencia [1..n])

Rotaciones divisibles por 8

PorJosé A. Alonso 22-diciembre-201719-febrero-2018

Las rotaciones de 928160 son 928160, 281609, 816092, 160928, 609281 y 92816 de las que 3 son divisibles por 8 (928160, 160928 y 92816).

Definir la función

   nRotacionesDivisiblesPor8 :: Integer -> Int

1	nRotacionesDivisiblesPor8 :: Integer -> Int

tal que (nRotacionesDivisiblesPor8 x) es el número de rotaciones de x divisibles por 8. Por ejemplo,

   nRotacionesDivisiblesPor8 928160       ==  3
   nRotacionesDivisiblesPor8 43262488612  ==  4
   nRotacionesDivisiblesPor8 (read (take (10^4) (cycle "248")))  ==  6666

nRotacionesDivisiblesPor8 928160 == 3

nRotacionesDivisiblesPor8 43262488612 == 4

nRotacionesDivisiblesPor8 (read (take (10^4) (cycle "248"))) == 6666

Soluciones

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

nRotacionesDivisiblesPor8 :: Integer -> Int
nRotacionesDivisiblesPor8 x =
  length [y | y <- rotaciones x
            , y `mod` 8 == 0]

--    rotaciones 1234  ==  [1234,2341,3412,4123]
rotaciones :: Integer -> [Integer]
rotaciones x = [read ys | ys <- rotacionesLista xs]
  where xs = show x

--    rotacionesLista "abcd"  ==  ["abcd","bcda","cdab","dabc"]
rotacionesLista :: [a] -> [[a]]
rotacionesLista xs =
  [zs ++ ys | k <- [0 .. length xs - 1]
            , let (ys,zs) = splitAt k xs] 

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

nRotacionesDivisiblesPor8b :: Integer -> Int
nRotacionesDivisiblesPor8b x =
  length [y | y <- tresDigitosConsecutivos x
            , y `mod` 8 == 0]

--    tresDigitosConsecutivos 1234  ==  [123,234,341,412]
tresDigitosConsecutivos :: Integer -> [Integer]
tresDigitosConsecutivos x =
  [read (take 3 ys) | ys <- rotacionesLista (show x)]

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

--    λ> nRotacionesDivisiblesPor8 (read (take (3*10^3) (cycle "248")))
--    2000
--    (3.59 secs, 4,449,162,144 bytes)
--    λ> nRotacionesDivisiblesPor8b (read (take (3*10^3) (cycle "248")))
--    2000
--    (0.48 secs, 593,670,656 bytes)

-- 1ª definición

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

nRotacionesDivisiblesPor8 :: Integer -> Int

nRotacionesDivisiblesPor8 x =

length [y | y <- rotaciones x

, y `mod` 8 == 0]

-- rotaciones 1234 == [1234,2341,3412,4123]

rotaciones :: Integer -> [Integer]

rotaciones x = [read ys | ys <- rotacionesLista xs]

where xs = show x

-- rotacionesLista "abcd" == ["abcd","bcda","cdab","dabc"]

rotacionesLista :: [a] -> [[a]]

rotacionesLista xs =

[zs ++ ys | k <- [0 .. length xs - 1]

, let (ys,zs) = splitAt k xs]

-- 2ª definición

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

nRotacionesDivisiblesPor8b :: Integer -> Int

nRotacionesDivisiblesPor8b x =

length [y | y <- tresDigitosConsecutivos x

, y `mod` 8 == 0]

-- tresDigitosConsecutivos 1234 == [123,234,341,412]

tresDigitosConsecutivos :: Integer -> [Integer]

tresDigitosConsecutivos x =

[read (take 3 ys) | ys <- rotacionesLista (show x)]

-- Comparación de eficiencia

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

-- λ> nRotacionesDivisiblesPor8 (read (take (3*10^3) (cycle "248")))

-- 2000

-- (3.59 secs, 4,449,162,144 bytes)

-- λ> nRotacionesDivisiblesPor8b (read (take (3*10^3) (cycle "248")))

-- 2000

-- (0.48 secs, 593,670,656 bytes)

Aplicaciones biyectivas

PorJosé A. Alonso 14-diciembre-201721-diciembre-2017

Definir las funciones

   biyectivas  :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
   nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer

1 2	biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]] nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer

tales que

(biyectivas xs ys) es el conjunto de las aplicaciones biyectivas del conjunto xs en el conjunto ys. Por ejemplo,

     λ> biyectivas [1,3] [2,4]
     [[(1,2),(3,4)],[(1,4),(3,2)]]
     λ> biyectivas [1,3,5] [2,4,6]
     [[(1,2),(3,4),(5,6)],[(1,4),(3,2),(5,6)],[(1,6),(3,4),(5,2)],
      [(1,4),(3,6),(5,2)],[(1,6),(3,2),(5,4)],[(1,2),(3,6),(5,4)]]
     λ> biyectivas [1,3] [2,4,6]
     []

λ> biyectivas [1,3] [2,4]

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

λ> biyectivas [1,3,5] [2,4,6]

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

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

λ> biyectivas [1,3] [2,4,6]

[]

(nBiyectivas xs ys) es el número de aplicaciones biyectivas del conjunto xs en el conjunto ys. Por ejemplo,

     nBiyectivas [1,3] [2,4]      ==  2
     nBiyectivas [1,3,5] [2,4,6]  ==  6
     λ> nBiyectivas [1,3] [2,4,6] ==  0
     length (show (nBiyectivas2 [1..2*10^4] [1..2*10^4]))  ==  77338

nBiyectivas [1,3] [2,4] == 2

nBiyectivas [1,3,5] [2,4,6] == 6

λ> nBiyectivas [1,3] [2,4,6] == 0

length (show (nBiyectivas2 [1..2*10^4] [1..2*10^4])) == 77338

Nota: En este ejercicio los conjuntos se representan mediante listas ordenadas de elementos distintos.

Soluciones

import Data.List (genericLength, permutations)

-- 1ª definición de biyectivas
biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
biyectivas xs ys
  | length xs == length ys = [zip xs zs | zs <- permutations ys]
  | otherwise              = []

-- 1ª definición de nBiyectivas
nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas xs ys
  | length xs == length ys = genericLength (biyectivas xs ys)
  | otherwise              = 0

-- 2ª definición de nBiyectivas
nBiyectivas2 :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas2 xs ys 
  | n == m    = product [1..n]
  | otherwise = 0
  where n = genericLength xs
        m = genericLength ys

import Data.List (genericLength, permutations)

-- 1ª definición de biyectivas

biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]

biyectivas xs ys

| length xs == length ys = [zip xs zs | zs <- permutations ys]

| otherwise = []

-- 1ª definición de nBiyectivas

nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer

nBiyectivas xs ys

| length xs == length ys = genericLength (biyectivas xs ys)

| otherwise = 0

-- 2ª definición de nBiyectivas

nBiyectivas2 :: (Ord a, Ord b) => [a] -> [b] -> Integer

nBiyectivas2 xs ys

| n == m = product [1..n]

| otherwise = 0

where n = genericLength xs

m = genericLength ys

Caminos minimales en un árbol numérico

PorJosé A. Alonso 7-diciembre-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

-- [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Máximo de las rotaciones restringidas

PorJosé A. Alonso 6-diciembre-201713-diciembre-2017

Rotar un número a la iquierda significa pasar su primer dígito al final. Por ejemplo, rotando a la izquierda el 56789 se obtiene 67895.

Las rotaciones restringidas del número 56789 se obtienen como se indica a continución:

Se inicia con el propio número: 56789
El anterior se rota a la izquierda y se obtiene el 67895.
Del anterior se fija el primer dígito y se rota a la iquierda los otros. Se obtiene 68957.
Del anterior se fijan los 2 primeros dígito y se rota a la iquierda los otros. Se obtiene 68579.
Del anterior se fijan los 3 primeros dígito y se rota a la iquierda los otros. Se obtiene 68597.

El proceso ha terminado ya que conservando los cuatro primeros queda sólo un dígito que al girar es él mismo. Por tanto, la sucesión de las rotaciones restringidas de 56789 es

   56789 -> 67895 -> 68957 -> 68579 -> 68597

1	56789 -> 67895 -> 68957 -> 68579 -> 68597

y su mayor elemento es 68957.

Definir la función

   maxRotaciones :: Integer -> Integer

1	maxRotaciones :: Integer -> Integer

tal que (maxRotaciones n) es el máximo de las rotaciones restringidas del número n. Por ejemplo,

   maxRotaciones 56789       ==  68957
   maxRotaciones 1347902468  ==  3790246814
   maxRotaciones 6           ==  6
   maxRotaciones 2017        ==  2017

maxRotaciones 56789 == 68957

maxRotaciones 1347902468 == 3790246814

maxRotaciones 6 == 6

maxRotaciones 2017 == 2017

Soluciones

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

maxRotaciones :: Integer -> Integer
maxRotaciones = read . aux . show
  where aux n@[_]        = n
        aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

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

maxRotaciones2 :: Integer -> Integer
maxRotaciones2 n
  | n < 10    = n
  | otherwise = maximum [ read (us ++ vs)
                        | (us,vs) <- take m (iterate siguiente ("",xs)) ]
  where xs = show n
        m  = length xs

-- siguiente ("","56789")  ==  ("6","7895")
-- siguiente ("6","7895")  ==  ("68","957")
-- siguiente ("68","957")  ==  ("685","79")
-- siguiente ("685","79")  ==  ("6859","7")
-- siguiente ("6859","7")  ==  ("6859","7")
siguiente :: (String,String) -> (String,String)
siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])
siguiente (xs,[a])    = (xs,[a])

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

maxRotaciones3 :: Integer -> Integer
maxRotaciones3 = read . aux . show
  where aux (x:y:xs) | x > y     = x : y : xs
                     | otherwise = y : (aux $ xs ++ [x])
        aux [x]                  = [x]
        aux _                    = []

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

--    λ> length (show (maxRotaciones (n (5*10^3))))
--    5001
--    (2.74 secs, 802,282,616 bytes)
--    λ> length (show (maxRotaciones2 (n (5*10^3))))
--    5001
--    (18.23 secs, 12,375,579,216 bytes)
--    λ> length (show (maxRotaciones3 (n (5*10^3))))
--    5001
--    (0.67 secs, 729,155,056 bytes)

-- 1ª solución

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

maxRotaciones :: Integer -> Integer

maxRotaciones = read . aux . show

where aux n@[_] = n

aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

-- 2ª solución

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

maxRotaciones2 :: Integer -> Integer

maxRotaciones2 n

| n < 10 = n

| otherwise = maximum [ read (us ++ vs)

| (us,vs) <- take m (iterate siguiente ("",xs)) ]

where xs = show n

m = length xs

-- siguiente ("","56789") == ("6","7895")

-- siguiente ("6","7895") == ("68","957")

-- siguiente ("68","957") == ("685","79")

-- siguiente ("685","79") == ("6859","7")

-- siguiente ("6859","7") == ("6859","7")

siguiente :: (String,String) -> (String,String)

siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])

siguiente (xs,[a]) = (xs,[a])

-- 3ª solución

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

maxRotaciones3 :: Integer -> Integer

maxRotaciones3 = read . aux . show

where aux (x:y:xs) | x > y = x : y : xs

| otherwise = y : (aux $ xs ++ [x])

aux [x] = [x]

aux _ = []

-- Comparación de eficiencia

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

-- λ> length (show (maxRotaciones (n (5*10^3))))

-- 5001

-- (2.74 secs, 802,282,616 bytes)

-- λ> length (show (maxRotaciones2 (n (5*10^3))))

-- 5001

-- (18.23 secs, 12,375,579,216 bytes)

-- λ> length (show (maxRotaciones3 (n (5*10^3))))

-- 5001

-- (0.67 secs, 729,155,056 bytes)

Conjunto de relaciones binarias entre dos conjuntos

PorJosé A. Alonso 27-noviembre-20174-diciembre-2017

Una relación binaria entre dos conjuntos A y B se puede representar mediante un conjunto de pares (a,b) tales que a ∈ A y b ∈ B. Por ejemplo, la relación < entre A = {1,5,3} y B = {0,2,4} se representa por {(1,2),(1,4),(3,4)}.

Definir las funciones

   relaciones  :: [a] -> [b] -> [[(a,b)]]
   nRelaciones :: [a] -> [b] -> Integer

1 2	relaciones :: [a] -> [b] -> [[(a,b)]] nRelaciones :: [a] -> [b] -> Integer

tales que

(relaciones xs ys) es el conjunto de las relaciones del conjunto xs en el conjunto ys. Por ejemplo,

     λ> relaciones [1] [2]
     [[],[(1,2)]]
     λ> relaciones [1] [2,4]
     [[],[(1,2)],[(1,4)],[(1,2),(1,4)]]
     λ> relaciones [1,3] [2]
     [[],[(1,2)],[(3,2)],[(1,2),(3,2)]]
     λ> relaciones [1,3] [2,4]
     [[],[(1,2)],[(1,4)],[(1,2),(1,4)],[(3,2)],[(1,2),(3,2)],
      [(1,4),(3,2)],[(1,2),(1,4),(3,2)],[(3,4)],[(1,2),(3,4)],
      [(1,4),(3,4)],[(1,2),(1,4),(3,4)],[(3,2),(3,4)],
      [(1,2),(3,2),(3,4)],[(1,4),(3,2),(3,4)],
      [(1,2),(1,4),(3,2),(3,4)]]
     λ> relaciones [] []
     [[]]
     λ> relaciones [] [2]
     [[]]
     λ> relaciones [1] []
     [[]]

λ> relaciones [1] [2]

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

λ> relaciones [1] [2,4]

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

λ> relaciones [1,3] [2]

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

λ> relaciones [1,3] [2,4]

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

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

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

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

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

λ> relaciones [] []

[[]]

λ> relaciones [] [2]

[[]]

λ> relaciones [1] []

[[]]

(nRelaciones xs ys) es el número de relaciones del conjunto xs en el conjunto ys. Por ejemplo,

     nRelaciones [1,2] [4,5]    ==  16
     nRelaciones [1,2] [4,5,6]  ==  64
     nRelaciones [0..9] [0..9]  ==  1267650600228229401496703205376

nRelaciones [1,2] [4,5] == 16

nRelaciones [1,2] [4,5,6] == 64

nRelaciones [0..9] [0..9] == 1267650600228229401496703205376

Soluciones

import Data.List (genericLength, subsequences)

relaciones :: [a] -> [b] -> [[(a,b)]]
relaciones xs ys =
  subsequences (producto xs ys)

-- (producto xs ys) es el producto cartesiano de xs e ys. Por ejemplo,
--    producto [1,3] [2,4]  ==  [(1,2),(1,4),(3,2),(3,4)]
producto :: [a] -> [b] -> [(a,b)]
producto xs ys =
  [(x,y) | x <- xs, y <- ys]

-- 1ª definición de nRelaciones
nRelaciones :: [a] -> [b] -> Integer
nRelaciones xs ys = genericLength (relaciones xs ys)

-- 2ª definición de nRelaciones
nRelaciones2 :: [a] -> [b] -> Integer
nRelaciones2 xs ys =
  2^(length xs * length ys)

-- Comparación de eficiencia
--    λ> nRelaciones [1..4] [1..5]
--    1048576
--    (1.17 secs, 228,243,608 bytes)
--    λ> nRelaciones2 [1..4] [1..5]
--    1048576
--    (0.02 secs, 144,856 bytes)

import Data.List (genericLength, subsequences)

relaciones :: [a] -> [b] -> [[(a,b)]]

relaciones xs ys =

subsequences (producto xs ys)

-- (producto xs ys) es el producto cartesiano de xs e ys. Por ejemplo,

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

producto :: [a] -> [b] -> [(a,b)]

producto xs ys =

[(x,y) | x <- xs, y <- ys]

-- 1ª definición de nRelaciones

nRelaciones :: [a] -> [b] -> Integer

nRelaciones xs ys = genericLength (relaciones xs ys)

-- 2ª definición de nRelaciones

nRelaciones2 :: [a] -> [b] -> Integer

nRelaciones2 xs ys =

2^(length xs * length ys)

-- Comparación de eficiencia

-- λ> nRelaciones [1..4] [1..5]

-- 1048576

-- (1.17 secs, 228,243,608 bytes)

-- λ> nRelaciones2 [1..4] [1..5]

-- 1048576

-- (0.02 secs, 144,856 bytes)

Sucesión contadora

PorJosé A. Alonso 22-noviembre-201726-marzo-2022

Definir las siguientes funciones

   numeroContado           :: Integer -> Integer
   contadora               :: Integer -> [Integer]
   lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

numeroContado :: Integer -> Integer

contadora :: Integer -> [Integer]

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

tales que

(numeroContado n) es el número obtenido al contar las repeticiones de cada una de las cifras de n. Por ejemplo,

     numeroContado 1                 == 11
     numeroContado 114213            == 31121314
     numeroContado 1111111111111111  == 161
     numeroContado 555555555500      == 20105

numeroContado 1 == 11

numeroContado 114213 == 31121314

numeroContado 1111111111111111 == 161

numeroContado 555555555500 == 20105

(contadora n) es la sucesión cuyo primer elemento es n y los restantes se obtienen contando el número anterior de la sucesión. Por ejemplo,

     λ> take 14 (contadora 1)
     [1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,
      31221324,21322314,21322314]
     λ> take 14 (contadora 5)
     [5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,
      3132132415,3122331415,3122331415,3122331415,3122331415]

λ> take 14 (contadora 1)

[1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,

31221324,21322314,21322314]

λ> take 14 (contadora 5)

[5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,

3132132415,3122331415,3122331415,3122331415,3122331415]

(lugarPuntoFijoContadora n k) es el menor i <= k tal que son iguales los elementos en las posiciones i e i+1 de la sucesión contadora que cominza con n. Por ejemplo,

      λ> lugarPuntoFijoContadora 1 100
      Just 12
      λ> contadora 1 !! 11
      31221324
      λ> contadora 1 !! 12
      21322314
      λ> contadora 1 !! 13
      21322314
      λ> lugarPuntoFijoContadora 1 10
      Nothing
      λ> lugarPuntoFijoContadora 5 20
      Just 10
      λ> lugarPuntoFijoContadora 40 200
      Nothing

λ> lugarPuntoFijoContadora 1 100

Just 12

λ> contadora 1 !! 11

31221324

λ> contadora 1 !! 12

21322314

λ> contadora 1 !! 13

21322314

λ> lugarPuntoFijoContadora 1 10

Nothing

λ> lugarPuntoFijoContadora 5 20

Just 10

λ> lugarPuntoFijoContadora 40 200

Nothing

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz.

Soluciones

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

-- Definición de numeroContado
numeroContado :: Integer -> Integer
numeroContado n =
  (read . concat . map concat) [[(show . length) m,nub m]
                               | m <- (group . sort . show) n]

-- 1ª definición de contadora
contadora :: Integer -> [Integer]
contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora
contadora2 :: Integer ->  [Integer]
contadora2 = iterate numeroContado 

-- Definición de lugarPuntoFijoContadora
lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer
lugarPuntoFijoContadora n k
  | m == k-1  = Nothing
  | otherwise = Just m
  where xs = genericTake k (contadora n)
        ds = zipWith (-) xs (tail xs)
        m  = genericLength (takeWhile (/=0) ds)

import Data.List ( genericLength

, genericTake

, group

, nub

, sort

)

-- Definición de numeroContado

numeroContado :: Integer -> Integer

numeroContado n =

(read . concat . map concat) [[(show . length) m,nub m]

| m <- (group . sort . show) n]

-- 1ª definición de contadora

contadora :: Integer -> [Integer]

contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora

contadora2 :: Integer -> [Integer]

contadora2 = iterate numeroContado

-- Definición de lugarPuntoFijoContadora

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

lugarPuntoFijoContadora n k

| m == k-1 = Nothing

| otherwise = Just m

where xs = genericTake k (contadora n)

ds = zipWith (-) xs (tail xs)

m = genericLength (takeWhile (/=0) ds)

Biparticiones de un número

PorJosé A. Alonso 9-noviembre-201716-noviembre-2017

Definir la función

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

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

tal que (biparticiones n) es la lista de pares de números formados por las primeras cifras de n y las restantes. Por ejemplo,

   biparticiones  2025  ==  [(202,5),(20,25),(2,25)]
   biparticiones 10000  ==  [(1000,0),(100,0),(10,0),(1,0)]

1 2	biparticiones 2025 == [(202,5),(20,25),(2,25)] biparticiones 10000 == [(1000,0),(100,0),(10,0),(1,0)]

Soluciones

import Test.QuickCheck

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

biparticiones1 :: Integer -> [(Integer,Integer)]
biparticiones1 x = [(read y, read z) | (y,z) <- biparticionesL1 xs]
  where xs = show x

-- (biparticionesL1 xs) es la lista de los pares formados por los
-- prefijos no vacío de xs y su resto. Por ejemplo,
--    biparticionesL1 "2025" == [("2","025"),("20","25"),("202","5")]
biparticionesL1 :: [a] -> [([a],[a])]
biparticionesL1 xs = [splitAt k xs | k <- [1..length xs - 1]]

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

biparticiones2 :: Integer -> [(Integer,Integer)]
biparticiones2 x = [(read y, read z) | (y,z) <- biparticionesL2 xs]
  where xs = show x

-- (biparticionesL2 xs) es la lista de los pares formados por los
-- prefijos no vacío de xs y su resto. Por ejemplo,
--    biparticionesL2 "2025" == [("2","025"),("20","25"),("202","5")]
biparticionesL2 :: [a] -> [([a],[a])]
biparticionesL2 xs =
  takeWhile (not . null . snd) [splitAt n xs | n <- [1..]]

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

biparticiones3 :: Integer -> [(Integer,Integer)]
biparticiones3 a =
  takeWhile ((>0) . fst) [divMod a (10^n) | n <- [1..]] 

-- 4ª solución
-- ===========

biparticiones4 :: Integer -> [(Integer,Integer)]
biparticiones4 n =
  [quotRem n (10^x) | x <- [1..length (show n) -1]]

-- 5ª solución
-- ===========

biparticiones5 :: Integer -> [(Integer,Integer)]
biparticiones5 n =
  takeWhile (/= (0,n)) [divMod n (10^x) | x <- [1..]]

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

--    λ> numero n = (read (replicate n '2')) :: Integer
--    (0.00 secs, 0 bytes)
--    λ> length (biparticiones1 (numero 10000))
--    9999
--    (0.03 secs, 10,753,192 bytes)
--    λ> length (biparticiones2 (numero 10000))
--    9999
--    (1.89 secs, 6,410,513,136 bytes)
--    λ> length (biparticiones3 (numero 10000))
--    9999
--    (0.54 secs, 152,777,680 bytes)
--    λ> length (biparticiones4 (numero 10000))
--    9999
--    (0.01 secs, 7,382,816 bytes)
--    λ> length (biparticiones5 (numero 10000))
--    9999
--    (2.11 secs, 152,131,136 bytes)
--    
--    λ> length (biparticiones1 (numero (10^7)))
--    9999999
--    (14.23 secs, 10,401,100,848 bytes)
--    λ> length (biparticiones4 (numero (10^7)))
--    9999999
--    (11.43 secs, 7,361,097,856 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

biparticiones1 x = [(read y, read z) | (y,z) <- biparticionesL1 xs]

where xs = show x

-- (biparticionesL1 xs) es la lista de los pares formados por los

-- prefijos no vacío de xs y su resto. Por ejemplo,

-- biparticionesL1 "2025" == [("2","025"),("20","25"),("202","5")]

biparticionesL1 :: [a] -> [([a],[a])]

biparticionesL1 xs = [splitAt k xs | k <- [1..length xs - 1]]

-- 2ª solución

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

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

biparticiones2 x = [(read y, read z) | (y,z) <- biparticionesL2 xs]

where xs = show x

-- (biparticionesL2 xs) es la lista de los pares formados por los

-- prefijos no vacío de xs y su resto. Por ejemplo,

-- biparticionesL2 "2025" == [("2","025"),("20","25"),("202","5")]

biparticionesL2 :: [a] -> [([a],[a])]

biparticionesL2 xs =

takeWhile (not . null . snd) [splitAt n xs | n <- [1..]]

-- 3ª solución

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

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

biparticiones3 a =

takeWhile ((>0) . fst) [divMod a (10^n) | n <- [1..]]

-- 4ª solución

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

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

biparticiones4 n =

[quotRem n (10^x) | x <- [1..length (show n) -1]]

-- 5ª solución

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

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

biparticiones5 n =

takeWhile (/= (0,n)) [divMod n (10^x) | x <- [1..]]

-- Comparación de eficiencia

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

-- λ> numero n = (read (replicate n '2')) :: Integer

-- (0.00 secs, 0 bytes)

-- λ> length (biparticiones1 (numero 10000))

-- 9999

-- (0.03 secs, 10,753,192 bytes)

-- λ> length (biparticiones2 (numero 10000))

-- 9999

-- (1.89 secs, 6,410,513,136 bytes)

-- λ> length (biparticiones3 (numero 10000))

-- 9999

-- (0.54 secs, 152,777,680 bytes)

-- λ> length (biparticiones4 (numero 10000))

-- 9999

-- (0.01 secs, 7,382,816 bytes)

-- λ> length (biparticiones5 (numero 10000))

-- 9999

-- (2.11 secs, 152,131,136 bytes)

-- λ> length (biparticiones1 (numero (10^7)))

-- 9999999

-- (14.23 secs, 10,401,100,848 bytes)

-- λ> length (biparticiones4 (numero (10^7)))

-- 9999999

-- (11.43 secs, 7,361,097,856 bytes)

Sucesión de Recamán

PorJosé A. Alonso 24-abril-201726-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

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

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

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

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

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

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

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

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

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

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

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

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman2 !! (2*10^4)

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

-- λ> sucRecaman3 !! (2*10^4)

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Números como sumas de primos consecutivos

PorJosé A. Alonso 19-abril-201725-abril-2021

El número 311 se puede escribir de 5 formas distintas como suma de 1 o más primos consecutivos

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107
   311 = 311

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

311 = 311

el número 41 se puede escribir de 4 formas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17
   41 = 41

41 = 2 + 3 + 5 + 7 + 11 + 13

41 = 11 + 13 + 17

41 = 41

y el número 14 no se puede escribir como suma de primos consecutivos.

Definir la función

   sumas :: Integer -> [[Integer]]

1	sumas :: Integer -> [[Integer]]

tal que (sumas x) es la lista de las formas de escribir x como suma de uno o más números primos consecutivos. Por ejemplo,

   λ> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107],[311]]
   λ> sumas 41
   [[2,3,5,7,11,13],[11,13,17],[41]]
   λ> sumas 14
   []
   λ> [length (sumas n) | n <- [0..20]]
   [0,0,1,1,0,2,0,1,1,0,1,1,1,1,0,1,0,2,1,1,0]
   λ> maximum [length (sumas n) | n <- [1..600]]
   5

λ> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107],[311]]

λ> sumas 41

[[2,3,5,7,11,13],[11,13,17],[41]]

λ> sumas 14

[]

λ> [length (sumas n) | n <- [0..20]]

[0,0,1,1,0,2,0,1,1,0,1,1,1,1,0,1,0,2,1,1,0]

λ> maximum [length (sumas n) | n <- [1..600]]

Soluciones

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

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (<= x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (<= x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Rotaciones divisibles por 4

PorJosé A. Alonso 3-abril-201710-abril-2017

Las rotaciones de 928160 son 928160, 281609, 816092, 160928, 609281 y 92816. De las cuales, las divisibles por 4 son 928160, 816092, 160928 y 92816.

Definir la función

   nRotacionesDivisibles :: Integer -> Int

1	nRotacionesDivisibles :: Integer -> Int

tal que (nRotacionesDivisibles n) es el número de rotaciones del número n divisibles por 4. Por ejemplo,

   nRotacionesDivisibles 928160          ==  4
   nRotacionesDivisibles 44              ==  2
   nRotacionesDivisibles (1234^50000)    ==  38684
   nRotacionesDivisibles (1234^300000)   ==  231853

nRotacionesDivisibles 928160 == 4

nRotacionesDivisibles 44 == 2

nRotacionesDivisibles (1234^50000) == 38684

nRotacionesDivisibles (1234^300000) == 231853

Soluciones

import Data.Char (digitToInt)

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

nRotacionesDivisibles :: Integer -> Int
nRotacionesDivisibles n =
  length [x | x <- rotacionesNumero n, x `mod` 4 == 0]


-- (rotacionesNumero) es la lista de la rotaciones del número n. Por
-- ejemplo,
--    rotacionesNumero 235  ==  [235,352,523]
rotacionesNumero :: Integer -> [Integer]
rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo, 
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

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

nRotacionesDivisibles2 :: Integer -> Int
nRotacionesDivisibles2 n = 
  length [x | x <- pares n, x `mod` 4 == 0]

-- (pares n) es la lista de pares de elementos consecutivos, incluyendo
-- el último con el primero. Por ejemplo,
--    pares 928160  ==  [9,92,28,81,16,60]
pares :: Integer -> [Int]
pares n =
  read [last ns,head ns] : [read [a,b] | (a,b) <- zip ns (tail ns)]
  where ns = show n

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

nRotacionesDivisibles3 :: Integer -> Int
nRotacionesDivisibles3 n =
  ( length
  . filter (0 ==)
  . map (`mod` 4)
  . zipWith (\x y -> 2*x + y) d
  . tail
  . (++[i])) d
  where
    d@(i:dn) = (map digitToInt . show) n

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

--    λ> nRotacionesDivisibles (123^1500)
--    803
--    (8.15 secs, 7,109,852,800 bytes)
--    λ> nRotacionesDivisibles2 (123^1500)
--    803
--    (0.05 secs, 0 bytes)
--    λ> nRotacionesDivisibles3 (123^1500)
--    803
--    (0.02 secs, 0 bytes)
--
--    λ> nRotacionesDivisibles2 (1234^50000)
--    38684
--    (2.24 secs, 1,160,467,472 bytes)
--    λ> nRotacionesDivisibles3 (1234^50000)
--    38684
--    (0.31 secs, 68,252,040 bytes)

import Data.Char (digitToInt)

-- 1ª definición

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

nRotacionesDivisibles :: Integer -> Int

nRotacionesDivisibles n =

length [x | x <- rotacionesNumero n, x `mod` 4 == 0]

-- (rotacionesNumero) es la lista de la rotaciones del número n. Por

-- ejemplo,

-- rotacionesNumero 235 == [235,352,523]

rotacionesNumero :: Integer -> [Integer]

rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones :: [a] -> [[a]]

rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 2ª definición

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

nRotacionesDivisibles2 :: Integer -> Int

nRotacionesDivisibles2 n =

length [x | x <- pares n, x `mod` 4 == 0]

-- (pares n) es la lista de pares de elementos consecutivos, incluyendo

-- el último con el primero. Por ejemplo,

-- pares 928160 == [9,92,28,81,16,60]

pares :: Integer -> [Int]

pares n =

read [last ns,head ns] : [read [a,b] | (a,b) <- zip ns (tail ns)]

where ns = show n

-- 3ª definición

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

nRotacionesDivisibles3 :: Integer -> Int

nRotacionesDivisibles3 n =

( length

. filter (0 ==)

. map (`mod` 4)

. zipWith (\x y -> 2*x + y) d

. tail

. (++[i])) d

where

d@(i:dn) = (map digitToInt . show) n

-- Comparación de eficiencia

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

-- λ> nRotacionesDivisibles (123^1500)

-- 803

-- (8.15 secs, 7,109,852,800 bytes)

-- λ> nRotacionesDivisibles2 (123^1500)

-- 803

-- (0.05 secs, 0 bytes)

-- λ> nRotacionesDivisibles3 (123^1500)

-- 803

-- (0.02 secs, 0 bytes)

-- λ> nRotacionesDivisibles2 (1234^50000)

-- 38684

-- (2.24 secs, 1,160,467,472 bytes)

-- λ> nRotacionesDivisibles3 (1234^50000)

-- 38684

-- (0.31 secs, 68,252,040 bytes)

Sumas con sumandos distintos o con sumandos impares

PorJosé A. Alonso 30-marzo-20176-abril-2017

El número 6 se puede descomponer de 4 formas distintas como suma con sumandos distintos:

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

6 = 1 + 2 + 3

6 = 1 + 5

6 = 2 + 4

6 = 6

y también se puede descomponer de 4 formas distintas como suma con sumandos impares:

   6 = 1 + 1 + 1 + 1 + 1 + 1
   6 = 1 + 1 + 1 + 3
   6 = 1 + 5
   6 = 3 + 3

6 = 1 + 1 + 1 + 1 + 1 + 1

6 = 1 + 1 + 1 + 3

6 = 1 + 5

6 = 3 + 3

Definir las siguientes funciones

   sumasSumandosDistintos  :: Integer -> [[Integer]]
   nSumasSumandosDistintos :: Integer -> Int
   sumasSumandosImpares    :: Integer -> [[Integer]]
   nSumasSumandosImpares   :: Integer -> Int
   igualdadDeSumas         :: Integer -> Bool

sumasSumandosDistintos :: Integer -> [[Integer]]

nSumasSumandosDistintos :: Integer -> Int

sumasSumandosImpares :: Integer -> [[Integer]]

nSumasSumandosImpares :: Integer -> Int

igualdadDeSumas :: Integer -> Bool

tales que

(sumasSumandosDistintos n) es la lista de las descomposiciones de n como sumas con sumandos distintos. Por ejemplo,

     sumasSumandosDistintos 5  ==  [[1,4],[2,3],[5]]
     sumasSumandosDistintos 6  ==  [[1,2,3],[1,5],[2,4],[6]]

1 2	sumasSumandosDistintos 5 == [[1,4],[2,3],[5]] sumasSumandosDistintos 6 == [[1,2,3],[1,5],[2,4],[6]]

(nSumasSumandosDistintos n) es el número de descomposiciones de n como sumas con sumandos distintos. Por ejemplo,

     nSumasSumandosDistintos 6  ==  4
     nSumasSumandosDistintos 7  ==  5

1 2	nSumasSumandosDistintos 6 == 4 nSumasSumandosDistintos 7 == 5

(sumasSumandosImpares n) es la lista de las descomposiones de n como sumas con sumandos impares. Por ejemplo,

     sumasSumandosImpares 5  ==  [[1,1,1,1,1],[1,1,3],[5]]
     sumasSumandosImpares 6  ==  [[1,1,1,1,1,1],[1,1,1,3],[1,5],[3,3]]

1 2	sumasSumandosImpares 5 == [[1,1,1,1,1],[1,1,3],[5]] sumasSumandosImpares 6 == [[1,1,1,1,1,1],[1,1,1,3],[1,5],[3,3]]

(nSumasSumandosImpares n) es el número de descomposiciones de n como sumas con sumandos impares. Por ejemplo,

     nSumasSumandosImpares 6  ==  4
     nSumasSumandosImpares 7  ==  5

1 2	nSumasSumandosImpares 6 == 4 nSumasSumandosImpares 7 == 5

(igualdadDeSumas n) se verifica si, para todo k entre 1 y n, las funciones nSumasSumandosDistintos y nSumasSumandosImpares son iguales. Por ejemplo,

     igualdadDeSumas 40  ==  True

1	igualdadDeSumas 40 == True

Soluciones

import Data.List (delete, nub)

-- Definiciones de sumasSumandosDistintos
-- ======================================

-- 1ª definición sumasSumandosDistintos
sumasSumandosDistintos :: Integer -> [[Integer]]
sumasSumandosDistintos n = aux n [1..n]
  where aux 0 _ = [[]]
        aux _ [] = []
        aux x ys@(y:_)
          | x < y     = []
          | x == y    = [[x]]
          | otherwise = [z : zs | z <- ys
                                , zs <- aux (x - z) (dropWhile (<=z) ys)]

-- 2ª definición de sumasSumandosDistintos
sumasSumandosDistintos2 :: Integer ->[[Integer]]
sumasSumandosDistintos2 = aux 0
  where aux i z
          | z < 0  = []
          | z == 0 = [[]]
          | z > 0  = concat [map (j:) (aux j (z-j)) | j <- [i+1..z]]

-- Definición de nSumasSumandosDistintos
-- =====================================

nSumasSumandosDistintos :: Integer -> Int
nSumasSumandosDistintos =
  length . sumasSumandosDistintos

-- Definiciones de sumasSumandosImpares
-- ====================================

-- 1ª definición de sumasSumandosImpares
sumasSumandosImpares :: Integer -> [[Integer]]
sumasSumandosImpares n = aux n [1,3..n]
  where aux n _ | n < 0 = []
        aux 0 _  = [[]]
        aux _ [] = []
        aux x zs@(y:ys) = [y:zs | zs <- aux (x-y) zs] ++ aux x ys 

-- 2ª definición de sumasSumandosImpares
sumasSumandosImpares2 :: Integer ->[[Integer]]
sumasSumandosImpares2 = aux 1
  where aux i z
          | z < 0  = []
          | z == 0 = [[]]
          | z > 0  = concat [map (j:) (aux j (z-j)) | j <-[i,i+2..z]]

-- Definición de nSumasSumandosImpares
-- ===================================

nSumasSumandosImpares :: Integer -> Int
nSumasSumandosImpares =
  length . sumasSumandosImpares

-- Definición conjunta (de josejuan)
-- =================================

-- podemos definir una gran familia de generadores de la siguiente forma
sumas :: Integer ->Integer ->Integer ->Integer ->Integer ->[[Integer]]
sumas u a b k n = s u n where
  s i z | z < 0 = []
        | z == 0 = [[]]
        | z > 0 = concat [map (j:) (s j (z - j)) | j <-[k*i+a,k*i+b..z]]
 
-- así, si queremos los distintos
sumasSumandosDistintos3 :: Integer ->[[Integer]]
sumasSumandosDistintos3 = sumas 0 1 2 1
 
-- o queremos los impares repetidos
sumasSumandosImpares3 :: Integer ->[[Integer]]
sumasSumandosImpares3 = sumas 1 0 2 1

-- Igualdad de las sumas
-- =====================

igualdadDeSumas :: Integer -> Bool
igualdadDeSumas n =
  and [nSumasSumandosDistintos k == nSumasSumandosImpares k | k <- [1..n]]

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

--    λ> length (sumasSumandosDistintos2 70)
--    29927
--    (0.57 secs, 374,604,848 bytes)
--    λ> length (sumasSumandosDistintos3 70)
--    29927
--    (0.57 secs, 352,658,200 bytes)
--    λ> length (sumasSumandosImpares 70)
--    29927
--    (8.87 secs, 5,221,638,688 bytes)
--    λ> length (sumasSumandosImpares2 70)
--    29927
--    (0.61 secs, 422,132,696 bytes)
--    λ> length (sumasSumandosImpares3 70)
--    29927
--    (0.56 secs, 412,289,336 bytes)

100

import Data.List (delete, nub)

-- Definiciones de sumasSumandosDistintos

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

-- 1ª definición sumasSumandosDistintos

sumasSumandosDistintos :: Integer -> [[Integer]]

sumasSumandosDistintos n = aux n [1..n]

where aux 0 _ = [[]]

aux _ [] = []

aux x ys@(y:_)

| x < y = []

| x == y = [[x]]

| otherwise = [z : zs | z <- ys

, zs <- aux (x - z) (dropWhile (<=z) ys)]

-- 2ª definición de sumasSumandosDistintos

sumasSumandosDistintos2 :: Integer ->[[Integer]]

sumasSumandosDistintos2 = aux 0

where aux i z

| z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (aux j (z-j)) | j <- [i+1..z]]

-- Definición de nSumasSumandosDistintos

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

nSumasSumandosDistintos :: Integer -> Int

nSumasSumandosDistintos =

length . sumasSumandosDistintos

-- Definiciones de sumasSumandosImpares

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

-- 1ª definición de sumasSumandosImpares

sumasSumandosImpares :: Integer -> [[Integer]]

sumasSumandosImpares n = aux n [1,3..n]

where aux n _ | n < 0 = []

aux 0 _ = [[]]

aux _ [] = []

aux x zs@(y:ys) = [y:zs | zs <- aux (x-y) zs] ++ aux x ys

-- 2ª definición de sumasSumandosImpares

sumasSumandosImpares2 :: Integer ->[[Integer]]

sumasSumandosImpares2 = aux 1

where aux i z

| z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (aux j (z-j)) | j <-[i,i+2..z]]

-- Definición de nSumasSumandosImpares

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

nSumasSumandosImpares :: Integer -> Int

nSumasSumandosImpares =

length . sumasSumandosImpares

-- Definición conjunta (de josejuan)

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

-- podemos definir una gran familia de generadores de la siguiente forma

sumas :: Integer ->Integer ->Integer ->Integer ->Integer ->[[Integer]]

sumas u a b k n = s u n where

s i z | z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (s j (z - j)) | j <-[k*i+a,k*i+b..z]]

-- así, si queremos los distintos

sumasSumandosDistintos3 :: Integer ->[[Integer]]

sumasSumandosDistintos3 = sumas 0 1 2 1

-- o queremos los impares repetidos

sumasSumandosImpares3 :: Integer ->[[Integer]]

sumasSumandosImpares3 = sumas 1 0 2 1

-- Igualdad de las sumas

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

igualdadDeSumas :: Integer -> Bool

igualdadDeSumas n =

and [nSumasSumandosDistintos k == nSumasSumandosImpares k | k <- [1..n]]

-- Comparación de eficiencia

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

-- λ> length (sumasSumandosDistintos2 70)

-- 29927

-- (0.57 secs, 374,604,848 bytes)

-- λ> length (sumasSumandosDistintos3 70)

-- 29927

-- (0.57 secs, 352,658,200 bytes)

-- λ> length (sumasSumandosImpares 70)

-- 29927

-- (8.87 secs, 5,221,638,688 bytes)

-- λ> length (sumasSumandosImpares2 70)

-- 29927

-- (0.61 secs, 422,132,696 bytes)

-- λ> length (sumasSumandosImpares3 70)

-- 29927

-- (0.56 secs, 412,289,336 bytes)

Caminos minimales en un arbol numérico

PorJosé A. Alonso 10-marzo-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

-- [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Precisión de aproximaciones de pi

PorJosé A. Alonso 27-febrero-20176-marzo-2017

La precisión de una aproximación x de pi es el número de dígitos comunes entre el inicio de x y de pi. Por ejemplo, puesto que 355/113 es 3.1415929203539825 y pi es 3.141592653589793, la precisión de 355/113 es 7.

Definir las siguientes funciones

   mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
   precisionPi       :: Double -> Int
   precisionPiCR     :: CReal -> Int

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

precisionPi :: Double -> Int

precisionPiCR :: CReal -> Int

tales que

(mayorPrefijoComun xs ys) es el mayor prefijo común de xs e ys. Por ejemplo,

     mayorPrefijoComun []      [2,3,4,5]  ==  []
     mayorPrefijoComun [2,3,5] []         ==  []
     mayorPrefijoComun [2,3,5] [2,3,4,5]  ==  [2,3]
     mayorPrefijoComun [2,3,5] [2,5,3,4]  ==  [2]
     mayorPrefijoComun [2,3,5] [5,2,3,4]  ==  []

mayorPrefijoComun [] [2,3,4,5] == []

mayorPrefijoComun [2,3,5] [] == []

mayorPrefijoComun [2,3,5] [2,3,4,5] == [2,3]

mayorPrefijoComun [2,3,5] [2,5,3,4] == [2]

mayorPrefijoComun [2,3,5] [5,2,3,4] == []

(precisionPi x) es la precisión de la aproximación de pi x. Por ejemplo,

     precisionPi (25/8)              ==  2
     precisionPi (22/7)              ==  3
     precisionPi (sqrt 2 + sqrt 3)   ==  3
     precisionPi (377/120)           ==  4
     precisionPi (31**(1/3))         ==  4
     precisionPi (7^7/4^9)           ==  5
     precisionPi (355/113)           ==  7
     precisionPi ((2143/22)**(1/4))  ==  9

precisionPi (25/8) == 2

precisionPi (22/7) == 3

precisionPi (sqrt 2 + sqrt 3) == 3

precisionPi (377/120) == 4

precisionPi (31**(1/3)) == 4

precisionPi (7^7/4^9) == 5

precisionPi (355/113) == 7

precisionPi ((2143/22)**(1/4)) == 9

(precisionPiCR x) es la precisión de la aproximación de pi x, como números reales. Por ejemplo,

     precisionPiCR (log (640320^3+744)/(sqrt 163))                        == 31
     precisionPiCR (log (5280^3*(236674+30303*sqrt 61)^3+744)/(sqrt 427)) == 53

1 2	precisionPiCR (log (640320^3+744)/(sqrt 163)) == 31 precisionPiCR (log (5280^3(236674+30303sqrt 61)^3+744)/(sqrt 427)) == 53

Nota: Para la definición precisionPiCR se usa la librería Data.Number.CReal que se instala con

   cabal install numbers

1	cabal install numbers

Soluciones

import Data.Number.CReal

-- mayorPrefijoComún
-- =================

-- 1ª definición
mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun [] _ = []
mayorPrefijoComun _ [] = []
mayorPrefijoComun (x:xs) (y:ys)
  | x == y    = x : mayorPrefijoComun xs ys
  | otherwise = []

-- 2ª definición
mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun2 xs ys =
  [x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)] 

-- 3ª definición
mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun3 xs ys =
  [x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)] 

-- 4ª definición
mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun4 xs =
  map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición
mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun5 =
  ((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi
-- ===========

-- 1ª definición
precisionPi :: Double -> Int
precisionPi x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = show x
        ys = show pi

-- 2ª definición
precisionPi2 :: Double -> Int
precisionPi2 =
  pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR
-- =============

precisionPiCR :: CReal -> Int
precisionPiCR = aux 50
  where aux n x | p < n-1   = p
                | otherwise = aux (n+50) x
          where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por
-- ejemplo,
--    precisionPiCRHasta 1 3.14   ==  2
--    precisionPiCRHasta 5 3.14   ==  3
--    precisionPiCRHasta 5 3.142  ==  3
--    precisionPiCRHasta 5 3.141  ==  4
precisionPiCRHasta :: Int -> CReal -> Int
precisionPiCRHasta n x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = showCReal n x
        ys = showCReal n pi

import Data.Number.CReal

-- mayorPrefijoComún

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

-- 1ª definición

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun [] _ = []

mayorPrefijoComun _ [] = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª definición

mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun2 xs ys =

[x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)]

-- 3ª definición

mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun3 xs ys =

[x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)]

-- 4ª definición

mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun4 xs =

map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición

mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun5 =

((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi

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

-- 1ª definición

precisionPi :: Double -> Int

precisionPi x =

length (mayorPrefijoComun xs ys) - 1

where xs = show x

ys = show pi

-- 2ª definición

precisionPi2 :: Double -> Int

precisionPi2 =

pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR

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

precisionPiCR :: CReal -> Int

precisionPiCR = aux 50

where aux n x | p < n-1 = p

| otherwise = aux (n+50) x

where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por

-- ejemplo,

-- precisionPiCRHasta 1 3.14 == 2

-- precisionPiCRHasta 5 3.14 == 3

-- precisionPiCRHasta 5 3.142 == 3

-- precisionPiCRHasta 5 3.141 == 4

precisionPiCRHasta :: Int -> CReal -> Int

precisionPiCRHasta n x =

length (mayorPrefijoComun xs ys) - 1

where xs = showCReal n x

ys = showCReal n pi

Distribución de dígitos de pi

PorJosé A. Alonso 16-febrero-201725-abril-2021

Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi, con la función digitosPi definida por

   digitosPi :: [Integer]
   digitosPi = g(1,0,1,1,3,3) where
     g (q,r,t,k,n,l) = 
       if 4*q+r-t < n*t
       then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
       else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

Por ejemplo,

   λ> take 25 digitosPi
   [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

1 2	λ> take 25 digitosPi [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

La distribución de los primeros 25 dígitos de pi es [0,2,3,5,3,3,3,1,2,3] ya que el 0 no aparece, el 1 ocurre 2 veces, el 3 ocurre 3 veces, el 4 ocurre 5 veces, …

Usando digitosPi, definir las siguientes funciones

   distribucionDigitosPi :: Int -> [Int]
   frecuenciaDigitosPi   :: Int -> [Double]

1 2	distribucionDigitosPi :: Int -> [Int] frecuenciaDigitosPi :: Int -> [Double]

tales que

(distribucionDigitosPi n) es la distribución de los n primeros dígitos de pi. Por ejemplo,

     λ> distribucionDigitosPi 10
     [0,2,1,2,1,2,1,0,0,1]
     λ> distribucionDigitosPi 100
     [8,8,12,12,10,8,9,8,12,13]
     λ> distribucionDigitosPi 1000
     [93,116,103,103,93,97,94,95,101,105]
     λ> distribucionDigitosPi 5000
     [466,531,496,460,508,525,513,488,492,521]

λ> distribucionDigitosPi 10

[0,2,1,2,1,2,1,0,0,1]

λ> distribucionDigitosPi 100

[8,8,12,12,10,8,9,8,12,13]

λ> distribucionDigitosPi 1000

[93,116,103,103,93,97,94,95,101,105]

λ> distribucionDigitosPi 5000

[466,531,496,460,508,525,513,488,492,521]

(frecuenciaDigitosPi n) es la frecuencia de los n primeros dígitos de pi. Por ejemplo,

   λ> frecuenciaDigitosPi 10
   [0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]
   λ> frecuenciaDigitosPi 100
   [8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]
   λ> frecuenciaDigitosPi 1000
   [9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]
   λ> frecuenciaDigitosPi 5000
   [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

λ> frecuenciaDigitosPi 10

[0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]

λ> frecuenciaDigitosPi 100

[8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]

λ> frecuenciaDigitosPi 1000

[9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]

λ> frecuenciaDigitosPi 5000

[9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

Soluciones

import Data.Array
import Data.List (group, sort)

digitosPi :: [Integer]
digitosPi = g(1,0,1,1,3,3) where
  g (q,r,t,k,n,l) = 
    if 4*q+r-t < n*t
    then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
    else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

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

distribucionDigitosPi :: Int -> [Int]
distribucionDigitosPi n =
    elems (accumArray (+) 0 (0,9) [(i,1)
                                  | i <- take n digitosPi]) 

frecuenciaDigitosPi :: Int -> [Double]
frecuenciaDigitosPi n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]
  where m = fromIntegral n

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

distribucionDigitosPi2 :: Int -> [Int]
distribucionDigitosPi2 n =
  [length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]
frecuenciaDigitosPi2 n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]
  where m = fromIntegral n

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

--    λ> last (take 5000 digitosPi)
--    2
--    (4.47 secs, 3,927,848,448 bytes)
--    λ> frecuenciaDigitosPi 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.01 secs, 0 bytes)
--    λ> frecuenciaDigitosPi2 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.02 secs, 0 bytes)

import Data.Array

import Data.List (group, sort)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

-- 1ª definición

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

distribucionDigitosPi :: Int -> [Int]

distribucionDigitosPi n =

elems (accumArray (+) 0 (0,9) [(i,1)

| i <- take n digitosPi])

frecuenciaDigitosPi :: Int -> [Double]

frecuenciaDigitosPi n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]

where m = fromIntegral n

-- 2ª definición

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

distribucionDigitosPi2 :: Int -> [Int]

distribucionDigitosPi2 n =

[length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]

frecuenciaDigitosPi2 n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]

where m = fromIntegral n

-- Comparación de eficiencia

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

-- λ> last (take 5000 digitosPi)

-- 2

-- (4.47 secs, 3,927,848,448 bytes)

-- λ> frecuenciaDigitosPi 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.01 secs, 0 bytes)

-- λ> frecuenciaDigitosPi2 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.02 secs, 0 bytes)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico