tail – Página 2 – Exercitium

Reconocimiento de conmutatividad

PorJosé A. Alonso 27-diciembre-20183-enero-2019

Para representar las operaciones binarias en un conjunto finito A con n elementos se pueden numerar sus elementos desde el 0 al n-1. Entonces cada operación binaria en A se puede ver como una lista de listas xss tal que el valor de aplicar la operación a los elementos i y j es el j-ésimo elemento del i-ésimo elemento de xss. Por ejemplo, si A = {0,1,2} entonces las tabla de la suma y de la resta módulo 3 en A son

   0 1 2    0 2 1
   1 2 0    1 0 2
   2 0 1    2 1 0
   Suma     Resta

0 1 2 0 2 1

1 2 0 1 0 2

2 0 1 2 1 0

Suma Resta

Definir la función

   conmutativa :: [[Int]] -> Bool

1	conmutativa :: [[Int]] -> Bool

tal que (conmutativa xss) se verifica si la operación cuya tabla es xss es conmutativa. Por ejemplo,

   conmutativa [[0,1,2],[1,0,1],[2,1,0]]  ==  True
   conmutativa [[0,1,2],[1,0,0],[2,1,0]]  ==  False
   conmutativa [[i+j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == True
   conmutativa [[i-j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == False

conmutativa [[0,1,2],[1,0,1],[2,1,0]] == True

conmutativa [[0,1,2],[1,0,0],[2,1,0]] == False

conmutativa [[i+j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == True

conmutativa [[i-j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == False

Soluciones

import Data.List (transpose)
import Test.QuickCheck

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

conmutativa :: [[Int]] -> Bool
conmutativa xss =
  and [producto i j == producto j i | i <- [0..n-1], j <- [0..n-1]]
  where producto i j = (xss !! i) !! j
        n            = length xss

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

conmutativa2 :: [[Int]] -> Bool
conmutativa2 []         = True
conmutativa2 t@(xs:xss) = xs == map head t
                          && conmutativa2 (map tail xss)

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

conmutativa3 :: [[Int]] -> Bool
conmutativa3 xss = xss == transpose xss

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

conmutativa4 :: [[Int]] -> Bool
conmutativa4 = (==) <*> transpose 

-- Equivalencia de las definiciones
-- ================================

-- Para comprobar la equivalencia se define el tipo de tabla de
-- operciones binarias:
newtype Tabla = T [[Int]]
  deriving Show

-- genTabla es un generador de tablas de operciones binaria. Por ejemplo,
--    λ> sample genTabla
--    T [[2,0,0],[1,2,1],[1,0,2]]
--    T [[0,3,0,1],[0,1,2,1],[0,2,1,2],[3,0,0,2]]
--    T [[2,0,1],[1,0,0],[2,1,2]]
--    T [[1,0],[0,1]]
--    T [[1,1],[0,1]]
--    T [[1,1,2],[1,0,1],[2,1,0]]
--    T [[4,4,3,0,2],[2,2,0,1,2],[4,0,1,0,0],[0,4,4,3,3],[3,0,4,2,1]]
--    T [[3,4,1,4,1],[2,4,4,0,4],[1,2,1,4,3],[3,1,4,4,2],[4,1,3,2,3]]
--    T [[2,0,1],[2,1,0],[0,2,2]]
--    T [[3,2,0,3],[2,1,1,1],[0,2,1,0],[3,3,2,3]]
--    T [[2,0,2,0],[0,0,3,1],[1,2,3,2],[3,3,0,2]]
genTabla :: Gen Tabla
genTabla = do
  n  <- choose (2,20)
  xs <- vectorOf (n^2) (elements [0..n-1])
  return (T (separa n xs))

-- (separa n xs) es la lista obtenidaseparando los elementos de xs en
-- grupos de n elementos. Por ejemplo,
--    separa 3 [1..9]  ==  [[1,2,3],[4,5,6],[7,8,9]]
separa :: Int -> [a] -> [[a]]
separa _ [] = []
separa n xs = take n xs : separa n (drop n xs)

-- Generación arbitraria de tablas
instance Arbitrary Tabla where
  arbitrary = genTabla

-- La propiedad es
prop_conmutativa :: Tabla -> Bool
prop_conmutativa (T xss) =
  conmutativa xss  == conmutativa2 xss &&
  conmutativa2 xss == conmutativa3 xss &&
  conmutativa2 xss == conmutativa4 xss

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

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

-- Para las comparaciones se usará la función tablaSuma tal que
-- (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por
-- ejemplo, 
--    tablaSuma 3  ==  [[0,1,2],[1,2,3],[2,3,4]]
tablaSuma ::  Int -> [[Int]]
tablaSuma n =
  [[i + j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]

-- La comparación es
--    λ> conmutativa (tablaSuma 400)
--    True
--    (1.92 secs, 147,608,696 bytes)
--    λ> conmutativa2 (tablaSuma 400)
--    True
--    (0.14 secs, 63,101,112 bytes)
--    λ> conmutativa3 (tablaSuma 400)
--    True
--    (0.10 secs, 64,302,608 bytes)
--    λ> conmutativa4 (tablaSuma 400)
--    True
--    (0.10 secs, 61,738,928 bytes)
--    
--    λ> conmutativa2 (tablaSuma 2000)
--    True
--    (1.81 secs, 1,569,390,480 bytes)
--    λ> conmutativa3 (tablaSuma 2000)
--    True
--    (3.07 secs, 1,601,006,840 bytes)
--    λ> conmutativa4 (tablaSuma 2000)
--    True
--    (3.14 secs, 1,536,971,288 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (transpose)

import Test.QuickCheck

-- 1ª solución

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

conmutativa :: [[Int]] -> Bool

conmutativa xss =

and [producto i j == producto j i | i <- [0..n-1], j <- [0..n-1]]

where producto i j = (xss !! i) !! j

n = length xss

-- 2ª solución

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

conmutativa2 :: [[Int]] -> Bool

conmutativa2 [] = True

conmutativa2 t@(xs:xss) = xs == map head t

&& conmutativa2 (map tail xss)

-- 3ª solución

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

conmutativa3 :: [[Int]] -> Bool

conmutativa3 xss = xss == transpose xss

-- 4ª solución

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

conmutativa4 :: [[Int]] -> Bool

conmutativa4 = (==) <*> transpose

-- Equivalencia de las definiciones

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

-- Para comprobar la equivalencia se define el tipo de tabla de

-- operciones binarias:

newtype Tabla = T [[Int]]

deriving Show

-- genTabla es un generador de tablas de operciones binaria. Por ejemplo,

-- λ> sample genTabla

-- T [[2,0,0],[1,2,1],[1,0,2]]

-- T [[0,3,0,1],[0,1,2,1],[0,2,1,2],[3,0,0,2]]

-- T [[2,0,1],[1,0,0],[2,1,2]]

-- T [[1,0],[0,1]]

-- T [[1,1],[0,1]]

-- T [[1,1,2],[1,0,1],[2,1,0]]

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

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

-- T [[2,0,1],[2,1,0],[0,2,2]]

-- T [[3,2,0,3],[2,1,1,1],[0,2,1,0],[3,3,2,3]]

-- T [[2,0,2,0],[0,0,3,1],[1,2,3,2],[3,3,0,2]]

genTabla :: Gen Tabla

genTabla = do

n <- choose (2,20)

xs <- vectorOf (n^2) (elements [0..n-1])

return (T (separa n xs))

-- (separa n xs) es la lista obtenidaseparando los elementos de xs en

-- grupos de n elementos. Por ejemplo,

-- separa 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]

separa :: Int -> [a] -> [[a]]

separa _ [] = []

separa n xs = take n xs : separa n (drop n xs)

-- Generación arbitraria de tablas

instance Arbitrary Tabla where

arbitrary = genTabla

-- La propiedad es

prop_conmutativa :: Tabla -> Bool

prop_conmutativa (T xss) =

conmutativa xss == conmutativa2 xss &&

conmutativa2 xss == conmutativa3 xss &&

conmutativa2 xss == conmutativa4 xss

-- La comprobación es

-- λ> quickCheck prop_conmutativa

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- Para las comparaciones se usará la función tablaSuma tal que

-- (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por

-- ejemplo,

-- tablaSuma 3 == [[0,1,2],[1,2,3],[2,3,4]]

tablaSuma :: Int -> [[Int]]

tablaSuma n =

[[i + j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]

-- La comparación es

-- λ> conmutativa (tablaSuma 400)

-- True

-- (1.92 secs, 147,608,696 bytes)

-- λ> conmutativa2 (tablaSuma 400)

-- True

-- (0.14 secs, 63,101,112 bytes)

-- λ> conmutativa3 (tablaSuma 400)

-- True

-- (0.10 secs, 64,302,608 bytes)

-- λ> conmutativa4 (tablaSuma 400)

-- True

-- (0.10 secs, 61,738,928 bytes)

-- λ> conmutativa2 (tablaSuma 2000)

-- True

-- (1.81 secs, 1,569,390,480 bytes)

-- λ> conmutativa3 (tablaSuma 2000)

-- True

-- (3.07 secs, 1,601,006,840 bytes)

-- λ> conmutativa4 (tablaSuma 2000)

-- True

-- (3.14 secs, 1,536,971,288 bytes)

Pensamiento

«Nuestras horas son minutos cuando esperamos saber, y siglos cuando
sabemos lo que se puede aprender.»

Antonio Machado

Intercambio de la primera y última columna de una matriz

PorJosé A. Alonso 17-diciembre-201824-diciembre-2018

Las matrices se pueden representar mediante listas de listas. Por ejemplo, la matriz

   8 9 7 6
   4 7 6 5
   3 2 1 8

8 9 7 6

4 7 6 5

3 2 1 8

se puede representar por la lista

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

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

Definir la función

   intercambia :: [[a]] -> [[a]]

1	intercambia :: [[a]] -> [[a]]

tal que (intercambia xss) es la matriz obtenida intercambiando la primera y la última columna de xss. Por ejemplo,

   λ> intercambia [[8,9,7,6],[4,7,6,5],[3,2,1,8]]
   [[6,9,7,8],[5,7,6,4],[8,2,1,3]]

1 2	λ> intercambia [[8,9,7,6],[4,7,6,5],[3,2,1,8]] [[6,9,7,8],[5,7,6,4],[8,2,1,3]]

Soluciones

intercambia :: [[a]] -> [[a]]
intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el
-- último elemento de xs. Por ejemplo,
--    intercambiaL [8,9,7,6]  ==  [6,9,7,8]
intercambiaL :: [a] -> [a]
intercambiaL xs =
  last xs : tail (init xs) ++ [head xs]

intercambia :: [[a]] -> [[a]]

intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el

-- último elemento de xs. Por ejemplo,

-- intercambiaL [8,9,7,6] == [6,9,7,8]

intercambiaL :: [a] -> [a]

intercambiaL xs =

last xs : tail (init xs) ++ [head xs]

Pensamiento

«¡Que difícil es,
cuando todo baja
no bajar también!»

Antonio Machado

Superación de límites

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

Una sucesión de puntuaciones se puede representar mediante una lista de números. Por ejemplo, [7,5,9,9,4,5,4,2,5,9,12,1]. En la lista anterior, los puntos en donde se alcanzan un nuevo máximo son 7, 9 y 12 (porque son mayores que todos sus anteriores) y en donde se alcanzan un nuevo mínimo son 7, 5, 4, 2 y 1 (porque son menores que todos sus anteriores). Por tanto, el máximo se ha superado 2 veces y el mínimo 4 veces.

Definir las funciones

   nuevosMaximos :: [Int] -> [Int]
   nuevosMinimos :: [Int] -> [Int]
   nRupturas     :: [Int] -> (Int,Int)

nuevosMaximos :: [Int] -> [Int]

nuevosMinimos :: [Int] -> [Int]

nRupturas :: [Int] -> (Int,Int)

tales que

(nuevosMaximos xs) es la lista de los nuevos máximos de xs. Por ejemplo,

     nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,9,12]

1	nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,9,12]

(nuevosMinimos xs) es la lista de los nuevos mínimos de xs. Por ejemplo,

     nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,5,4,2,1]

1	nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,5,4,2,1]

(nRupturas xs) es el par formado por el número de veces que se supera el máximo y el número de veces que se supera el mínimo en xs. Por ejemplo,

     nRupturas [7,5,9,9,4,5,4,2,5,9,12,1]  ==  (2,4)

1	nRupturas [7,5,9,9,4,5,4,2,5,9,12,1] == (2,4)

Soluciones

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]
nuevosMaximos xs = map head (group (map maximum xss))
  where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]
nuevosMinimos xs = map head (group (map minimum xss))
  where xss = tail (inits xs)

nRupturas :: [Int] -> (Int,Int)
nRupturas [] = (0,0)
nRupturas xs =
  ( length (nuevosMaximos xs) - 1
  , length (nuevosMinimos xs) - 1)

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]

nuevosMaximos xs = map head (group (map maximum xss))

where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]

nuevosMinimos xs = map head (group (map minimum xss))

where xss = tail (inits xs)

nRupturas :: [Int] -> (Int,Int)

nRupturas [] = (0,0)

nRupturas xs =

( length (nuevosMaximos xs) - 1

, length (nuevosMinimos xs) - 1)

Pensamiento

«Todo necio confunde valor y precio.» ~ Antonio Machado.

Elemento del árbol binario completo según su posición

PorJosé A. Alonso 6-diciembre-201817-enero-2019

Un árbol binario completo es un árbol binario que tiene todos los nodos posibles hasta el penúltimo nivel, y donde los elementos del último nivel están colocados de izquierda a derecha sin dejar huecos entre ellos.

La numeración de los árboles binarios completos se realiza a partir de la raíz, recorriendo los niveles de izquierda a derecha. Por ejemplo,

                  1
                 /  \
                /    \
               /      \
              2        3
             / \      / \
            4   5    6   7
           / \ 
          8   9

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

   data Arbol = H
              | N Integer Arbol Arbol
     deriving (Show, Eq)

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 9 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   elementoEnPosicion :: Posicion -> Integer

1	elementoEnPosicion :: Posicion -> Integer

tal que (elementoEnPosicion ms) es el elemento en la posición ms. Por ejemplo,

   elementoEnPosicion [D,I]    ==  6
   elementoEnPosicion [D,D]    ==  7
   elementoEnPosicion [I,I,D]  ==  9
   elementoEnPosicion []       ==  1

elementoEnPosicion [D,I] == 6

elementoEnPosicion [D,D] == 7

elementoEnPosicion [I,I,D] == 9

elementoEnPosicion [] == 1

Soluciones

import Test.QuickCheck

data Arbol = H
           | N Integer Arbol Arbol
  deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

elementoEnPosicion :: Posicion -> Integer
elementoEnPosicion ms =
  aux ms (arbolBinarioCompleto (2^(1 + length ms)))
  where aux []     (N x _ _) = x
        aux (I:ms) (N _ i _) = aux ms i
        aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n
-- nodos. Por ejemplo, 
--    λ> arbolBinarioCompleto 4
--    N 1 (N 2 (N 4 H H) H) (N 3 H H)
--    λ> pPrint (arbolBinarioCompleto 9)
--    N 1
--      (N 2
--         (N 4
--            (N 8 H H)
--            (N 9 H H))
--         (N 5 H H))
--      (N 3
--         (N 6 H H)
--         (N 7 H H))
arbolBinarioCompleto :: Integer -> Arbol
arbolBinarioCompleto n = aux 1
  where aux i | i <= n    = N i (aux (2*i)) (aux (2*i+1))
              | otherwise = H

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

elementoEnPosicion2 :: Posicion -> Integer
elementoEnPosicion2 = aux . reverse
  where aux []     = 1
        aux (I:ms) = 2 * aux ms
        aux (D:ms) = 2 * aux ms + 1

-- Equivalencia
-- ============

-- La propiedad es
prop_elementoEnPosicion_equiv :: Positive Integer -> Bool
prop_elementoEnPosicion_equiv (Positive n) =
  elementoEnPosicion  ps == n &&
  elementoEnPosicion2 ps == n 
  where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el
-- árbol binario completo. Por ejemplo,
--    posicionDeElemento 6  ==  [D,I]
--    posicionDeElemento 7  ==  [D,D]
--    posicionDeElemento 9  ==  [I,I,D]
--    posicionDeElemento 1  ==  []
posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  [f x | x <- tail (reverse (binario n))]
  where f 0 = I
        f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria
-- de n. Por ejemplo,
--    binario 11  ==  [1,1,0,1]
binario :: Integer -> [Integer]
binario n
  | n < 2     = [n]
  | otherwise = n `mod` 2 : binario (n `div` 2)

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

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

--    λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))
--    90310
--    (1.96 secs, 11,518,771,016 bytes)
--    λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))
--    90310
--    (14.32 secs, 11,508,181,176 bytes)

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

