I1M2011: Resolución de problemas matemáticos con Haskell (2)

En la primera parte de la clase de hoy de Informática de 1º del Grado en Matemáticas se han explicado las soluciones de los 5 últimos ejercicios de la 12ª relación en la que se plantea la resolución de distintos problemas
matemáticos. En concreto,

el producto, por plegado, de los números que verifican una propiedad,
el carácter funcional de una relación,
las cabezas y las colas de una lista y
la identidad de Bezout.

Estos ejercicios corresponden a los temas 5, 6 y 7.

Los ejercicios, y sus soluciones, se muestran a continuación.

-- ---------------------------------------------------------------------
-- Importación de librerías auxiliares                                --
-- ---------------------------------------------------------------------

import Test.QuickCheck
import Data.List

-- -------------------------------------------------------------------
-- Ejercicio 7.1. Definir mediante plegado la función 
--    producto :: Num a => [a] -> a
-- tal que (producto xs) es el producto de los elementos de la lista
-- xs. Por ejemplo, 
--    producto [2,1,-3,4,5,-6] == 720
-- ---------------------------------------------------------------------

producto :: Num a => [a] -> a
producto = foldr (*) 1

-- ---------------------------------------------------------------------
-- Ejercicio 7.2. Definir mediante plegado la función 
--    productoPred :: Num a => (a -> Bool) -> [a] -> a
-- tal que (productoPred p xs) es el producto de los elementos de la
-- lista xs que verifican el predicado p. Por ejemplo, 
--    productoPred even [2,1,-3,4,-5,6] == 48
-- ---------------------------------------------------------------------

productoPred :: Num a => (a -> Bool) -> [a] -> a
productoPred p = foldr (\x y -> if p x then x*y else y) 1

-- ---------------------------------------------------------------------
-- Ejercicio 7.3. Definir la función 
--    productoPos :: (Num a, Ord a) => [a] -> a
-- tal que (productoPos xs) esel producto de los elementos estríctamente
-- positivos de la lista xs. Por ejemplo,
--    productoPos [2,1,-3,4,-5,6] == 48
-- ---------------------------------------------------------------------

productoPos :: (Num a, Ord a) => [a] -> a
productoPos = productoPred (>0)

-- ---------------------------------------------------------------------
-- Ejercicio 8. Las relaciones finitas se pueden representar mediante
-- listas de pares. Por ejemplo,
--    r1, r2, r3 :: [(Int, Int)]
--    r1 = [(1,3), (2,6), (8,9), (2,7)]
--    r2 = [(1,3), (2,6), (8,9), (3,7)]
--    r3 = [(1,3), (2,6), (8,9), (3,6)]
-- Definir la función 
--    esFuncion :: (Eq a, Eq b) => [(a,b)] -> Bool
-- tal que (esFuncion r) se verifica si la relación r es una función (es
-- decir, a cada elemento del dominio de la relación r le corresponde un
-- único elemento). Por ejemplo, 
--    esFuncion r1 == False
--    esFuncion r2 == True
--    esFuncion r3 == True
-- ---------------------------------------------------------------------

r1, r2, r3 :: [(Int, Int)]
r1 = [(1,3), (2,6), (8,9), (2,7)]
r2 = [(1,3), (2,6), (8,9), (3,7)]
r3 = [(1,3), (2,6), (8,9), (3,6)]