elementoEnPosicion :: Posicion -> Integer

elementoEnPosicion ms =

aux ms (arbolBinarioCompleto (2^(1 + length ms)))

where aux [] (N x _ _) = x

aux (I:ms) (N _ i _) = aux ms i

aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

-- N 1 (N 2 (N 4 H H) H) (N 3 H H)

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

where aux i | i <= n = N i (aux (2*i)) (aux (2*i+1))

| otherwise = H

-- 2ª solución

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

elementoEnPosicion2 :: Posicion -> Integer

elementoEnPosicion2 = aux . reverse

where aux [] = 1

aux (I:ms) = 2 * aux ms

aux (D:ms) = 2 * aux ms + 1

-- Equivalencia

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

-- La propiedad es

prop_elementoEnPosicion_equiv :: Positive Integer -> Bool

prop_elementoEnPosicion_equiv (Positive n) =

elementoEnPosicion ps == n &&

elementoEnPosicion2 ps == n

where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el

-- árbol binario completo. Por ejemplo,

-- posicionDeElemento 6 == [D,I]

-- posicionDeElemento 7 == [D,D]

-- posicionDeElemento 9 == [I,I,D]

-- posicionDeElemento 1 == []

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

[f x | x <- tail (reverse (binario n))]

where f 0 = I

f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria

-- de n. Por ejemplo,

-- binario 11 == [1,1,0,1]

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

| otherwise = n `mod` 2 : binario (n `div` 2)

-- La comprobación es

-- λ> quickCheck prop_elementoEnPosicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))

-- 90310

-- (1.96 secs, 11,518,771,016 bytes)

-- λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))

-- 90310

-- (14.32 secs, 11,508,181,176 bytes)

Pensamiento

Las más hondas palabras
del sabio nos enseñan
lo que el silbar del viento cuando sopla
o el sonar de las aguas cuando ruedan.

Antonio Machado

Posiciones en árboles binarios completos

PorJosé A. Alonso 5-diciembre-201819-enero-2019

La numeración de los árboles binarios completos se realiza a partir de la raíz, recorriendo los niveles de izquierda a derecha. Por ejemplo,

                  1
                 /  \
                /    \
               /      \
              2        3
             / \      / \
            4   5    6   7
           / \    
          8   9

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

   data Arbol = H
              | N Integer Arbol Arbol
     deriving (Show, Eq)

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 9 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   posicionDeElemento :: Integer -> Posicion

1	posicionDeElemento :: Integer -> Posicion

tal que (posicionDeElemento n) es la posición del elemento n en el árbol binario completo. Por ejemplo,

   posicionDeElemento 6  ==  [D,I]
   posicionDeElemento 7  ==  [D,D]
   posicionDeElemento 9  ==  [I,I,D]
   posicionDeElemento 1  ==  []

   length (posicionDeElemento (10^50000))  ==  166096

posicionDeElemento 6 == [D,I]

posicionDeElemento 7 == [D,D]

posicionDeElemento 9 == [I,I,D]

posicionDeElemento 1 == []

length (posicionDeElemento (10^50000)) == 166096

Soluciones

import Test.QuickCheck

data Arbol = H
           | N Integer Arbol Arbol
  deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  head (posiciones n (arbolBinarioCompleto n))

-- (arbolBinarioCompleto n) es el árbol binario completo con n
-- nodos. Por ejemplo, 
--    λ> arbolBinarioCompleto 4
--    N 1 (N 2 (N 4 H H) H) (N 3 H H)
--    λ> pPrint (arbolBinarioCompleto 9)
--    N 1
--      (N 2
--         (N 4
--            (N 8 H H)
--            (N 9 H H))
--         (N 5 H H))
--      (N 3
--         (N 6 H H)
--         (N 7 H H))
arbolBinarioCompleto :: Integer -> Arbol
arbolBinarioCompleto n = aux 1
  where aux i | i <= n    = N i (aux (2*i)) (aux (2*i+1))
              | otherwise = H

-- (posiciones n a) es la lista de las posiciones del elemento n
-- en el árbol a. Por ejemplo,
--    posiciones 9 (arbolBinarioCompleto 9)  ==  [[I,I,D]]
posiciones :: Integer -> Arbol -> [Posicion]
posiciones n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++ ps
                           | otherwise = ps
          where ps = map (I:) (aux n i cs) ++
                     map (D:) (aux n d cs)

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

posicionDeElemento2 :: Integer -> Posicion
posicionDeElemento2 1 = []
posicionDeElemento2 n
  | even n    = posicionDeElemento2 (n `div` 2) ++ [I]
  | otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

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

posicionDeElemento3 :: Integer -> Posicion
posicionDeElemento3 = reverse . aux
  where aux 1 = []
        aux n | even n    = I : aux (n `div` 2) 
              | otherwise = D : aux (n `div` 2) 

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

posicionDeElemento4 :: Integer -> Posicion
posicionDeElemento4 n =
  [f x | x <- tail (reverse (binario n))]
  where f 0 = I
        f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria
-- de n. Por ejemplo,
--    binario 11  ==  [1,1,0,1]
binario :: Integer -> [Integer]
binario n
  | n < 2     = [n]
  | otherwise = n `mod` 2 : binario (n `div` 2)

-- Equivalencia
-- ============

-- La propiedad es
prop_posicionDeElemento_equiv :: Positive Integer -> Bool
prop_posicionDeElemento_equiv (Positive n) =
  posicionDeElemento n == posicionDeElemento2 n &&
  posicionDeElemento n == posicionDeElemento3 n &&
  posicionDeElemento n == posicionDeElemento4 n

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

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

--    λ> posicionDeElemento (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (5.72 secs, 3,274,535,328 bytes)
--    λ> posicionDeElemento2 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 189,560 bytes)
--    λ> posicionDeElemento3 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 180,728 bytes)
--    λ> posicionDeElemento4 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 184,224 bytes)
--    
--    λ> length (posicionDeElemento2 (10^4000))
--    13287
--    (2.80 secs, 7,672,011,280 bytes)
--    λ> length (posicionDeElemento3 (10^4000))
--    13287
--    (0.03 secs, 19,828,744 bytes)
--    λ> length (posicionDeElemento4 (10^4000))
--    13287
--    (0.03 secs, 18,231,536 bytes)
--    
--    λ> length (posicionDeElemento3 (10^50000))
--    166096
--    (1.34 secs, 1,832,738,136 bytes)
--    λ> length (posicionDeElemento4 (10^50000))
--    166096
--    (1.70 secs, 1,812,806,080 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

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

head (posiciones n (arbolBinarioCompleto n))

-- (arbolBinarioCompleto n) es el árbol binario completo con n

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

-- N 1 (N 2 (N 4 H H) H) (N 3 H H)

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

where aux i | i <= n = N i (aux (2*i)) (aux (2*i+1))

| otherwise = H

-- (posiciones n a) es la lista de las posiciones del elemento n

-- en el árbol a. Por ejemplo,

-- posiciones 9 (arbolBinarioCompleto 9) == [[I,I,D]]

posiciones :: Integer -> Arbol -> [Posicion]

posiciones n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++ ps

| otherwise = ps

where ps = map (I:) (aux n i cs) ++

map (D:) (aux n d cs)

-- 2ª solución

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

posicionDeElemento2 :: Integer -> Posicion

posicionDeElemento2 1 = []

posicionDeElemento2 n

| even n = posicionDeElemento2 (n `div` 2) ++ [I]

| otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

-- 3ª solución

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

posicionDeElemento3 :: Integer -> Posicion

posicionDeElemento3 = reverse . aux

where aux 1 = []

aux n | even n = I : aux (n `div` 2)

| otherwise = D : aux (n `div` 2)

-- 4ª solución

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

posicionDeElemento4 :: Integer -> Posicion

posicionDeElemento4 n =

[f x | x <- tail (reverse (binario n))]

where f 0 = I

f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria

-- de n. Por ejemplo,

-- binario 11 == [1,1,0,1]

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

| otherwise = n `mod` 2 : binario (n `div` 2)

-- Equivalencia

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

-- La propiedad es

prop_posicionDeElemento_equiv :: Positive Integer -> Bool

prop_posicionDeElemento_equiv (Positive n) =

posicionDeElemento n == posicionDeElemento2 n &&

posicionDeElemento n == posicionDeElemento3 n &&

posicionDeElemento n == posicionDeElemento4 n

-- La comprobación es

-- λ> quickCheck prop_posicionDeElemento_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> posicionDeElemento (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (5.72 secs, 3,274,535,328 bytes)

-- λ> posicionDeElemento2 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 189,560 bytes)

-- λ> posicionDeElemento3 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 180,728 bytes)

-- λ> posicionDeElemento4 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 184,224 bytes)

-- λ> length (posicionDeElemento2 (10^4000))

-- 13287

-- (2.80 secs, 7,672,011,280 bytes)

-- λ> length (posicionDeElemento3 (10^4000))

-- 13287

-- (0.03 secs, 19,828,744 bytes)

-- λ> length (posicionDeElemento4 (10^4000))

-- 13287

-- (0.03 secs, 18,231,536 bytes)

-- λ> length (posicionDeElemento3 (10^50000))

-- 166096

-- (1.34 secs, 1,832,738,136 bytes)

-- λ> length (posicionDeElemento4 (10^50000))

-- 166096

-- (1.70 secs, 1,812,806,080 bytes)

Pensamiento

El ojo que ves no es
ojo porque tú lo veas;
es ojo porque te ve.

Antonio Machado

Números primos sumas de dos primos

PorJosé A. Alonso 26-noviembre-201819-enero-2019

Definir las funciones

   esPrimoSumaDeDosPrimos :: Integer -> Bool

1	esPrimoSumaDeDosPrimos :: Integer -> Bool

primosSumaDeDosPrimos :: [Integer]
tales que

(esPrimoSumaDeDosPrimos x) se verifica si x es un número primo que se puede escribir como la suma de dos números primos. Por ejemplo,

     esPrimoSumaDeDosPrimos 19        ==  True
     esPrimoSumaDeDosPrimos 20        ==  False
     esPrimoSumaDeDosPrimos 23        ==  False
     esPrimoSumaDeDosPrimos 18409541  ==  False

esPrimoSumaDeDosPrimos 19 == True

esPrimoSumaDeDosPrimos 20 == False

esPrimoSumaDeDosPrimos 23 == False

esPrimoSumaDeDosPrimos 18409541 == False

primosSumaDeDosPrimos es la lista de los números primos que se pueden escribir como la suma de dos números primos. Por ejemplo,

     λ> take 17 primosSumaDeDosPrimos
     [5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]
     λ> primosSumaDeDosPrimos !! (10^5)
     18409543

λ> take 17 primosSumaDeDosPrimos

[5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]

λ> primosSumaDeDosPrimos !! (10^5)

18409543

Soluciones

import Data.Numbers.Primes (isPrime, primes)

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

esPrimoSumaDeDosPrimos :: Integer -> Bool
esPrimoSumaDeDosPrimos x =
  isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]
primosSumaDeDosPrimos =
  [x | x <- primes
     , isPrime (x - 2)]

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

primosSumaDeDosPrimos2 :: [Integer]
primosSumaDeDosPrimos2 =
  [y | (x,y) <- zip primes (tail primes)
     , y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool
esPrimoSumaDeDosPrimos2 x = 
  x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias
-- =============

-- Equivalencia de esPrimoSumaDeDosPrimos
prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property
prop_esPrimoSumaDeDosPrimos_equiv x =
  x > 0 ==>
  esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

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

-- Equivalencia de primosSumaDeDosPrimos
prop_primosSumaDeDosPrimos_equiv :: Int -> Property
prop_primosSumaDeDosPrimos_equiv n =
  n >= 0 ==>
  primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

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

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

--    λ> primosSumaDeDosPrimos !! (10^4)
--    1261081
--    (2.07 secs, 4,540,085,256 bytes)
--
-- Se recarga para evitar memorización    
--    λ> primosSumaDeDosPrimos2 !! (10^4)
--    1261081
--    (0.49 secs, 910,718,408 bytes)

import Data.Numbers.Primes (isPrime, primes)

-- 1ª solución

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

esPrimoSumaDeDosPrimos :: Integer -> Bool

esPrimoSumaDeDosPrimos x =

isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]

primosSumaDeDosPrimos =

[x | x <- primes

, isPrime (x - 2)]

-- 2ª solución

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

primosSumaDeDosPrimos2 :: [Integer]

primosSumaDeDosPrimos2 =

[y | (x,y) <- zip primes (tail primes)

, y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool

esPrimoSumaDeDosPrimos2 x =

x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias

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

-- Equivalencia de esPrimoSumaDeDosPrimos

prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property

prop_esPrimoSumaDeDosPrimos_equiv x =

x > 0 ==>

esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

-- La comprobación es

-- λ> quickCheck prop_esPrimoSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Equivalencia de primosSumaDeDosPrimos

prop_primosSumaDeDosPrimos_equiv :: Int -> Property

prop_primosSumaDeDosPrimos_equiv n =

n >= 0 ==>

primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

-- La comprobación es

-- λ> quickCheck prop_primosSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> primosSumaDeDosPrimos !! (10^4)

-- 1261081

-- (2.07 secs, 4,540,085,256 bytes)

-- Se recarga para evitar memorización

-- λ> primosSumaDeDosPrimos2 !! (10^4)

-- 1261081

-- (0.49 secs, 910,718,408 bytes)

Pensamiento

Sed incompresivos; yo os aconsejo la incomprensión, aunque sólo sea para destripar los chistes de los tontos.

Antonio Machado

Sucesión fractal

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

La sucesión fractal

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

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

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

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

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

los términos impares forman la misma sucesión original

     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

1 2	sucFractal :: [Integer] sumaSucFractal :: Integer -> Integer

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      == 13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

[schedule expon=’2018-06-19′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 17 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

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

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

sucFractal1 :: [Integer]
sucFractal1 = 
  map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
  | even n    = n `div` 2
  | otherwise = termino (n `div` 2)

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

sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
  x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

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

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
  sum (map termino [0..n-1])

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

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)

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

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
  | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
  | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
  where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla (x:xs) (y:ys) =

x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

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

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Referencia

+ [Fractal sequences and restricted Nim](http://bit.ly/1WX1IjB) por Lionel Levine.
[/schedule]

La regla de los signos de Descartes

PorJosé A. Alonso 30-mayo-20186-junio-2018

Los polinomios pueden representarse mediante listas. Por ejemplo, el polinomio x^5+3x^4-5x^2+x-7 se representa por [1,3,0,-5,1,-7]. En dicha lista, obviando el cero, se producen tres cambios de signo: del 3 al -5, del -5 al 1 y del 1 al -7. Llamando C(p) al número de cambios de signo en la lista de coeficientes del polinomio p(x), tendríamos entonces que en este caso C(p)=3.

La regla de los signos de Descartes dice que el número de raíces reales positivas de una ecuación polinómica con coeficientes reales igualada a cero es, como mucho, igual al número de cambios de signo que se produzcan entre sus coeficientes (obviando los ceros). Por ejemplo, en el caso anterior la ecuación tendría como mucho tres soluciones reales positivas, ya que C(p)=3.

Además, si la cota C(p) no se alcanza, entonces el número de raíces positivas de la ecuación difiere de ella un múltiplo de dos. En el ejemplo anterior esto significa que la ecuación puede tener tres raíces positivas o tener solamente una, pero no podría ocurrir que tuviera dos o que no tuviera ninguna.

Definir las funciones

   cambios :: [Int] -> [(Int,Int)]
   nRaicesPositivas :: [Int] -> [Int]

1 2	cambios :: [Int] -> [(Int,Int)] nRaicesPositivas :: [Int] -> [Int]

tales que

(cambios xs) es la lista de los pares de elementos de xs con signos distintos, obviando los ceros. Por ejemplo,

     cambios [1,3,0,-5,1,-7]  ==  [(3,-5),(-5,1),(1,-7)]

1	cambios [1,3,0,-5,1,-7] == [(3,-5),(-5,1),(1,-7)]

(nRaicesPositivas p) es la lista de los posibles números de raíces positivas del polinomio p (representado mediante una lista) según la regla de los signos de Descartes. Por ejemplo,

     nRaicesPositivas [1,3,0,-5,1,-7]  ==  [3,1]

1	nRaicesPositivas [1,3,0,-5,1,-7] == [3,1]

que significa que la ecuación x^5+3x^4-5x^2+x-7=0 puede tener 3 ó 1 raíz positiva.

Soluciones

-- 1ª definición (por comprensión)
-- ===============================

cambios1 :: [Int] -> [(Int,Int)]
cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]
  where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero. 
-- Por ejemplo,  
--    noCeros [1,3,0,-5,1,-7]  ==  [1,3,-5,1,-7]
noCeros :: [Int] -> [Int]
noCeros = filter (/=0)

-- 2ª definición (por recursión)
-- =============================

cambios2 :: [Int] -> [(Int,Int)]
cambios2 xs = cambios2' (noCeros xs)
  where cambios2' (x:y:xs)
          | x*y < 0   = (x,y) : cambios2' (y:xs)
          | otherwise = cambios2' (y:xs)
        cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]
nRaicesPositivas xs = [n,n-2..0]
  where n = length (cambios1 xs)

-- 1ª definición (por comprensión)

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

cambios1 :: [Int] -> [(Int,Int)]

cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]

where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero.

-- Por ejemplo,

-- noCeros [1,3,0,-5,1,-7] == [1,3,-5,1,-7]

noCeros :: [Int] -> [Int]

noCeros = filter (/=0)

-- 2ª definición (por recursión)

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

cambios2 :: [Int] -> [(Int,Int)]

cambios2 xs = cambios2' (noCeros xs)

where cambios2' (x:y:xs)

| x*y < 0 = (x,y) : cambios2' (y:xs)

| otherwise = cambios2' (y:xs)

cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]

nRaicesPositivas xs = [n,n-2..0]

where n = length (cambios1 xs)

Caminos reducidos

PorJosé A. Alonso 25-mayo-201825-abril-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [S,S,S,N,N,N] == []

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (2.17 secs, 379049224 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (2.17 secs, 379049224 bytes)

Polinomios de Fibonacci

PorJosé A. Alonso 21-mayo-201828-mayo-2018

La sucesión de polinomios de Fibonacci se define por

   p(0) = 0
   p(1) = 1
   p(n) = x*p(n-1) + p(n-2)

p(0) = 0

p(1) = 1

p(n) = x*p(n-1) + p(n-2)

Los primeros términos de la sucesión son

   p(2) = x
   p(3) = x^2 + 1
   p(4) = x^3 + 2*x
   p(5) = x^4 + 3*x^2 + 1

p(2) = x

p(3) = x^2 + 1

p(4) = x^3 + 2*x

p(5) = x^4 + 3*x^2 + 1

Definir la lista

   sucPolFib :: [Polinomio Integer]

1	sucPolFib :: [Polinomio Integer]

tal que sus elementos son los polinomios de Fibonacci. Por ejemplo,

   λ> take 7 sucPolFib
   [0,1,1*x,x^2 + 1,x^3 + 2*x,x^4 + 3*x^2 + 1,x^5 + 4*x^3 + 3*x]
   λ> sum (map grado (take 3000 sucPolFib2))
   4495501

λ> take 7 sucPolFib

[0,1,1*x,x^2 + 1,x^3 + 2*x,x^4 + 3*x^2 + 1,x^5 + 4*x^3 + 3*x]

λ> sum (map grado (take 3000 sucPolFib2))

4495501

Comprobar con QuickCheck que el valor del n-ésimo término de sucPolFib para x=1 es el n-ésimo término de la sucesión de Fibonacci 0, 1, 1, 2, 3, 5, 8, …

Nota. Limitar la búsqueda a ejemplos pequeños usando

   quickCheckWith (stdArgs {maxSize=5}) prop_polFib

1	quickCheckWith (stdArgs {maxSize=5}) prop_polFib

Soluciones

import Data.List (genericIndex)
import I1M.PolOperaciones
import Test.QuickCheck

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

sucPolFib :: [Polinomio Integer]
sucPolFib = [polFibR n | n <- [0..]]

polFibR :: Integer -> Polinomio Integer
polFibR 0 = polCero
polFibR 1 = polUnidad
polFibR n = 
  sumaPol (multPol (consPol 1 1 polCero) (polFibR (n-1)))
          (polFibR (n-2))

-- 2ª definición (dinámica)
-- ========================

sucPolFib2 :: [Polinomio Integer]
sucPolFib2 = 
  polCero : polUnidad : zipWith f (tail sucPolFib2) sucPolFib2
  where f p = sumaPol (multPol (consPol 1 1 polCero) p)

-- La propiedad es
prop_polFib :: Integer -> Property
prop_polFib n = 
    n >= 0 ==> valor (polFib n) 1 == fib n
    where polFib n = sucPolFib2 `genericIndex` n
          fib n    = fibs `genericIndex` n

fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=5}) prop_polFib
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import I1M.PolOperaciones