esFuncion :: (Eq a, Eq b) => [(a,b)] -> Bool
esFuncion [] = True
esFuncion ((x,y):r) = 
    [y' | (x',y') <- r, x == x', y /= y'] == [] && esFuncion r 

-- -------------------------------------------------------------------
-- Ejercicio 9.1. Se denomina cola de una lista l a una sublista no
-- vacía de l formada por un elemento y los siguientes hasta el
-- final. Por ejemplo, [3,4,5] es una cola de la lista [1,2,3,4,5]. 
-- 
-- Definir la función 
--    colas :: [a] -> [[a]]
-- tal que (colas xs) es la lista de las colas
-- de la lista xs. Por ejemplo, 
--    colas []        == [[]]
--    colas [1,2]     == [[1,2],[2],[]]
--    colas [4,1,2,5] == [[4,1,2,5],[1,2,5],[2,5],[5],[]]
-- ---------------------------------------------------------------------

colas :: [a] -> [[a]]
colas []     = [[]]
colas (x:xs) = (x:xs) : colas xs

-- ---------------------------------------------------------------------
-- Ejercicio 9.2. Comprobar con QuickCheck que las funciones colas y
-- tails son equivalentes.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_colas :: [Int] -> Bool
prop_colas xs = colas xs == tails xs

-- La comprobación es
--    *Main> quickCheck prop_colas
--    +++ OK, passed 100 tests.

-- ---------------------------------------------------------------------
-- Ejercicio 10.1. Se denomina cabeza de una lista l a una sublista no
-- vacía de la formada por el primer elemento y los siguientes hasta uno
-- dado. Por ejemplo, [1,2,3] es una cabeza de [1,2,3,4,5]. 
-- 
-- Definir la función 
--    cabezas :: [a] -> [[a]]
-- tal que (cabezas xs) es la lista de las cabezas de la lista xs. Por
-- ejemplo, 
--    cabezas []          == [[]] 
--    cabezas [1,4]       == [[],[1],[1,4]] 
--    cabezas [1,4,5,2,3] == [[],[1],[1,4],[1,4,5],[1,4,5,2],[1,4,5,2,3]] 
-- ---------------------------------------------------------------------

-- 1. Por recursión
cabezas :: [a] -> [[a]]
cabezas []     = [[]]
cabezas (x:xs) = [] : [x:ys | ys <- cabezas xs]

-- 2. Usando patrones de plegado.
cabezasP :: [a] -> [[a]]
cabezasP = foldr (\x y -> [x]:[x:ys | ys <- y]) []

-- 3. Usando colas y funciones de orden superior.
cabezas3 :: [a] -> [[a]]
cabezas3 xs = reverse (map reverse (colas (reverse xs)))

-- La anterior definición puede escribirse sin argumentos como 
cabezas3' :: [a] -> [[a]]
cabezas3' = reverse . map reverse . (colas . reverse)

-- ---------------------------------------------------------------------
-- Ejercicio 10.2. Comprobar con QuickCheck que las funciones cabezas y
-- inits son equivalentes.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_cabezas :: [Int] -> Bool
prop_cabezas xs = cabezas xs == inits xs

-- La comprobación es
--    *Main> quickCheck prop_cabezas
--    +++ OK, passed 100 tests.

-- ---------------------------------------------------------------------
-- Ejercicio 11.1. [La identidad de Bezout] Definir la función
--    bezout :: Integer -> Integer -> (Integer, Integer)
-- tal que (bezout a b) es un par de números x e y tal que a*x+b*y es el
-- máximo común divisor de a y b. Por ejemplo,
--    bezout 21 15  ==  (-2,3)
-- Indicación: Se puede usar la función quotRem tal que (quotRem x y) es
-- el par formado por el cociente y el resto de dividir x entre y.
-- ---------------------------------------------------------------------

-- Ejemplo de cálculo
--    a  b   q r   
--    36 21  1 15   (1)
--    21 15  1  6   (2) 
--    15  6  2  3   (3)
--     6  3  2  0
--     3  0   
-- Por tanto,
--    3 = 15 - 6*2              [por (3)]
--      = 15 - (21-15*1)*2      [por (2)]
--      = 21*(-2) + 15*3        
--      = 21*(-2)+ (36-21*1)*3  [por (1)]
--      = 36*3 + 21*(-5)

-- Sean q, r el cociente y el resto de a entre b, d el máximo común
-- denominador de a y b y (x,y) el valor de (bezout b r) . Entonces,
--    a = bp+r
--    d = bx+ry
-- Por tanto,
--    d = bx + (a-bp)y
--      = ay + b(x-qy)
-- Luego,
--    bezout a b = (y,x-qy)

bezout :: Integer -> Integer -> (Integer, Integer)
bezout _ 0 = (1,0)
bezout _ 1 = (0,1)
bezout a b = (y, x-q*y)
    where (x,y) = bezout b r
          (q,r) = quotRem a b

-- ---------------------------------------------------------------------
-- Ejercicio 11.2. Comprobar con QuickCheck que si a>0, b>0 y 
-- (x,y) es el valor de (bezout a b), entonces a*x+b*y es igual al
-- máximo común divisor de a y b.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_Bezout :: Integer -> Integer -> Property
prop_Bezout a b = a>0 && b>0 ==> a*x+b*y == gcd a b
    where (x,y) = bezout a b          

-- La comprobación es
--   Main> quickCheck prop_Bezout
--   OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

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

-- Importación de librerías auxiliares --

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

import Test.QuickCheck

import Data.List

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

-- Ejercicio 7.1. Definir mediante plegado la función

-- producto :: Num a => [a] -> a

-- tal que (producto xs) es el producto de los elementos de la lista

-- xs. Por ejemplo,

-- producto [2,1,-3,4,5,-6] == 720

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

producto :: Num a => [a] -> a

producto = foldr (*) 1

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

-- Ejercicio 7.2. Definir mediante plegado la función

-- productoPred :: Num a => (a -> Bool) -> [a] -> a

-- tal que (productoPred p xs) es el producto de los elementos de la

-- lista xs que verifican el predicado p. Por ejemplo,

-- productoPred even [2,1,-3,4,-5,6] == 48

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

productoPred :: Num a => (a -> Bool) -> [a] -> a

productoPred p = foldr (\x y -> if p x then x*y else y) 1

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

-- Ejercicio 7.3. Definir la función

-- productoPos :: (Num a, Ord a) => [a] -> a

-- tal que (productoPos xs) esel producto de los elementos estríctamente

-- positivos de la lista xs. Por ejemplo,

-- productoPos [2,1,-3,4,-5,6] == 48

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

productoPos :: (Num a, Ord a) => [a] -> a

productoPos = productoPred (>0)

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

-- Ejercicio 8. Las relaciones finitas se pueden representar mediante

-- listas de pares. Por ejemplo,

-- r1, r2, r3 :: [(Int, Int)]

-- r1 = [(1,3), (2,6), (8,9), (2,7)]

-- r2 = [(1,3), (2,6), (8,9), (3,7)]

-- r3 = [(1,3), (2,6), (8,9), (3,6)]

-- Definir la función

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

-- tal que (esFuncion r) se verifica si la relación r es una función (es

-- decir, a cada elemento del dominio de la relación r le corresponde un

-- único elemento). Por ejemplo,

-- esFuncion r1 == False

-- esFuncion r2 == True

-- esFuncion r3 == True

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

r1, r2, r3 :: [(Int, Int)]

r1 = [(1,3), (2,6), (8,9), (2,7)]

r2 = [(1,3), (2,6), (8,9), (3,7)]

r3 = [(1,3), (2,6), (8,9), (3,6)]

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

esFuncion [] = True

esFuncion ((x,y):r) =

[y' | (x',y') <- r, x == x', y /= y'] == [] && esFuncion r

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

-- Ejercicio 9.1. Se denomina cola de una lista l a una sublista no

-- vacía de l formada por un elemento y los siguientes hasta el

-- final. Por ejemplo, [3,4,5] es una cola de la lista [1,2,3,4,5].

-- Definir la función

-- colas :: [a] -> [[a]]

-- tal que (colas xs) es la lista de las colas

-- de la lista xs. Por ejemplo,

-- colas [] == [[]]

-- colas [1,2] == [[1,2],[2],[]]

-- colas [4,1,2,5] == [[4,1,2,5],[1,2,5],[2,5],[5],[]]

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

colas :: [a] -> [[a]]

colas [] = [[]]

colas (x:xs) = (x:xs) : colas xs

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

-- Ejercicio 9.2. Comprobar con QuickCheck que las funciones colas y

-- tails son equivalentes.

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

-- La propiedad es

prop_colas :: [Int] -> Bool

prop_colas xs = colas xs == tails xs

-- La comprobación es

-- *Main> quickCheck prop_colas

-- +++ OK, passed 100 tests.

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

-- Ejercicio 10.1. Se denomina cabeza de una lista l a una sublista no

-- vacía de la formada por el primer elemento y los siguientes hasta uno

-- dado. Por ejemplo, [1,2,3] es una cabeza de [1,2,3,4,5].

-- Definir la función

-- cabezas :: [a] -> [[a]]

-- tal que (cabezas xs) es la lista de las cabezas de la lista xs. Por

-- ejemplo,

-- cabezas [] == [[]]

-- cabezas [1,4] == [[],[1],[1,4]]

-- cabezas [1,4,5,2,3] == [[],[1],[1,4],[1,4,5],[1,4,5,2],[1,4,5,2,3]]

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

-- 1. Por recursión

cabezas :: [a] -> [[a]]

cabezas [] = [[]]

cabezas (x:xs) = [] : [x:ys | ys <- cabezas xs]

-- 2. Usando patrones de plegado.

cabezasP :: [a] -> [[a]]

cabezasP = foldr (\x y -> [x]:[x:ys | ys <- y]) []

-- 3. Usando colas y funciones de orden superior.

cabezas3 :: [a] -> [[a]]

cabezas3 xs = reverse (map reverse (colas (reverse xs)))

-- La anterior definición puede escribirse sin argumentos como

cabezas3' :: [a] -> [[a]]

cabezas3' = reverse . map reverse . (colas . reverse)

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

-- Ejercicio 10.2. Comprobar con QuickCheck que las funciones cabezas y

-- inits son equivalentes.

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

-- La propiedad es

prop_cabezas :: [Int] -> Bool

prop_cabezas xs = cabezas xs == inits xs

-- La comprobación es

-- *Main> quickCheck prop_cabezas

-- +++ OK, passed 100 tests.

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

-- Ejercicio 11.1. [La identidad de Bezout] Definir la función

-- bezout :: Integer -> Integer -> (Integer, Integer)

-- tal que (bezout a b) es un par de números x e y tal que a*x+b*y es el

-- máximo común divisor de a y b. Por ejemplo,

-- bezout 21 15 == (-2,3)

-- Indicación: Se puede usar la función quotRem tal que (quotRem x y) es

-- el par formado por el cociente y el resto de dividir x entre y.

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

-- Ejemplo de cálculo

-- a b q r

-- 36 21 1 15 (1)

-- 21 15 1 6 (2)

-- 15 6 2 3 (3)

-- 6 3 2 0

-- 3 0

-- Por tanto,

-- 3 = 15 - 6*2 [por (3)]

-- = 15 - (21-15*1)*2 [por (2)]

-- = 21*(-2) + 15*3

-- = 21*(-2)+ (36-21*1)*3 [por (1)]

-- = 36*3 + 21*(-5)

-- Sean q, r el cociente y el resto de a entre b, d el máximo común

-- denominador de a y b y (x,y) el valor de (bezout b r) . Entonces,

-- a = bp+r

-- d = bx+ry

-- Por tanto,

-- d = bx + (a-bp)y

-- = ay + b(x-qy)

-- Luego,

-- bezout a b = (y,x-qy)

bezout :: Integer -> Integer -> (Integer, Integer)

bezout _ 0 = (1,0)

bezout _ 1 = (0,1)

bezout a b = (y, x-q*y)

where (x,y) = bezout b r

(q,r) = quotRem a b

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

-- Ejercicio 11.2. Comprobar con QuickCheck que si a>0, b>0 y

-- (x,y) es el valor de (bezout a b), entonces a*x+b*y es igual al

-- máximo común divisor de a y b.

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

-- La propiedad es

prop_Bezout :: Integer -> Integer -> Property

prop_Bezout a b = a>0 && b>0 ==> a*x+b*y == gcd a b

where (x,y) = bezout a b

-- La comprobación es

-- Main> quickCheck prop_Bezout

-- OK, passed 100 tests.

Se puede imprimir o compartir con