import Test.QuickCheck

-- 1ª solución

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

sucPolFib :: [Polinomio Integer]

sucPolFib = [polFibR n | n <- [0..]]

polFibR :: Integer -> Polinomio Integer

polFibR 0 = polCero

polFibR 1 = polUnidad

polFibR n =

sumaPol (multPol (consPol 1 1 polCero) (polFibR (n-1)))

(polFibR (n-2))

-- 2ª definición (dinámica)

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

sucPolFib2 :: [Polinomio Integer]

sucPolFib2 =

polCero : polUnidad : zipWith f (tail sucPolFib2) sucPolFib2

where f p = sumaPol (multPol (consPol 1 1 polCero) p)

-- La propiedad es

prop_polFib :: Integer -> Property

prop_polFib n =

n >= 0 ==> valor (polFib n) 1 == fib n

where polFib n = sucPolFib2 `genericIndex` n

fib n = fibs `genericIndex` n

fibs :: [Integer]

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

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=5}) prop_polFib

-- +++ OK, passed 100 tests.

Números compuestos por un conjunto de primos

PorJosé A. Alonso 20-abril-201830-abril-2018

Los números compuestos por un conjunto de primos son los números cuyos factores primos pertenecen al conjunto. Por ejemplo, los primeros números compuestos por [2,5,7] son

   1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

1	1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

El 28 es compuesto ya que sus divisores primos son 2 y 7 que están en [2,5,7].

Definir la función

   compuestos :: [Integer] -> [Integer]

1	compuestos :: [Integer] -> [Integer]

tal que (compuesto ps) es la lista de los números compuestos por el conjunto de primos ps. Por ejemplo,

   λ> take 20 (compuestos [2,5,7])
   [1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]
   λ> take 20 (compuestos [2,5])
   [1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]
   λ> take 20 (compuestos [2,3,5])
   [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]
   λ> take 20 (compuestos [3,5,7,11,13])
   [1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]
   λ> take 15 (compuestos [2])
   [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]
   λ> compuestos [2,7] !! (10^4)
   57399514149595471961908157955229677377312712667508119466382354072731648
   λ> compuestos [2,3,5] !! (10^5)
   290237644800000000000000000000000000000

λ> take 20 (compuestos [2,5,7])

[1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]

λ> take 20 (compuestos [2,5])

[1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]

λ> take 20 (compuestos [2,3,5])

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

λ> take 20 (compuestos [3,5,7,11,13])

[1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]

λ> take 15 (compuestos [2])

[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]

λ> compuestos [2,7] !! (10^4)

57399514149595471961908157955229677377312712667508119466382354072731648

λ> compuestos [2,3,5] !! (10^5)

290237644800000000000000000000000000000

Soluciones

import Data.Numbers.Primes (primeFactors)

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

compuestos1 :: [Integer] -> [Integer]
compuestos1 ps =
  [n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen
-- a ps. Por ejemplo, 
--    esCompuesto [2,3,7]    28  ==  True
--    esCompuesto [2,3,7]   140  ==  False
--    esCompuesto [2,3,5,7] 140  ==  True
esCompuesto :: [Integer] -> Integer -> Bool
esCompuesto ps n =
  subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs
-- pertenecen a ys. Por ejemplo, 
--    subconjunto [2,7,2] [7,5,2]  ==  True
--    subconjunto [2,7,3] [7,5,2]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

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

compuestos2 :: [Integer] -> [Integer]
compuestos2 ps =
   1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de
-- ps por los números compuestos con ps. Por ejemplo,
--    λ> take 8 (compuestos4 [2,5,7])
--    [1,2,4,5,7,8,10,14]
--    λ> map (take 6) (combinaciones [2,5,7])
--    [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]
combinaciones :: [Integer] -> [[Integer]]
combinaciones ps =
  [[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo, 
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: [[Integer]] -> [Integer]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista
-- ordenadas xs e ys. Por ejemplo,  
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla []     ys              = ys
mezcla xs     []              = xs
mezcla us@(x:xs) vs@(y:ys) | x == y     = x : mezcla xs ys
                           | x < y      = x : mezcla xs vs
                           | otherwise  = y : mezcla us ys

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

compuestos3 :: [Integer] -> [Integer]
compuestos3 [] = [1]
compuestos3 (p:ps) =
  mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

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

compuestos4 :: [Integer] -> [Integer]
compuestos4 ps = foldl aux xs (tail ps)
  where p        = head ps
        xs       = [p^k | k <- [0..]]
        aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución
-- ===========

compuestos5 :: [Integer] -> [Integer]
compuestos5 = foldl aux [1] 
  where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución
-- ===========

compuestos6 :: [Integer] -> [Integer]
compuestos6 xs = aux
  where aux = 1 : mezclas xs aux
        mezclas []     _  = []
        mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

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

--    λ> compuestos1 [2,3,5] !! 300
--    84375
--    (5.85 secs, 2,961,101,088 bytes)
--    λ> compuestos2 [2,3,5] !! 300
--    84375
--    (3.54 secs, 311,137,952 bytes)
--    λ> compuestos2 [2,3,5] !! 400
--    312500
--    (13.01 secs, 1,229,801,184 bytes)
--    λ> compuestos3 [2,3,5] !! 400
--    312500
--    (0.02 secs, 2,066,152 bytes)
--    λ> compuestos3 [2,3,5] !! 20000
--    15441834907098675000000
--    (1.57 secs, 203,061,864 bytes)
--    λ> compuestos4 [2,3,5] !! 20000
--    15441834907098675000000
--    (0.40 secs, 53,335,080 bytes)
--    λ> compuestos4 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.25 secs, 170,058,496 bytes)
--    λ> compuestos5 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.26 secs, 170,104,648 bytes)
--    λ> compuestos6 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (0.26 secs, 40,490,280 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

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

compuestos1 :: [Integer] -> [Integer]

compuestos1 ps =

[n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen

-- a ps. Por ejemplo,

-- esCompuesto [2,3,7] 28 == True

-- esCompuesto [2,3,7] 140 == False

-- esCompuesto [2,3,5,7] 140 == True

esCompuesto :: [Integer] -> Integer -> Bool

esCompuesto ps n =

subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs

-- pertenecen a ys. Por ejemplo,

-- subconjunto [2,7,2] [7,5,2] == True

-- subconjunto [2,7,3] [7,5,2] == False

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

subconjunto xs ys =

all (`elem` ys) xs

-- 2ª solución

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

compuestos2 :: [Integer] -> [Integer]

compuestos2 ps =

1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de

-- ps por los números compuestos con ps. Por ejemplo,

-- λ> take 8 (compuestos4 [2,5,7])

-- [1,2,4,5,7,8,10,14]

-- λ> map (take 6) (combinaciones [2,5,7])

-- [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]

combinaciones :: [Integer] -> [[Integer]]

combinaciones ps =

[[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

-- [2,3,4,5,6,7,8,9,10,11]

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

mezclaTodas :: [[Integer]] -> [Integer]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista

-- ordenadas xs e ys. Por ejemplo,

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla [] ys = ys

mezcla xs [] = xs

mezcla us@(x:xs) vs@(y:ys) | x == y = x : mezcla xs ys

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª solución

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

compuestos3 :: [Integer] -> [Integer]

compuestos3 [] = [1]

compuestos3 (p:ps) =

mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución

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

compuestos4 :: [Integer] -> [Integer]

compuestos4 ps = foldl aux xs (tail ps)

where p = head ps

xs = [p^k | k <- [0..]]

aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución

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

compuestos5 :: [Integer] -> [Integer]

compuestos5 = foldl aux [1]

where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución

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

compuestos6 :: [Integer] -> [Integer]

compuestos6 xs = aux

where aux = 1 : mezclas xs aux

mezclas [] _ = []

mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

-- Comparación de eficiencia

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

-- λ> compuestos1 [2,3,5] !! 300

-- 84375

-- (5.85 secs, 2,961,101,088 bytes)

-- λ> compuestos2 [2,3,5] !! 300

-- 84375

-- (3.54 secs, 311,137,952 bytes)

-- λ> compuestos2 [2,3,5] !! 400

-- 312500

-- (13.01 secs, 1,229,801,184 bytes)

-- λ> compuestos3 [2,3,5] !! 400

-- 312500

-- (0.02 secs, 2,066,152 bytes)

-- λ> compuestos3 [2,3,5] !! 20000

-- 15441834907098675000000

-- (1.57 secs, 203,061,864 bytes)

-- λ> compuestos4 [2,3,5] !! 20000

-- 15441834907098675000000

-- (0.40 secs, 53,335,080 bytes)

-- λ> compuestos4 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.25 secs, 170,058,496 bytes)

-- λ> compuestos5 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.26 secs, 170,104,648 bytes)

-- λ> compuestos6 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (0.26 secs, 40,490,280 bytes)

Notas de evaluación acumulada

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

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Números tetranacci

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

Los números tetranacci son una generalización de los números de Fibonacci definidos por

   T(0) = 0,
   T(1) = 1,
   T(2) = 1,
   T(3) = 2, 
   T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

T(0) = 0,

T(1) = 1,

T(2) = 1,

T(3) = 2,

T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

Los primeros números tetranacci son

   0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

1	0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

Definir las funciones

   tetranacci        :: Int -> Integer
   graficaTetranacci :: Int -> IO ()

1 2	tetranacci :: Int -> Integer graficaTetranacci :: Int -> IO ()

tales que

(tetranacci n) es el n-ésimo número tetranacci. Por ejemplo,

     λ> tetranacci 10
     208
     λ> map tetranacci [0..10]
     [0,1,1,2,4,8,15,29,56,108,208]
     λ> length (show (tetranacci5 (10^5)))
     28501

λ> tetranacci 10

208

λ> map tetranacci [0..10]

[0,1,1,2,4,8,15,29,56,108,208]

λ> length (show (tetranacci5 (10^5)))

28501

(graficaTetranacci n) dibuja la gráfica de los cocientes de n primeros pares de número tetranacci. Por ejemplo, (graficaTetranacci 300) dibuja

Soluciones

import Data.List (zipWith4)
import Data.Array
import Graphics.Gnuplot.Simple

-- 1ª solución (por recursión) 
-- ===========================

tetranacci :: Int -> Integer
tetranacci 0 = 0
tetranacci 1 = 1
tetranacci 2 = 1
tetranacci 3 = 2
tetranacci n =
  tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4) 

-- 2ª solución (programación dinámica con zipWith4)
-- ================================================

tetranacci2 :: Int -> Integer
tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]
tetranaccis2 = 
    0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)
    where f a b c d = a+b+c+d
          r n       = drop n tetranaccis2

-- 3ª solución (con acumuladores)
-- ==============================

tetranacci3 :: Int -> Integer
tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]
tetranaccis3 = p (0, 1, 1, 2)
    where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

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

tetranacci4 :: Int -> Integer
tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]
tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4
   where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

-- 5ª solución (programación dinámica con vectores)
-- ================================================

tetranacci5 :: Int -> Integer
tetranacci5 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 0
  f 1 = 1
  f 2 = 1
  f 3 = 2
  f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4) 

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

--    λ> tetranacci 26
--    7555935
--    (3.04 secs, 1,649,520,064 bytes)
--    λ> tetranacci2 26
--    7555935
--    (0.00 secs, 148,064 bytes)
-- 
--    λ> length (show (tetranacci2 (10^5)))
--    28501
--    (1.22 secs, 1,844,457,288 bytes)
--    λ> length (show (tetranacci3 (10^5)))
--    28501
--    (0.88 secs, 1,860,453,968 bytes)
--    λ> length (show (tetranacci4 (10^5)))
--    28501
--    (0.77 secs, 1,882,852,168 bytes)
--    λ> length (show (tetranacci5 (10^5)))
--    28501
--    (0.72 secs, 1,905,707,408 bytes)

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

graficaTetranacci :: Int -> IO ()
graficaTetranacci n =
  plotList [ Key Nothing
           , Title "Tasa de crecimiento de los numeros tetranacci"
           , PNG ("Numeros_tetranacci_" ++ show n ++ ".png")
           ]
           (take n (zipWith (/) (tail xs) xs))
  where xs = (map fromIntegral tetranaccis4) :: [Double]

import Data.List (zipWith4)

import Data.Array

import Graphics.Gnuplot.Simple

-- 1ª solución (por recursión)

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

tetranacci :: Int -> Integer

tetranacci 0 = 0

tetranacci 1 = 1

tetranacci 2 = 1

tetranacci 3 = 2

tetranacci n =

tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4)

-- 2ª solución (programación dinámica con zipWith4)

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

tetranacci2 :: Int -> Integer

tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]

tetranaccis2 =

0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)

where f a b c d = a+b+c+d

r n = drop n tetranaccis2

-- 3ª solución (con acumuladores)

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

tetranacci3 :: Int -> Integer

tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]

tetranaccis3 = p (0, 1, 1, 2)

where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

-- 4ª solución

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

tetranacci4 :: Int -> Integer

tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]

tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4

where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

-- 5ª solución (programación dinámica con vectores)

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

tetranacci5 :: Int -> Integer

tetranacci5 n = v ! n where

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

f 0 = 0

f 1 = 1

f 2 = 1

f 3 = 2

f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia

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

-- λ> tetranacci 26

-- 7555935

-- (3.04 secs, 1,649,520,064 bytes)

-- λ> tetranacci2 26

-- 7555935

-- (0.00 secs, 148,064 bytes)

-- λ> length (show (tetranacci2 (10^5)))

-- 28501

-- (1.22 secs, 1,844,457,288 bytes)

-- λ> length (show (tetranacci3 (10^5)))

-- 28501

-- (0.88 secs, 1,860,453,968 bytes)

-- λ> length (show (tetranacci4 (10^5)))

-- 28501

-- (0.77 secs, 1,882,852,168 bytes)

-- λ> length (show (tetranacci5 (10^5)))

-- 28501

-- (0.72 secs, 1,905,707,408 bytes)

-- Gráfica

-- =======

graficaTetranacci :: Int -> IO ()

graficaTetranacci n =

plotList [ Key Nothing

, Title "Tasa de crecimiento de los numeros tetranacci"

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

]

(take n (zipWith (/) (tail xs) xs))

where xs = (map fromIntegral tetranaccis4) :: [Double]

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.

La conjetura de Gilbreath

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

Partiendo de los 5 primeros números primos y calculando el valor absoluto de la diferencia de cada dos números consecutivos hasta quedarse con un único número se obtiene la siguiente tabla:

   2, 3, 5, 7, 11
   1, 2, 2, 4 
   1, 0, 2
   1, 2 
   1

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

Se observa que todas las filas, salvo la inicial, comienzan con el número 1.

Repitiendo el proceso pero empezando con los 8 primeros números primos se obtiene la siguiente tabla:

   2, 3, 5, 7, 11, 13, 17, 19 
   1, 2, 2, 4,  2,  4,  2  
   1, 0, 2, 2,  2,  2 
   1, 2, 0, 0,  0 
   1, 2, 0, 0 
   1, 2, 0 
   1, 2 
   1

2, 3, 5, 7, 11, 13, 17, 19

1, 2, 2, 4, 2, 4, 2

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

Se observa que, de nuevo, todas las filas, salvo la inicial, comienza con el número 1.

La conjetura de Gilbreath afirma que si escribimos la sucesión de números primos completa y después construimos las correspondientes sucesiones formadas por el valor absoluto de la resta de cada pareja de números consecutivos, entonces todas esas filas que obtenemos comienzan siempre por 1.

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

Para la representación, usaremos la simétrica de la que hemos comentado anteriormente; es decir,

    2
    3, 1
    5, 2, 1
    7, 2, 0, 1
   11, 4, 2, 2, 1
   13, 2, 2, 0, 2, 1
   17, 4, 2, 0, 0, 2, 1
   19, 2, 2, 0, 0, 0, 2, 1

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

17, 4, 2, 0, 0, 2, 1

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

en la que la primera columna son los números primos y el elemento de la fila i y columna j (con i, j > 1) es el valor absoluto de la diferencia de los elementos (i,j-1) e (i-1,j-1).

Definir las siguientes funciones

   siguiente           :: Integer -> [Integer] -> [Integer]
   triangulo           :: [[Integer]]
   conjetura_Gilbreath :: Int -> Bool

siguiente :: Integer -> [Integer] -> [Integer]

triangulo :: [[Integer]]

conjetura_Gilbreath :: Int -> Bool

tales que

(siguiente x ys) es la línea siguiente de la ys que empieza por x en la tabla de Gilbreath; es decir, si ys es [y1,y2,…,yn], entonces (siguiente x ys) es [x,|y1-x|,|y2-|y1-x||,…] Por ejemplo,

     siguiente  7 [5,2,1]               ==  [7,2,0,1]
     siguiente 29 [23,4,2,0,0,0,0,2,1]  ==  [29,6,2,0,0,0,0,0,2,1]

1 2	siguiente 7 [5,2,1] == [7,2,0,1] siguiente 29 [23,4,2,0,0,0,0,2,1] == [29,6,2,0,0,0,0,0,2,1]

triangulo es el triángulo de Gilbreath. Por ejemplo,

     ghci> take 10 triangulo
     [[ 2],
      [ 3,1],
      [ 5,2,1],
      [ 7,2,0,1],
      [11,4,2,2,1],
      [13,2,2,0,2,1],
      [17,4,2,0,0,2,1],
      [19,2,2,0,0,0,2,1],
      [23,4,2,0,0,0,0,2,1],
      [29,6,2,0,0,0,0,0,2,1]]

ghci> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

[11,4,2,2,1],

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

[17,4,2,0,0,2,1],

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

[23,4,2,0,0,0,0,2,1],

[29,6,2,0,0,0,0,0,2,1]]

(conjeturaGilbreath n) se verifica si se cumple la conjetura de Gilbreath para los n primeros números primos; es decir, en el triángulo de Gilbreath cuya primera columna son los n primeros números primos, todas las filas a partir de la segunda terminan en 1. Por ejemplo,

     ghci> conjeturaGilbreath 1000
     True

1 2	ghci> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]
siguiente x ys = scanl (\m n -> abs (m-n)) x ys 

triangulo :: [[Integer]]
triangulo = 
    [2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool
conjeturaGilbreath n = all p (tail (take n triangulo))
  where p xs = last xs == 1

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]

siguiente x ys = scanl (\m n -> abs (m-n)) x ys

triangulo :: [[Integer]]

triangulo =

[2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool

conjeturaGilbreath n = all p (tail (take n triangulo))

where p xs = last xs == 1

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)

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

Vecino en lista circular

PorJosé A. Alonso 19-diciembre-201726-marzo-2022

En la lista circular [3,2,5,7,9]

el vecino izquierdo de 5 es 2 y su vecino derecho es 7,
el vecino izquierdo de 9 es 7 y su vecino derecho es 3,
el vecino izquierdo de 3 es 9 y su vecino derecho es 2,
el elemento 4 no tiene vecinos (porque no está en la lista).

Para indicar las direcciones se define el tipo de datos

   data Direccion = I | D deriving Eq

1	data Direccion = I \| D deriving Eq

Definir la función

   vecino :: Eq a => Direccion -> [a] -> a -> Maybe a

1	vecino :: Eq a => Direccion -> [a] -> a -> Maybe a

tal que (vecino d xs x) es el vecino de x en la lista de elementos distintos xs según la dirección d. Por ejemplo,

   vecino I [3,2,5,7,9] 5  ==  Just 2
   vecino D [3,2,5,7,9] 5  ==  Just 7
   vecino I [3,2,5,7,9] 9  ==  Just 7
   vecino D [3,2,5,7,9] 9  ==  Just 3
   vecino I [3,2,5,7,9] 3  ==  Just 9
   vecino D [3,2,5,7,9] 3  ==  Just 2
   vecino I [3,2,5,7,9] 4  ==  Nothing
   vecino D [3,2,5,7,9] 4  ==  Nothing

vecino I [3,2,5,7,9] 5 == Just 2

vecino D [3,2,5,7,9] 5 == Just 7

vecino I [3,2,5,7,9] 9 == Just 7

vecino D [3,2,5,7,9] 9 == Just 3

vecino I [3,2,5,7,9] 3 == Just 9

vecino D [3,2,5,7,9] 3 == Just 2

vecino I [3,2,5,7,9] 4 == Nothing

vecino D [3,2,5,7,9] 4 == Nothing

Soluciones

data Direccion = I | D deriving Eq

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

vecino1 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino1 d xs x = busca x (vecinos d xs)

-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la
-- direccioń d. Por ejemplo,
--    vecinos I [1..5]  ==  [(2,1),(3,2),(4,3),(5,4),(1,5)]
--    vecinos D [1..5]  ==  [(1,2),(2,3),(3,4),(4,5),(5,1)]
vecinos :: Direccion -> [a] -> [(a,a)]
vecinos I xs = zip (tail (cycle xs)) xs
vecinos D xs = zip xs (tail (cycle xs))

-- (busca x ps) es el la segunda componente de primer par de ps cuya
-- primera componente es igual a x. Por ejemplo, 
--    busca 3 [(4,1),(3,2),(3,7)]  ==  Just 2
--    busca 7 [(4,1),(3,2),(3,7)]  ==  Nothing
busca :: Eq a => a -> [(a,b)] -> Maybe b
busca x ps
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where zs = [z | (x',z) <- ps, x' == x]

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

vecino2 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino2 d xs x = lookup x (vecinos d xs)

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

vecino3 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino3 I xs x = lookup x (zip (tail (cycle xs)) xs) 
vecino3 D xs x = lookup x (zip xs (tail (cycle xs)))

data Direccion = I | D deriving Eq

-- 1ª solución

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

vecino1 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino1 d xs x = busca x (vecinos d xs)

-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la

-- direccioń d. Por ejemplo,

-- vecinos I [1..5] == [(2,1),(3,2),(4,3),(5,4),(1,5)]

-- vecinos D [1..5] == [(1,2),(2,3),(3,4),(4,5),(5,1)]

vecinos :: Direccion -> [a] -> [(a,a)]

vecinos I xs = zip (tail (cycle xs)) xs

vecinos D xs = zip xs (tail (cycle xs))

-- (busca x ps) es el la segunda componente de primer par de ps cuya

-- primera componente es igual a x. Por ejemplo,

-- busca 3 [(4,1),(3,2),(3,7)] == Just 2

-- busca 7 [(4,1),(3,2),(3,7)] == Nothing

busca :: Eq a => a -> [(a,b)] -> Maybe b

busca x ps

| null zs = Nothing

| otherwise = Just (head zs)

where zs = [z | (x',z) <- ps, x' == x]

-- 2ª solución

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

vecino2 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino2 d xs x = lookup x (vecinos d xs)

-- 3ª solución

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

vecino3 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino3 I xs x = lookup x (zip (tail (cycle xs)) xs)

vecino3 D xs x = lookup x (zip xs (tail (cycle xs)))

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)

Subnúmeros pares

PorJosé A. Alonso 18-abril-201725-abril-2017

Los subnúmeros de un número x son los números que se pueden formar con dígitos de x en posiciones consecutivas. Por ejemplo, el número 254 tiene 6 subnúmeros: 2, 5, 4, 25, 54 y 254.

Definir las funciones

   subnumeros       :: Integer -> [Integer]
   nSubnumerosPares :: Integer -> Integer

1 2	subnumeros :: Integer -> [Integer] nSubnumerosPares :: Integer -> Integer

tales que

(subnumerosPares x) es la lista de los subnúmeros pares de x. Por ejemplo,

     subnumerosPares 254   ==  [2,254,54,4]
     subnumerosPares 154   ==  [154,54,4]
     subnumerosPares 15    ==  []

subnumerosPares 254 == [2,254,54,4]

subnumerosPares 154 == [154,54,4]

subnumerosPares 15 == []

(nSubnumerosPares x) es la cantidad de subnúmeros pares de x. Por ejemplo,

     nSubnumerosPares 254   ==  4
     nSubnumerosPares2 (4^(10^6))  ==  90625258498

1 2	nSubnumerosPares 254 == 4 nSubnumerosPares2 (4^(10^6)) == 90625258498

Soluciones

import Data.List ( genericLength
                 , inits
                 , tails
                 )

subnumerosPares :: Integer -> [Integer]
subnumerosPares n =
  filter even (subnumeros n)

-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,
--    subnumeros 254  ==  [2,25,5,254,54,4]
subnumeros :: Integer -> [Integer]
subnumeros n =
  [read x | x <- sublistas (show n)]

-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo, 
--    sublistas "abc"  ==  ["a","ab","b","abc","bc","c"]
sublistas :: [a] -> [[a]]
sublistas xs =
  concat [init (tails ys) | ys <- tail (inits xs)]

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

nSubnumerosPares :: Integer -> Integer
nSubnumerosPares =
  genericLength . subnumerosPares

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

nSubnumerosPares2 :: Integer -> Integer
nSubnumerosPares2 =
  sum . posicionesDigitosPares 

-- (posicionesDigitosPares x) es la lista de las posiciones de los
-- dígitos pares de x. Por ejemplo,
--    posicionesDigitosPares 254  ==  [1,3]
posicionesDigitosPares :: Integer -> [Integer]
posicionesDigitosPares x =
  [n | (n,y) <- zip [1..] (show x)
     , y `elem` "02468"]

-- Comparación de eficiencia
--    λ> nSubnumerosPares (2^(10^3))
--    22934
--    (2.83 secs, 3,413,414,872 bytes)
--    λ> nSubnumerosPares2 (2^(10^3))
--    22934
--    (0.01 secs, 0 bytes)

import Data.List ( genericLength

, inits

, tails

)

subnumerosPares :: Integer -> [Integer]

subnumerosPares n =

filter even (subnumeros n)

-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,

-- subnumeros 254 == [2,25,5,254,54,4]

subnumeros :: Integer -> [Integer]

subnumeros n =

[read x | x <- sublistas (show n)]

-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo,

-- sublistas "abc" == ["a","ab","b","abc","bc","c"]

sublistas :: [a] -> [[a]]

sublistas xs =

concat [init (tails ys) | ys <- tail (inits xs)]

-- 1ª definición

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

nSubnumerosPares :: Integer -> Integer

nSubnumerosPares =

genericLength . subnumerosPares

-- 2ª definición

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

nSubnumerosPares2 :: Integer -> Integer

nSubnumerosPares2 =

sum . posicionesDigitosPares

-- (posicionesDigitosPares x) es la lista de las posiciones de los

-- dígitos pares de x. Por ejemplo,

-- posicionesDigitosPares 254 == [1,3]

posicionesDigitosPares :: Integer -> [Integer]

posicionesDigitosPares x =

[n | (n,y) <- zip [1..] (show x)

, y `elem` "02468"]

-- Comparación de eficiencia

-- λ> nSubnumerosPares (2^(10^3))

-- 22934

-- (2.83 secs, 3,413,414,872 bytes)

-- λ> nSubnumerosPares2 (2^(10^3))

-- 22934

-- (0.01 secs, 0 bytes)

Distancias entre primos consecutivos

PorJosé A. Alonso 4-abril-201711-abril-2017

Los 15 primeros números primos son

   2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47

1	2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47

Las distancias entre los elementos consecutivos son

   1, 2, 2, 4, 2,  4,  2,  4,  6,  2,  6,  4,  2,  4

1	1, 2, 2, 4, 2, 4, 2, 4, 6, 2, 6, 4, 2, 4

La distribución de las distancias es

   (1,1), (2,6), (4,5), (6,2)

1	(1,1), (2,6), (4,5), (6,2)

(es decir, el 1 aparece una vez, el 2 aparece 6 veces, etc.) La frecuencia de las distancias es

   (1,7.142857), (2,42.857143), (4,35.714287), (6,14.285714)

1	(1,7.142857), (2,42.857143), (4,35.714287), (6,14.285714)

(es decir, el 1 aparece el 7.142857%, el 2 el 42.857143% etc.)

Definir las funciones

  cuentaDistancias        :: Int -> [(Int,Int)]
  frecuenciasDistancias   :: Int -> [(Int,Float)]
  graficas                :: [Int] -> IO ()
  distanciasMasFrecuentes :: Int -> [Int]

cuentaDistancias :: Int -> [(Int,Int)]

frecuenciasDistancias :: Int -> [(Int,Float)]

graficas :: [Int] -> IO ()

distanciasMasFrecuentes :: Int -> [Int]

tales que

(cuentaDistancias n) es la distribución de distancias entre los n primeros primos consecutivos. Por ejemplo,

     λ> cuentaDistancias 15
     [(1,1),(2,6),(4,5),(6,2)]
     λ> cuentaDistancias 100
     [(1,1),(2,25),(4,26),(6,25),(8,7),(10,7),(12,4),(14,3),(18,1)]

λ> cuentaDistancias 15

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

λ> cuentaDistancias 100

[(1,1),(2,25),(4,26),(6,25),(8,7),(10,7),(12,4),(14,3),(18,1)]

(frecuenciasDistancias n) es la frecuencia de distancias entre los n primeros primos consecutivos. Por ejemplo,

     λ> frecuenciasDistancias 15
     [(1,7.142857),(2,42.857143),(4,35.714287),(6,14.285714)]
     λ> frecuenciasDistancias 30
     [(1,3.4482758),(2,34.482758),(4,34.482758),(6,24.137932),(8,3.4482758)]

λ> frecuenciasDistancias 15

[(1,7.142857),(2,42.857143),(4,35.714287),(6,14.285714)]

λ> frecuenciasDistancias 30

[(1,3.4482758),(2,34.482758),(4,34.482758),(6,24.137932),(8,3.4482758)]

(graficas ns) dibuja las gráficas de (frecuenciasDistancias k) para k en ns. Por ejemplo, (graficas [10,20,30]) dibuja

(graficas [1000,2000,3000]) dibuja

y (graficas [100000,200000,300000]) dibuja
(distanciasMasFrecuentes n) es la lista de las distancias más frecuentes entre los elementos consecutivos de la lista de los n primeros primos. Por ejemplo,

     distanciasMasFrecuentes 15     ==  [2]
     distanciasMasFrecuentes 26     ==  [2,4]
     distanciasMasFrecuentes 32     ==  [4]
     distanciasMasFrecuentes 41     ==  [2,4,6]
     distanciasMasFrecuentes 77     ==  [6]
     distanciasMasFrecuentes 160    ==  [4,6]
     distanciasMasFrecuentes (10^6) == [6]

distanciasMasFrecuentes 15 == [2]

distanciasMasFrecuentes 26 == [2,4]

distanciasMasFrecuentes 32 == [4]

distanciasMasFrecuentes 41 == [2,4,6]

distanciasMasFrecuentes 77 == [6]

distanciasMasFrecuentes 160 == [4,6]

distanciasMasFrecuentes (10^6) == [6]

Comprobar con QuickCheck si para todo n > 160 se verifica que (distanciasMasFrecuentes n) es [6].

Soluciones

import Data.Numbers.Primes
import qualified Data.Map as M 
import Graphics.Gnuplot.Simple
import Test.QuickCheck

cuentaDistancias :: Int -> [(Int,Int)]
cuentaDistancias = M.toList . dicDistancias

dicDistancias :: Int -> M.Map Int Int
dicDistancias n =
  M.fromListWith (+) (zip (distancias n) (repeat 1))

distancias :: Int -> [Int]
distancias n =
  zipWith (-) (tail xs) xs
  where xs = take n primes

frecuenciasDistancias :: Int -> [(Int,Float)]
frecuenciasDistancias n =
  [(k,(100 * fromIntegral x) / n1) | (k,x) <- cuentaDistancias n]
  where n1 = fromIntegral (n-1)

graficas :: [Int] -> IO ()
graficas ns =
  plotLists [Key Nothing]
            (map frecuenciasDistancias ns)

distanciasMasFrecuentes :: Int -> [Int]
distanciasMasFrecuentes n =
  M.keys (M.filter (==m) d)
  where d = dicDistancias n
        m = maximum (M.elems d)

-- La propiedad es
prop_distanciasMasFrecuentes :: Int -> Bool
prop_distanciasMasFrecuentes n =
  distanciasMasFrecuentes (161 + abs n) == [6]

import Data.Numbers.Primes

import qualified Data.Map as M

import Graphics.Gnuplot.Simple

import Test.QuickCheck

cuentaDistancias :: Int -> [(Int,Int)]

cuentaDistancias = M.toList . dicDistancias

dicDistancias :: Int -> M.Map Int Int

dicDistancias n =

M.fromListWith (+) (zip (distancias n) (repeat 1))

distancias :: Int -> [Int]

distancias n =

zipWith (-) (tail xs) xs

where xs = take n primes

frecuenciasDistancias :: Int -> [(Int,Float)]

frecuenciasDistancias n =

[(k,(100 * fromIntegral x) / n1) | (k,x) <- cuentaDistancias n]

where n1 = fromIntegral (n-1)

graficas :: [Int] -> IO ()

graficas ns =

plotLists [Key Nothing]

(map frecuenciasDistancias ns)

distanciasMasFrecuentes :: Int -> [Int]

distanciasMasFrecuentes n =

M.keys (M.filter (==m) d)

where d = dicDistancias n

m = maximum (M.elems d)

-- La propiedad es

prop_distanciasMasFrecuentes :: Int -> Bool

prop_distanciasMasFrecuentes n =

distanciasMasFrecuentes (161 + abs n) == [6]

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)

Distribución de diferencias de dígitos consecutivos de pi

PorJosé A. Alonso 14-marzo-201725-abril-2021

La distribución de las diferencias de los dígitos consecutivos para los 18 primeros dígitos de pi se calcula como sigue: los primeros 18 dígitos de pi son

   3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5, 8, 9, 7, 9, 3, 2, 3

1	3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5, 8, 9, 7, 9, 3, 2, 3

Las diferencias de sus elementos consecutivos es

   2, -3, 3, -4, -4, 7, -4, 1, 2, -2, -3, -1, 2, -2, 6, 1, -1

1	2, -3, 3, -4, -4, 7, -4, 1, 2, -2, -3, -1, 2, -2, 6, 1, -1

y la distribución de sus frecuencias en el intervalo [-9,9] es

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

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

es decir, el desde el -9 a -5 no aparecen, el -4 aparece 3 veces, el -2 aparece 2 veces y así sucesivamente.

Definir las funciones

   distribucionDDCpi :: Int -> [Int]
   graficas :: [Int] -> FilePath -> IO ()

1 2	distribucionDDCpi :: Int -> [Int] graficas :: [Int] -> FilePath -> IO ()

tales que

(distribucionDDCpi n) es la distribución de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi. Por ejemplo,

   λ> distribucionDDCpi 18
   [0,0,0,0,0,3,2,2,2,0,2,3,1,0,0,1,1,0,0]
   λ> distribucionDDCpi 100
   [1,2,1,7,7,7,6,5,8,6,7,14,4,9,3,6,4,1,0]
   λ> distribucionDDCpi 200
   [3,6,2,13,14,12,11,12,15,17,15,19,11,17,8,13,9,2,0]
   λ> distribucionDDCpi 1000
   [16,25,23,44,57,61,55,75,92,98,80,88,64,65,42,54,39,14,8]
   λ> distribucionDDCpi 5000
   [67,99,130,196,245,314,361,391,453,468,447,407,377,304,242,221,134,97,47]

λ> distribucionDDCpi 18

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

λ> distribucionDDCpi 100

[1,2,1,7,7,7,6,5,8,6,7,14,4,9,3,6,4,1,0]

λ> distribucionDDCpi 200

[3,6,2,13,14,12,11,12,15,17,15,19,11,17,8,13,9,2,0]

λ> distribucionDDCpi 1000

[16,25,23,44,57,61,55,75,92,98,80,88,64,65,42,54,39,14,8]

λ> distribucionDDCpi 5000

[67,99,130,196,245,314,361,391,453,468,447,407,377,304,242,221,134,97,47]

(graficas ns f) dibuja en el fichero f las gráficas de las distribuciones de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi, para n en ns. Por ejemplo, al evaluar (graficas [100,250..4000] «distribucionDDCpi.png» se escribe en el fichero «distribucionDDCpi.png» la siguiente gráfica

Nota: Se puede usar la librería Data.Number.CReal.

Soluciones

import Data.Number.CReal
import Graphics.Gnuplot.Simple
import Data.Array

--    λ> digitosPi 18
--    [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3]
digitosPi :: Int -> [Int]
digitosPi n = init [read [c] | c <- (x:xs)]
  where (x:_:xs) = showCReal n pi

--    λ> diferenciasConsecutivos (digitosPi 18)
--    [2,-3,3,-4,-4,7,-4,1,2,-2,-3,-1,2,-2,6,1,-1]
diferenciasConsecutivos :: Num a => [a] -> [a]
diferenciasConsecutivos xs =
  zipWith (-) xs (tail xs)

distribucionDDCpi :: Int -> [Int]
distribucionDDCpi =
  distribucion . diferenciasConsecutivos . digitosPi
  where distribucion xs =
          elems (accumArray (+) 0 (-9,9) (zip xs (repeat 1)))

graficas :: [Int] -> FilePath -> IO ()
graficas ns f = 
  plotLists [Key Nothing, PNG f]
            [puntos n | n <- ns]
  where puntos :: Int -> [(Int,Int)]
        puntos n = zip [-9..9] (distribucionDDCpi n)

import Data.Number.CReal

import Graphics.Gnuplot.Simple

import Data.Array

-- λ> digitosPi 18

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

digitosPi :: Int -> [Int]

digitosPi n = init [read [c] | c <- (x:xs)]

where (x:_:xs) = showCReal n pi

-- λ> diferenciasConsecutivos (digitosPi 18)

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

diferenciasConsecutivos :: Num a => [a] -> [a]

diferenciasConsecutivos xs =

zipWith (-) xs (tail xs)

distribucionDDCpi :: Int -> [Int]

distribucionDDCpi =

distribucion . diferenciasConsecutivos . digitosPi

where distribucion xs =

elems (accumArray (+) 0 (-9,9) (zip xs (repeat 1)))

graficas :: [Int] -> FilePath -> IO ()

graficas ns f =

plotLists [Key Nothing, PNG f]

[puntos n | n <- ns]

where puntos :: Int -> [(Int,Int)]

puntos n = zip [-9..9] (distribucionDDCpi n)

Números construibles como sumas de dos dados

PorJosé A. Alonso 3-marzo-201725-marzo-2022

Un número x es construible a partir de de los números enteros positivos a y b si se puede escribir como una suma cuyos sumandos son a o b. Por ejemplo, 7 y 9 son construibles a partir de 2 y 3 ya que 7 = 2+2+3 y 9 = 3+3+3.

Definir las funciones

   construibles  :: Integer -> Integer -> [Integer]
   esConstruible :: Integer -> Integer -> Integer -> Bool

1 2	construibles :: Integer -> Integer -> [Integer] esConstruible :: Integer -> Integer -> Integer -> Bool

tales que

(construibles a b) es la lista de los números construibles a partir de a y b. Por ejemplo,

     take 5 (construibles 2 9)  ==  [2,4,6,8,9]
     take 5 (construibles 6 4)  ==  [4,6,8,10,12]
     take 5 (construibles 9 7)  ==  [7,9,14,16,18]

take 5 (construibles 2 9) == [2,4,6,8,9]

take 5 (construibles 6 4) == [4,6,8,10,12]

take 5 (construibles 9 7) == [7,9,14,16,18]

(esConstruible a b x) se verifica si x es construible a partir de a y b. Por ejemplo,

     esConstruible 2 3 7   ==  True
     esConstruible 9 7 15  ==  False

1 2	esConstruible 2 3 7 == True esConstruible 9 7 15 == False

Soluciones

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]
construibles a b = tail aux
  where aux = 0 : mezcla [a + x | x <- aux]
                         [b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla p@(x:xs) q@(y:ys) | x < y     = x : mezcla xs q
                         | x > y     = y : mezcla p  ys  
                         | otherwise = x : mezcla xs ys
mezcla []       ys                   = ys
mezcla xs       []                   = xs
              
esConstruible :: Integer -> Integer -> Integer -> Bool
esConstruible a b x = x == y
  where (y:_) = dropWhile (<x) (construibles a b)

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]

construibles a b = tail aux

where aux = 0 : mezcla [a + x | x <- aux]

[b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]

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

| x > y = y : mezcla p ys

| otherwise = x : mezcla xs ys

mezcla [] ys = ys

mezcla xs [] = xs

esConstruible :: Integer -> Integer -> Integer -> Bool

esConstruible a b x = x == y

where (y:_) = dropWhile (<x) (construibles a b)

Cálculo de pi mediante el método de Newton

PorJosé A. Alonso 24-febrero-201725-abril-2021

El método de Newton para el cálculo de pi se basa en la relación

y en el desarrollo del arco seno

de donde se obtiene la fórmula

La primeras aproximaciones son

   a(0) = 6*(1/2)                               = 3.0
   a(1) = 6*(1/2+1/(2*3*2^3))                   = 3.125
   a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

a(0) = 6*(1/2) = 3.0

a(1) = 6*(1/2+1/(2*3*2^3)) = 3.125

a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Newton. Por ejemplo,

     aproximacionPi 0   ==  3.0
     aproximacionPi 1   ==  3.125
     aproximacionPi 2   ==  3.1390625
     aproximacionPi 10  ==  3.1415926468755613
     aproximacionPi 21  ==  3.141592653589793
     pi                 ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.125

aproximacionPi 2 == 3.1390625

aproximacionPi 10 == 3.1415926468755613

aproximacionPi 21 == 3.141592653589793

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi donde k toma los valores de la lista xs. Por ejemplo, (grafica [1..30]) dibuja

Nota: Este ejercicio ha sido propuesto por Manuel Herrera.

Soluciones

import Graphics.Gnuplot.Simple

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

aproximacionPi :: Int -> Double
aproximacionPi n = 6 * arcsinX
  where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]
factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]
potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]
fraccionesPI =
  scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]
serie = scanl1 (+) (zipWith (/)
                            (map fromIntegral numeradores)
                            (map fromIntegral denominadores))
  where numeradores    = 1 : scanl1 (*) [1,3..]
        denominadores  = zipWith (*) denominadores1 denominadores2
        denominadores1 = 2 : scanl1 (*) [2,4..]
        denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()
grafica xs = 
    plotList [Key Nothing]
             [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n = 6 * arcsinX

where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]

factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]

potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]

fraccionesPI =

scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]

serie = scanl1 (+) (zipWith (/)

(map fromIntegral numeradores)

(map fromIntegral denominadores))

where numeradores = 1 : scanl1 (*) [1,3..]

denominadores = zipWith (*) denominadores1 denominadores2

denominadores1 = 2 : scanl1 (*) [2,4..]

denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()

grafica xs =

plotList [Key Nothing]

[(k,aproximacionPi k) | k <- xs]

Máxima potencia que divide al factorial

PorJosé A. Alonso 26-enero-20172-febrero-2017

La máxima potencia de 2 que divide al factorial de 5 es 3, ya que 5! = 120, 120 es divisible por 2^3 y no lo es por 2^4.

Definir la función

   maxPotDivFact :: Integer -> Integer -> Integer

1	maxPotDivFact :: Integer -> Integer -> Integer

tal que (maxPotDivFact p n), para cada primo p, es el mayor k tal que p^k divide al factorial de n. Por ejemplo,

   maxPotDivFact 2 5       ==  3
   maxPotDivFact 3 6       ==  2
   maxPotDivFact 2 10      ==  8
   maxPotDivFact 3 10      ==  4
   maxPotDivFact 2 (10^2)  ==  97
   maxPotDivFact 2 (10^3)  ==  994
   maxPotDivFact 2 (10^4)  ==  9995
   maxPotDivFact 2 (10^5)  ==  99994
   maxPotDivFact 2 (10^6)  ==  999993
   maxPotDivFact 3 (10^5)  ==  49995
   maxPotDivFact 3 (10^6)  ==  499993
   maxPotDivFact 7 (10^5)  ==  16662
   maxPotDivFact 7 (10^6)  ==  166664
   length (show (maxPotDivFact 2 (10^20000)))  ==  20000

maxPotDivFact 2 5 == 3

maxPotDivFact 3 6 == 2

maxPotDivFact 2 10 == 8

maxPotDivFact 3 10 == 4

maxPotDivFact 2 (10^2) == 97

maxPotDivFact 2 (10^3) == 994

maxPotDivFact 2 (10^4) == 9995

maxPotDivFact 2 (10^5) == 99994

maxPotDivFact 2 (10^6) == 999993

maxPotDivFact 3 (10^5) == 49995

maxPotDivFact 3 (10^6) == 499993

maxPotDivFact 7 (10^5) == 16662

maxPotDivFact 7 (10^6) == 166664

length (show (maxPotDivFact 2 (10^20000))) == 20000

Soluciones

import Data.List (genericIndex, genericTake)
import Data.Numbers.Primes (primes)
import Test.QuickCheck

-- 1ª definición
maxPotDivFact :: Integer -> Integer -> Integer
maxPotDivFact p n =
  head [k | k <- [0..], f `mod` (p^k) /= 0] - 1
  where f = product [1..n]

-- 1ª definición
maxPotDivFact2 :: Integer -> Integer -> Integer
maxPotDivFact2 p n
  | n < p     = 0
  | otherwise = m + maxPotDivFact2 p m
  where m = n `div` p  
  
-- 3ª definición
maxPotDivFact3 :: Integer -> Integer -> Integer
maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia
--    λ> maxPotDivFact 2 (10^4)
--    9995
--    (5.47 secs, 161,040,624 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--
--    λ> length (show (maxPotDivFact2 2 (10^20000)))
--    20000
--    (1.93 secs, 592,168,544 bytes)
--    λ> length (show (maxPotDivFact3 2 (10^20000)))
--    20000
--    (2.93 secs, 861,791,504 bytes)

import Data.List (genericIndex, genericTake)

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición

maxPotDivFact :: Integer -> Integer -> Integer

maxPotDivFact p n =

head [k | k <- [0..], f `mod` (p^k) /= 0] - 1

where f = product [1..n]

-- 1ª definición

maxPotDivFact2 :: Integer -> Integer -> Integer

maxPotDivFact2 p n

| n < p = 0

| otherwise = m + maxPotDivFact2 p m

where m = n `div` p

-- 3ª definición

maxPotDivFact3 :: Integer -> Integer -> Integer

maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia

-- λ> maxPotDivFact 2 (10^4)

-- 9995

-- (5.47 secs, 161,040,624 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> length (show (maxPotDivFact2 2 (10^20000)))

-- 20000

-- (1.93 secs, 592,168,544 bytes)

-- λ> length (show (maxPotDivFact3 2 (10^20000)))

-- 20000

-- (2.93 secs, 861,791,504 bytes)

Árboles continuos

PorJosé A. Alonso 25-enero-20171-febrero-2017

Los árboles binarios se pueden representar con el de tipo de dato algebraico

   data Arbol a = H
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, los árboles

       3                7     
      / \              / \    
     2   4            5   8   
    / \   \          / \   \  
   1   3   5        6   4   10

3 7

/ \ / \

2 4 5 8

/ \ \ / \ \

1 3 5 6 4 10

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

Un árbol binario es continuo si el valor absoluto de la diferencia de los elementos adyacentes es 1. Por ejemplo, el árbol ej1 es continuo ya que el valor absoluto de sus pares de elementos adyacentes son

   |3-2| = |2-1| = |2-3| = |3-4| = |4-5| = 1

1	\|3-2\| = \|2-1\| = \|2-3\| = \|3-4\| = \|4-5\| = 1

En cambio, el ej2 no lo es ya que |8-10| ≠ 1.

Definir la función

   esContinuo :: (Num a, Eq a) => Arbol a -> Bool

1	esContinuo :: (Num a, Eq a) => Arbol a -> Bool

tal que (esContinuo x) se verifica si el árbol x es continuo. Por ejemplo,

   esContinuo ej1  ==  True
   esContinuo ej2  ==  False

1 2	esContinuo ej1 == True esContinuo ej2 == False

Soluciones

data Arbol a = H
             | N a (Arbol a) (Arbol a)
  deriving Show

ej1, ej2 :: Arbol Int
ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool
esContinuo H         = True
esContinuo (N _ H H) = True
esContinuo (N x i@(N y _ _) H) =
  abs (x - y) == 1 && esContinuo i
esContinuo (N x H d@(N y _ _)) =
  abs (x - y) == 1 && esContinuo d
esContinuo (N x i@(N y _ _) d@(N z _ _)) =
  abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d 

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool
esContinuo2 x =
  all esContinua (ramas x)

-- (ramas x) es la lista de las ramas del árbol x. Por ejemplo,
--    ramas ej1  ==  [[3,2,1],[3,2,3],[3,4,5]]
--    ramas ej2  ==  [[7,5,6],[7,5,4],[7,8,10]]
ramas :: Arbol a -> [[a]]
ramas H         = []
ramas (N x H H) = [[x]]
ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de
-- los elementos adyacentes de xs es 1. Por ejemplo, 
--    esContinua [3,2,3]   ==  True
--    esContinua [7,8,10]  ==  False
esContinua :: (Num a, Eq a) => [a] -> Bool
esContinua xs =
  and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

-- 1ª solución

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool

esContinuo H = True

esContinuo (N _ H H) = True

esContinuo (N x i@(N y _ _) H) =

abs (x - y) == 1 && esContinuo i

esContinuo (N x H d@(N y _ _)) =

abs (x - y) == 1 && esContinuo d

esContinuo (N x i@(N y _ _) d@(N z _ _)) =

abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d

-- 2ª solución

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool

esContinuo2 x =

all esContinua (ramas x)

-- (ramas x) es la lista de las ramas del árbol x. Por ejemplo,

-- ramas ej1 == [[3,2,1],[3,2,3],[3,4,5]]

-- ramas ej2 == [[7,5,6],[7,5,4],[7,8,10]]

ramas :: Arbol a -> [[a]]

ramas H = []

ramas (N x H H) = [[x]]

ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de

-- los elementos adyacentes de xs es 1. Por ejemplo,

-- esContinua [3,2,3] == True

-- esContinua [7,8,10] == False

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

esContinua xs =

and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

Referencias

Basado en Continuous tree de GeeksforGeeks.

La sucesión «Mira y di»

PorJosé A. Alonso 24-enero-201731-enero-2017

La sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,

   x(1) = 11     ("dos unos                          --> "21")
   x(2) = 21     ("un dos un uno                     --> "1211")
   x(3) = 1211   ("un uno un dos dos unos            --> "111221")
   x(4) = 111221 ("tres unos dos doses un uno        --> "312211")
   x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

x(1) = 11 ("dos unos --> "21")

x(2) = 21 ("un dos un uno --> "1211")

x(3) = 1211 ("un uno un dos dos unos --> "111221")

x(4) = 111221 ("tres unos dos doses un uno --> "312211")

x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

Definir la función

  sucMiraYDi :: Integer -> [Integer]

1	sucMiraYDi :: Integer -> [Integer]

tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,

   λ> take 9 (sucMiraYdi 1)
   [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]
   λ> take 5 (sucMiraYdi 2017)
   [2017,12101117,111211103117,31123110132117,1321121321101113122117]
   λ> take 7 (sucMiraYDi 22)
   [22,22,22,22,22,22,22]
   λ> (sucMiraYDi 1) !! 11
   3113112221232112111312211312113211
   λ> (sucMiraYDi 1) !! 12
   1321132132111213122112311311222113111221131221

λ> take 9 (sucMiraYdi 1)

[1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]

λ> take 5 (sucMiraYdi 2017)

[2017,12101117,111211103117,31123110132117,1321121321101113122117]

λ> take 7 (sucMiraYDi 22)

[22,22,22,22,22,22,22]

λ> (sucMiraYDi 1) !! 11

3113112221232112111312211312113211

λ> (sucMiraYDi 1) !! 12

1321132132111213122112311311222113111221131221

Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son

   2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

1	2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

Definir la función

   aproximacionConway :: Integer -> Double -> Int

1	aproximacionConway :: Integer -> Double -> Int

tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,

   aproximacionConway 1 0.3     ==  3
   aproximacionConway 1 0.1     ==  5
   aproximacionConway 1 0.01    ==  9
   aproximacionConway 1 0.001   ==  24
   aproximacionConway 1 0.0001  ==  43
   aproximacionConway 2 0.0001  ==  47

aproximacionConway 1 0.3 == 3

aproximacionConway 1 0.1 == 5

aproximacionConway 1 0.01 == 9

aproximacionConway 1 0.001 == 24

aproximacionConway 1 0.0001 == 43

aproximacionConway 2 0.0001 == 47

Nota: Este ejercicio ha sido propuesto por Elías Guisado.

Soluciones

import Data.List (genericLength, group)

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

sucMiraYdi :: Integer -> [Integer]
sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.
--    di 1       ==  11
--    di 11      ==  21
--    di 21      ==  1211
--    di 1211    ==  111221
--    di 111221  ==  312211
--    di 312211  ==  13112221
di :: Integer -> Integer
di = read . concatMap aux . group . show
  where aux s = show (length s) ++ [head s]

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

sucMiraYdi2 :: Integer -> [Integer]
sucMiraYdi2 = iterate (read . concatMap aux . group . show)
  where aux s = show (length s) ++ [head s]

-- Constante de Conway
-- ===================

aproximacionConway :: Integer -> Double -> Int
aproximacionConway n e =
  length (takeWhile aux (razonesMiraYdi n))
  where aux x = abs (x - constanteConway) > e 

constanteConway :: Double
constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada
-- elemento de la sucesión "Mira y di" con elemento inicial n y su
-- anterior. Por ejemplo,
--    λ> take 10 (razonesMiraYdi 1)
--    [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]
--    λ> take 7 (razonesMiraYdi 10)
--    [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]
razonesMiraYdi :: Integer -> [Double]
razonesMiraYdi n =
  zipWith (/) (tail xs) xs
  where xs = map (genericLength . show) (sucMiraYdi n)

import Data.List (genericLength, group)

-- 1ª solución

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

sucMiraYdi :: Integer -> [Integer]

sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.

-- di 1 == 11

-- di 11 == 21

-- di 21 == 1211

-- di 1211 == 111221

-- di 111221 == 312211

-- di 312211 == 13112221

di :: Integer -> Integer

di = read . concatMap aux . group . show

where aux s = show (length s) ++ [head s]

-- 2ª solución

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

sucMiraYdi2 :: Integer -> [Integer]

sucMiraYdi2 = iterate (read . concatMap aux . group . show)

where aux s = show (length s) ++ [head s]

-- Constante de Conway

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

aproximacionConway :: Integer -> Double -> Int

aproximacionConway n e =

length (takeWhile aux (razonesMiraYdi n))

where aux x = abs (x - constanteConway) > e

constanteConway :: Double

constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada

-- elemento de la sucesión "Mira y di" con elemento inicial n y su

-- anterior. Por ejemplo,

-- λ> take 10 (razonesMiraYdi 1)

-- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]

-- λ> take 7 (razonesMiraYdi 10)

-- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]

razonesMiraYdi :: Integer -> [Double]

razonesMiraYdi n =

zipWith (/) (tail xs) xs

where xs = map (genericLength . show) (sucMiraYdi n)

Cadena de primos

PorJosé A. Alonso 23-enero-201730-enero-2017

La lista de los primeros números primos es

   [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

1	[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

Los primeros elementos de la cadena obtenida concatenado los números primos es

   "23571113171923293137414347535961677173798389971011"

1	"23571113171923293137414347535961677173798389971011"

Definir la función

   primoEnPosicion :: Int -> Integer

1	primoEnPosicion :: Int -> Integer

tal que (primoEnPosicion n) es el número primo que tiene algún dígito en la posición n de la cadena obtenida concatenado los números primos. Por ejemplo,

   primoEnPosicion 0       ==  2
   primoEnPosicion 1       ==  3
   primoEnPosicion 4       ==  11
   primoEnPosicion 5       ==  11
   primoEnPosicion 6       ==  13
   primoEnPosicion 1022    ==  2011
   primoEnPosicion 1023    ==  2017
   primoEnPosicion 1026    ==  2017
   primoEnPosicion 1027    ==  2027
   primoEnPosicion (10^7)  ==  21242357

primoEnPosicion 0 == 2

primoEnPosicion 1 == 3

primoEnPosicion 4 == 11

primoEnPosicion 5 == 11

primoEnPosicion 6 == 13

primoEnPosicion 1022 == 2011

primoEnPosicion 1023 == 2017

primoEnPosicion 1026 == 2017

primoEnPosicion 1027 == 2027

primoEnPosicion (10^7) == 21242357

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

primoEnPosicion :: Int -> Integer
primoEnPosicion = aux primes
  where aux (x:xs) n | m > n     = x
                     | otherwise = aux xs (n-m)
          where m = length (show x)


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

primoEnPosicion2 :: Int -> Integer
primoEnPosicion2 n = p
  where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y
-- las posiciones de sus dígitos finales en la sucesión de la
-- concatenación de primos. Por ejemplo, 
--    λ> take 10 primosYfinales
--    [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]
primosYfinales :: [(Integer, Int)]
primosYfinales = scanl f (2,0) (tail primes)
  where f (p,k) q = (q, k + length (show q))

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equivalencia (Positive n) =
  primoEnPosicion n == primoEnPosicion2 n

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

primoEnPosicion :: Int -> Integer

primoEnPosicion = aux primes

where aux (x:xs) n | m > n = x

| otherwise = aux xs (n-m)

where m = length (show x)

-- 2ª definición

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

primoEnPosicion2 :: Int -> Integer

primoEnPosicion2 n = p

where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y

-- las posiciones de sus dígitos finales en la sucesión de la

-- concatenación de primos. Por ejemplo,

-- λ> take 10 primosYfinales

-- [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]

primosYfinales :: [(Integer, Int)]

primosYfinales = scanl f (2,0) (tail primes)

where f (p,k) q = (q, k + length (show q))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia (Positive n) =

primoEnPosicion n == primoEnPosicion2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Terminaciones de Fibonacci

PorJosé A. Alonso 2-enero-20179-enero-2017

Definir la sucesión

   sucFinalesFib :: [(Integer,Integer)]

1	sucFinalesFib :: [(Integer,Integer)]

cuyos elementos son los pares (n,x), donde x es el n-ésimo término de la sucesión de Fibonacci, tales que la terminación de x es n. Por ejemplo,

   λ> take 6 sucFinalesFib
   [(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]
   λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]
   (245,712011255569818855923257924200496343807632829750245)
   λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]
   10945

λ> take 6 sucFinalesFib

[(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]

λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]

(245,712011255569818855923257924200496343807632829750245)

λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]

10945

Soluciones

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]
sucFinalesFib =
  [(n, fib n) | n <- [0..]
              , show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]
sucFib = 0 : 1 : zipWith (+) sucFib (tail sucFib)

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.
fib :: Integer -> Integer
fib n = sucFib `genericIndex` n

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]

sucFinalesFib =

[(n, fib n) | n <- [0..]

, show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]

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

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.

fib :: Integer -> Integer

fib n = sucFib `genericIndex` n

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico