I1M2011: Ejercicios de definiciones por recursión y comprensión y sobre cadenas en Haskell

La clase de hoy de Informática de 1º del Grado en Matemáticas hemos comentando las soluciones de ejercicios de las dos primeras partes de la 9ª relación.

La 1ª parte contiene ejercicios con definiciones por comprensión y recursión. En concreto, se estudian funciones para calcular

la compra de una persona agarrada y
la división de una lista numérica según su media.

La 2ª parte contiene ejercicios sobre cadenas. En concreto, se estudian funciones para calcular

la suma de los dígitos de una cadena,
la capitalización de una cadena,
el título con las reglas de mayúsculas iniciales,
la búsqueda en crucigramas,
las posiciones de un carácter en una cadena y
si una cadena es una subcadena de otra.

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 Data.Char
import Data.List
import Test.QuickCheck

-- ---------------------------------------------------------------------
-- Definiciones por comprensión y recursión                           --
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 1.1. Una persona es tan agarrada que sólo compra cuando le
-- hacen un descuento del 10% y el precio (con el descuento) es menor o
-- igual que 199. 
-- 
-- Definir, usando comprensión, la función
--    agarrado :: [Float] -> Float
-- tal que (agarrado ps) es el precio que tiene que pagar por una compra
-- cuya lista de precios es ps. Por ejemplo,
--    agarrado  [45.00, 199.00, 220.00, 399.00]  ==  417.59998
-- ---------------------------------------------------------------------

agarrado :: [Float] -> Float
agarrado ps = sum [p * 0.9 | p <- ps, p * 0.9 <= 199]

-- ---------------------------------------------------------------------
-- Ejercicio 1.2. Definir, por recursión, la función
--    agarradoRec :: [Float] -> Float
-- tal que (agarradoRec ps) es el precio que tiene que pagar por una compra
-- cuya lista de precios es ps. Por ejemplo,
--    agarradoRec  [45.00, 199.00, 220.00, 399.00]  ==  417.59998
-- ---------------------------------------------------------------------

agarradoRec :: [Float] -> Float
agarradoRec [] = 0
agarradoRec (p:ps)
    | precioConDescuento <= 199 = precioConDescuento + agarradoRec ps
    | otherwise                 = agarradoRec ps
    where precioConDescuento = p * 0.9 

-- ---------------------------------------------------------------------
-- Ejercicio 1.3. Comprobar con QuickCheck que ambas definiciones son
-- similares; es decir, el valor absoluto de su diferencia es menor que
-- una décima. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_agarrado :: [Float] -> Bool
prop_agarrado xs = abs (agarradoRec xs - agarrado xs) <= 0.1

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

-- ---------------------------------------------------------------------
-- Ejercicio 2.1. La función 
--    divideMedia :: [Double] -> ([Double],[Double])
-- dada una lista numérica, xs, calcula el par (ys,zs), donde ys 
-- contiene los elementos de xs estrictamente menores que la media, 
-- mientras que zs contiene los elementos de xs estrictamente mayores 
-- que la media. Por ejemplo, 
--    divideMedia [6,7,2,8,6,3,4] ==  ([2.0,3.0,4.0],[6.0,7.0,8.0,6.0])
--    divideMedia [1,2,3]         ==  ([1.0],[3.0])
-- Definir la función divideMedia por filtrado, comprensión y
-- recursión. 
-- ---------------------------------------------------------------------

-- La definición por filtrado es
divideMediaF :: [Double] -> ([Double],[Double])
divideMediaF xs = (filter (<m) xs, filter (>m) xs)
    where m = media xs

-- (media xs) es la media de xs. Por ejemplo,
--    media [1,2,3]       ==  2.0
--    media [1,-2,3.5,4]  ==  1.625 
-- Nota: En la definición de media se usa la función fromIntegral tal
-- que (fromIntegral x) es el número real correspondiente al número
-- entero x. 
media :: [Double] -> Double
media xs = (sum xs) / fromIntegral (length xs)

-- La definición por comprensión es
divideMediaC :: [Double] -> ([Double],[Double])
divideMediaC xs = ([x | x <- xs, x < m], [x | x <- xs, x > m])
    where m = media xs

-- La definición por recursión es
divideMediaR :: [Double] -> ([Double],[Double])
divideMediaR xs = divideMediaR' xs
    where m = media xs
          divideMediaR' [] = ([],[])
          divideMediaR' (x:xs) | x < m  = (x:ys, zs)
                               | x == m = (ys, zs)
                               | x > m  = (ys, x:zs)
                               where (ys, zs) = divideMediaR' xs

-- ---------------------------------------------------------------------
-- Ejercicio 2.2. Comprobar con QuickCheck que las tres definiciones
-- anteriores divideMediaF, divideMediaC y divideMediaR son
-- equivalentes.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_divideMedia :: [Double] -> Bool
prop_divideMedia xs =
    divideMediaC xs == d &&
    divideMediaR xs == d
    where d = divideMediaF xs 
    
-- La comprobación es
--    *Main> quickCheck prop_divideMedia
--    +++ OK, passed 100 tests.

-- ---------------------------------------------------------------------
-- Ejercicio 2.3. Comprobar con QuickCheck que si (ys,zs) es el par
-- obtenido aplicándole la función divideMediaF a xs, entonces la suma
-- de las longitudes de ys y zs es menor o igual que la longitud de xs.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_longitudDivideMedia :: [Double] -> Bool
prop_longitudDivideMedia xs =
    length ys + length zs <= length xs
    where (ys,zs) = divideMediaF xs

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

-- ---------------------------------------------------------------------
-- Ejercicio 2.4. Comprobar con QuickCheck que si (ys,zs) es el par
-- obtenido aplicándole la función divideMediaF a xs, entonces todos los
-- elementos de ys son menores que todos los elementos de zs.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_divideMediaMenores :: [Double] -> Bool
prop_divideMediaMenores xs =
    and [y < z | y <- ys, z <- zs]
    where (ys,zs) = divideMediaF xs

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

-- ---------------------------------------------------------------------
-- Ejercicio 2.5. Comprobar con QuickCheck que si (ys,zs) es el par
-- obtenido aplicándole la función divideMediaF a xs, entonces la
-- media de xs no pertenece a ys ni a zs.
-- Nota: Usar la función notElem tal que (notElem x ys) se verifica si y
-- no pertenece a ys.
-- ---------------------------------------------------------------------

-- La propiedad es
prop_divideMediaSinMedia :: [Double] -> Bool
prop_divideMediaSinMedia xs =
    notElem m (ys ++ zs)
    where  m       = media xs
           (ys,zs) = divideMediaF xs

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

-- ---------------------------------------------------------------------
-- Funciones sobre cadenas                                            --
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 2.1. Definir, por comprensión, la función
--    sumaDigitos :: String -> Int
-- tal que (sumaDigitos xs) es la suma de los dígitos de la cadena
-- xs. Por ejemplo, 
--    sumaDigitos "SE 2431 X"  ==  10
-- Nota: Usar las funciones isDigit y digitToInt.
-- ---------------------------------------------------------------------

sumaDigitos :: String -> Int
sumaDigitos xs = sum [digitToInt x | x <- xs, isDigit x]

-- ---------------------------------------------------------------------
-- Ejercicio 2.2. Definir, por recursión, la función
--    sumaDigitosRec :: String -> Int
-- tal que (sumaDigitosRec xs) es la suma de los dígitos de la cadena
-- xs. Por ejemplo, 
--    sumaDigitosRec "SE 2431 X"  ==  10
-- Nota: Usar las funciones isDigit y digitToInt.
-- ---------------------------------------------------------------------

sumaDigitosRec :: String -> Int
sumaDigitosRec [] = 0
sumaDigitosRec (x:xs) 
    | isDigit x  = digitToInt x + sumaDigitosRec xs
    | otherwise  = sumaDigitosRec xs

-- ---------------------------------------------------------------------
-- Ejercicio 2.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_sumaDigitos :: String -> Bool
prop_sumaDigitos xs = 
    sumaDigitos xs == sumaDigitosRec xs

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

-- ---------------------------------------------------------------------
-- Ejercicio 3.1. Definir, por comprensión, la función
--    mayusculaInicial :: String -> String
-- tal que (mayusculaInicial xs) es la palabra xs con la letra inicial
-- en mayúscula y las restantes en minúsculas. Por ejemplo, 
--    mayusculaInicial "sEviLLa"  ==  "Sevilla"
-- Nota: Usar las funciones toLower y toUpper.
-- ---------------------------------------------------------------------

mayusculaInicial :: String -> String
mayusculaInicial []     = []
mayusculaInicial (x:xs) = toUpper x : [toLower x | x <- xs]

-- ---------------------------------------------------------------------
-- Ejercicio 3.2. Definir, por recursión, la función
--    mayusculaInicialRec :: String -> String
-- tal que (mayusculaInicialRec xs) es la palabra xs con la letra
-- inicial en mayúscula y las restantes en minúsculas. Por ejemplo,
--    mayusculaInicialRec "sEviLLa"  ==  "Sevilla"
-- ---------------------------------------------------------------------

mayusculaInicialRec :: String -> String
mayusculaInicialRec [] = []
mayusculaInicialRec (x:xs) = toUpper x : aux xs
    where aux (x:xs) = toLower x : aux xs
          aux []     = []

-- ---------------------------------------------------------------------
-- Ejercicio 3.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_mayusculaInicial :: String -> Bool
prop_mayusculaInicial xs = 
    mayusculaInicial xs == mayusculaInicialRec xs

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

-- ---------------------------------------------------------------------
-- Ejercicio 4.1. Se consideran las siguientes reglas de mayúsculas
-- iniciales para los títulos: 
--    * la primera palabra comienza en mayúscula y
--    * todas las palabras que tienen 4 letras como mínimo empiezan
--      con mayúsculas
-- Definir, por comprensión, la función
--    titulo :: [String] -> [String]
-- tal que (titulo ps) es la lista de las palabras de ps con
-- las reglas de mayúsculas iniciales de los títulos. Por ejemplo,
--    *Main> titulo ["eL","arTE","DE","La","proGraMacion"]
--    ["El","Arte","de","la","Programacion"]
-- ---------------------------------------------------------------------

titulo :: [String] -> [String]
titulo []     = []
titulo (p:ps) = mayusculaInicial p : [transforma p | p <- ps]

-- (transforma p) es la palabra p con mayúscula inicial si su longitud
-- es mayor o igual que 4 y es p en minúscula en caso contrario
transforma :: String -> String
transforma p | length p >= 4 = mayusculaInicial p
             | otherwise     = minuscula p

-- (minuscula xs) es la palabra xs en minúscula.
minuscula :: String -> String
minuscula xs = [toLower x | x <- xs]

-- ---------------------------------------------------------------------
-- Ejercicio 4.2. Definir, por recursión, la función
--    tituloRec :: [String] -> [String]
-- tal que (tituloRec ps) es la lista de las palabras de ps con
-- las reglas de mayúsculas iniciales de los títulos. Por ejemplo,
--    *Main> tituloRec ["eL","arTE","DE","La","proGraMacion"]
--    ["El","Arte","de","la","Programacion"]
-- ---------------------------------------------------------------------

tituloRec :: [String] -> [String]
tituloRec []     = []
tituloRec (p:ps) = mayusculaInicial p : tituloRecAux ps
    where tituloRecAux []     = []
          tituloRecAux (p:ps) = transforma p : tituloRecAux ps

-- ---------------------------------------------------------------------
-- Ejercicio 4.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_titulo :: [String] -> Bool
prop_titulo xs = titulo xs == tituloRec xs

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

-- ---------------------------------------------------------------------
-- Ejercicio 5.1. Definir, por comprensión, la función
--    buscaCrucigrama :: Char -> Int -> Int -> [String] -> [String]
-- tal que (buscaCrucigrama l pos lon ps) es la lista de las palabras de
-- la lista de palabras ps que tienen longitud lon y poseen la letra l en
-- la posición pos (comenzando en 0). Por ejemplo,
--    *Main> buscaCrucigrama 'c' 1 7 ["ocaso", "casa", "ocupado"]
--    ["ocupado"]
-- ---------------------------------------------------------------------

buscaCrucigrama :: Char -> Int -> Int -> [String] -> [String]
buscaCrucigrama l pos lon ps =
    [p | p <- ps,  
         length p == lon, 
         0 <= pos,  pos < length p, 
         p !! pos == l]

-- ---------------------------------------------------------------------
-- Ejercicio 5.2. Definir, por recursión, la función
--    buscaCrucigramaRec :: Char -> Int -> Int -> [String] -> [String]
-- tal que (buscaCrucigramaRec l pos lon ps) es la lista de las palabras
-- de la lista de palabras ps que tienn longitud lon y posen la letra l
-- en la posición pos (comenzando en 0). Por ejemplo,
--    *Main> buscaCrucigramaRec 'c' 1 7 ["ocaso", "acabado", "ocupado"]
--    ["acabado","ocupado"]
-- ---------------------------------------------------------------------

buscaCrucigramaRec :: Char -> Int -> Int -> [String] -> [String]
buscaCrucigramaRec letra pos lon [] = []
buscaCrucigramaRec letra pos lon (p:ps) 
    | length p == lon && 0 <= pos && pos < length p && p !! pos == letra 
        = p : buscaCrucigramaRec letra pos lon ps
    | otherwise 
        = buscaCrucigramaRec letra pos lon ps

-- ---------------------------------------------------------------------
-- Ejercicio 5.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_buscaCrucigrama :: Char -> Int -> Int -> [String] -> Bool
prop_buscaCrucigrama letra pos lon ps =
    buscaCrucigrama letra pos lon ps == buscaCrucigramaRec letra pos lon ps

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

-- ---------------------------------------------------------------------
-- Ejercicio 6.1. Definir, por comprensión, la función
--    posiciones :: String -> Char -> [Int]
-- tal que (posiciones xs y) es la lista de la posiciones del carácter y
-- en la cadena xs. Por ejemplo,
--    posiciones "Salamamca" 'a'  ==  [1,3,5,8]
-- ---------------------------------------------------------------------

posiciones :: String -> Char -> [Int]
posiciones xs y = [n | (x,n) <- zip xs [0..], x == y]

-- ---------------------------------------------------------------------
-- Ejercicio 6.2. Definir, por recursión, la función
--    posicionesRec :: String -> Char -> [Int]
-- tal que (posicionesRec xs y) es la lista de la posiciones del
-- carácter y en la cadena xs. Por ejemplo,
--    posicionesRec "Salamamca" 'a'  ==  [1,3,5,8]
-- ---------------------------------------------------------------------

posicionesRec :: String -> Char -> [Int]
posicionesRec xs y = posicionesAux xs y 0
    where
      posicionesAux [] y n = []
      posicionesAux (x:xs) y n | x == y    = n : posicionesAux xs y (n+1)
                               | otherwise = posicionesAux xs y (n+1)

-- ---------------------------------------------------------------------
-- Ejercicio 6.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_posiciones :: String -> Char -> Bool
prop_posiciones xs y = 
    posiciones xs y == posicionesRec xs y

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

-- ---------------------------------------------------------------------
-- Ejercicio 7.1. Definir, por recursión, la función
--    contieneRec :: String -> String -> Bool
-- tal que (contieneRec xs ys) se verifica si ys es una subcadena de
-- xs. Por ejemplo, 
--    contieneRec "escasamente" "casa"   ==  True
--    contieneRec "escasamente" "cante"  ==  False
--    contieneRec "" ""                  ==  True
-- Nota: Se puede usar la predefinida (isPrefixOf ys xs) que se verifica
-- si ys es un prefijo de xs.
-- ---------------------------------------------------------------------

contieneRec :: String -> String -> Bool
contieneRec _ []  = True       
contieneRec [] ys = False
contieneRec xs ys = isPrefixOf ys xs || contieneRec (tail xs) ys

-- ---------------------------------------------------------------------
-- Ejercicio 7.2. Definir, por comprensión, la función
--    contiene :: String -> String -> Bool
-- tal que (contiene xs ys) se verifica si ys es una subcadena de
-- xs. Por ejemplo, 
--    contiene "escasamente" "casa"      ==  True
--    contiene "escasamente" "cante"     ==  False
--    contiene "casado y casada" "casa"  ==  True
--    contiene "" ""                     ==  True
-- Nota: Se puede usar la predefinida (isPrefixOf ys xs) que se verifica
-- si ys es un prefijo de xs.
-- ---------------------------------------------------------------------

contiene :: String -> String -> Bool
contiene xs ys = sufijosComenzandoCon xs ys /= []

-- (sufijosComenzandoCon xs ys) es la lista de los sufijos de xs que
-- comienzan con ys. Por ejemplo,
--    sufijosComenzandoCon "abacbad" "ba"  ==  ["bacbad","bad"]
sufijosComenzandoCon :: String -> String -> [String]
sufijosComenzandoCon xs ys = [x | x <- sufijos xs, isPrefixOf ys x]

-- (sufijos xs) es la lista de sufijos de xs. Por ejemplo,
--    sufijos "abc"  ==  ["abc","bc","c",""]
sufijos :: String -> [String]
sufijos xs = [drop i xs | i <- [0..length xs]]

-- ---------------------------------------------------------------------
-- Ejercicio 7.3. Comprobar con QuickCheck que ambas definiciones son
-- equivalentes. 
-- ---------------------------------------------------------------------

-- La propiedad es
prop_contiene :: String -> String -> Bool
prop_contiene xs ys = 
    contieneRec xs ys == contiene xs ys

-- La comprobación es
--    *Main> quickCheck prop_contiene
--    +++ 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

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

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

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

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

import Data.Char

import Data.List

import Test.QuickCheck

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

-- Definiciones por comprensión y recursión --

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

-- Ejercicio 1.1. Una persona es tan agarrada que sólo compra cuando le

-- hacen un descuento del 10% y el precio (con el descuento) es menor o

-- igual que 199.

-- Definir, usando comprensión, la función

-- agarrado :: [Float] -> Float

-- tal que (agarrado ps) es el precio que tiene que pagar por una compra

-- cuya lista de precios es ps. Por ejemplo,

-- agarrado [45.00, 199.00, 220.00, 399.00] == 417.59998

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

agarrado :: [Float] -> Float

agarrado ps = sum [p * 0.9 | p <- ps, p * 0.9 <= 199]

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

-- Ejercicio 1.2. Definir, por recursión, la función

-- agarradoRec :: [Float] -> Float

-- tal que (agarradoRec ps) es el precio que tiene que pagar por una compra

-- cuya lista de precios es ps. Por ejemplo,

-- agarradoRec [45.00, 199.00, 220.00, 399.00] == 417.59998

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

agarradoRec :: [Float] -> Float

agarradoRec [] = 0

agarradoRec (p:ps)

| precioConDescuento <= 199 = precioConDescuento + agarradoRec ps

| otherwise = agarradoRec ps

where precioConDescuento = p * 0.9

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

-- Ejercicio 1.3. Comprobar con QuickCheck que ambas definiciones son

-- similares; es decir, el valor absoluto de su diferencia es menor que

-- una décima.

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

-- La propiedad es

prop_agarrado :: [Float] -> Bool

prop_agarrado xs = abs (agarradoRec xs - agarrado xs) <= 0.1

-- La comprobación es

-- *Main> quickCheck prop_agarrado

-- +++ OK, passed 100 tests.

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

-- Ejercicio 2.1. La función

-- divideMedia :: [Double] -> ([Double],[Double])

-- dada una lista numérica, xs, calcula el par (ys,zs), donde ys

-- contiene los elementos de xs estrictamente menores que la media,

-- mientras que zs contiene los elementos de xs estrictamente mayores

-- que la media. Por ejemplo,

-- divideMedia [6,7,2,8,6,3,4] == ([2.0,3.0,4.0],[6.0,7.0,8.0,6.0])

-- divideMedia [1,2,3] == ([1.0],[3.0])

-- Definir la función divideMedia por filtrado, comprensión y

-- recursión.

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

-- La definición por filtrado es

divideMediaF :: [Double] -> ([Double],[Double])

divideMediaF xs = (filter (<m) xs, filter (>m) xs)

where m = media xs

-- (media xs) es la media de xs. Por ejemplo,

-- media [1,2,3] == 2.0

-- media [1,-2,3.5,4] == 1.625

-- Nota: En la definición de media se usa la función fromIntegral tal

-- que (fromIntegral x) es el número real correspondiente al número

-- entero x.

media :: [Double] -> Double

media xs = (sum xs) / fromIntegral (length xs)

-- La definición por comprensión es

divideMediaC :: [Double] -> ([Double],[Double])

divideMediaC xs = ([x | x <- xs, x < m], [x | x <- xs, x > m])

where m = media xs

-- La definición por recursión es

divideMediaR :: [Double] -> ([Double],[Double])

divideMediaR xs = divideMediaR' xs

where m = media xs

divideMediaR' [] = ([],[])

divideMediaR' (x:xs) | x < m = (x:ys, zs)

| x == m = (ys, zs)

| x > m = (ys, x:zs)

where (ys, zs) = divideMediaR' xs

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

-- Ejercicio 2.2. Comprobar con QuickCheck que las tres definiciones

-- anteriores divideMediaF, divideMediaC y divideMediaR son

-- equivalentes.

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

-- La propiedad es

prop_divideMedia :: [Double] -> Bool

prop_divideMedia xs =

divideMediaC xs == d &&

divideMediaR xs == d

where d = divideMediaF xs

-- La comprobación es

-- *Main> quickCheck prop_divideMedia

-- +++ OK, passed 100 tests.

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

-- Ejercicio 2.3. Comprobar con QuickCheck que si (ys,zs) es el par

-- obtenido aplicándole la función divideMediaF a xs, entonces la suma

-- de las longitudes de ys y zs es menor o igual que la longitud de xs.

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

-- La propiedad es

prop_longitudDivideMedia :: [Double] -> Bool

prop_longitudDivideMedia xs =

length ys + length zs <= length xs

where (ys,zs) = divideMediaF xs

-- La comprobación es

-- *Main> quickCheck prop_longitudDivideMedia

-- +++ OK, passed 100 tests.

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

-- Ejercicio 2.4. Comprobar con QuickCheck que si (ys,zs) es el par

-- obtenido aplicándole la función divideMediaF a xs, entonces todos los

-- elementos de ys son menores que todos los elementos de zs.

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

-- La propiedad es

prop_divideMediaMenores :: [Double] -> Bool

prop_divideMediaMenores xs =

and [y < z | y <- ys, z <- zs]

where (ys,zs) = divideMediaF xs

-- La comprobación es

-- *Main> quickCheck prop_divideMediaMenores

-- +++ OK, passed 100 tests.

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

-- Ejercicio 2.5. Comprobar con QuickCheck que si (ys,zs) es el par

-- obtenido aplicándole la función divideMediaF a xs, entonces la

-- media de xs no pertenece a ys ni a zs.

-- Nota: Usar la función notElem tal que (notElem x ys) se verifica si y

-- no pertenece a ys.

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

-- La propiedad es

prop_divideMediaSinMedia :: [Double] -> Bool

prop_divideMediaSinMedia xs =

notElem m (ys ++ zs)

where m = media xs

(ys,zs) = divideMediaF xs

-- La comprobación es

-- *Main> quickCheck prop_divideMediaSinMedia

-- +++ OK, passed 100 tests.

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

-- Funciones sobre cadenas --

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

-- Ejercicio 2.1. Definir, por comprensión, la función

-- sumaDigitos :: String -> Int

-- tal que (sumaDigitos xs) es la suma de los dígitos de la cadena

-- xs. Por ejemplo,

-- sumaDigitos "SE 2431 X" == 10

-- Nota: Usar las funciones isDigit y digitToInt.

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

sumaDigitos :: String -> Int

sumaDigitos xs = sum [digitToInt x | x <- xs, isDigit x]

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

-- Ejercicio 2.2. Definir, por recursión, la función

-- sumaDigitosRec :: String -> Int

-- tal que (sumaDigitosRec xs) es la suma de los dígitos de la cadena

-- xs. Por ejemplo,

-- sumaDigitosRec "SE 2431 X" == 10

-- Nota: Usar las funciones isDigit y digitToInt.

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

sumaDigitosRec :: String -> Int

sumaDigitosRec [] = 0

sumaDigitosRec (x:xs)

| isDigit x = digitToInt x + sumaDigitosRec xs

| otherwise = sumaDigitosRec xs

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

-- Ejercicio 2.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_sumaDigitos :: String -> Bool

prop_sumaDigitos xs =

sumaDigitos xs == sumaDigitosRec xs

-- La comprobación es

-- *Main> quickCheck prop_sumaDigitos

-- +++ OK, passed 100 tests.

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

-- Ejercicio 3.1. Definir, por comprensión, la función

-- mayusculaInicial :: String -> String

-- tal que (mayusculaInicial xs) es la palabra xs con la letra inicial

-- en mayúscula y las restantes en minúsculas. Por ejemplo,

-- mayusculaInicial "sEviLLa" == "Sevilla"

-- Nota: Usar las funciones toLower y toUpper.

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

mayusculaInicial :: String -> String

mayusculaInicial [] = []

mayusculaInicial (x:xs) = toUpper x : [toLower x | x <- xs]

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

-- Ejercicio 3.2. Definir, por recursión, la función

-- mayusculaInicialRec :: String -> String

-- tal que (mayusculaInicialRec xs) es la palabra xs con la letra

-- inicial en mayúscula y las restantes en minúsculas. Por ejemplo,

-- mayusculaInicialRec "sEviLLa" == "Sevilla"

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

mayusculaInicialRec :: String -> String

mayusculaInicialRec [] = []

mayusculaInicialRec (x:xs) = toUpper x : aux xs

where aux (x:xs) = toLower x : aux xs

aux [] = []

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

-- Ejercicio 3.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_mayusculaInicial :: String -> Bool

prop_mayusculaInicial xs =

mayusculaInicial xs == mayusculaInicialRec xs

-- La comprobación es

-- *Main> quickCheck prop_mayusculaInicial

-- +++ OK, passed 100 tests.

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

-- Ejercicio 4.1. Se consideran las siguientes reglas de mayúsculas

-- iniciales para los títulos:

-- * la primera palabra comienza en mayúscula y

-- * todas las palabras que tienen 4 letras como mínimo empiezan

-- con mayúsculas

-- Definir, por comprensión, la función

-- titulo :: [String] -> [String]

-- tal que (titulo ps) es la lista de las palabras de ps con

-- las reglas de mayúsculas iniciales de los títulos. Por ejemplo,

-- *Main> titulo ["eL","arTE","DE","La","proGraMacion"]

-- ["El","Arte","de","la","Programacion"]

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

titulo :: [String] -> [String]

titulo [] = []

titulo (p:ps) = mayusculaInicial p : [transforma p | p <- ps]

-- (transforma p) es la palabra p con mayúscula inicial si su longitud

-- es mayor o igual que 4 y es p en minúscula en caso contrario

transforma :: String -> String

transforma p | length p >= 4 = mayusculaInicial p

| otherwise = minuscula p

-- (minuscula xs) es la palabra xs en minúscula.

minuscula :: String -> String

minuscula xs = [toLower x | x <- xs]

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

-- Ejercicio 4.2. Definir, por recursión, la función

-- tituloRec :: [String] -> [String]

-- tal que (tituloRec ps) es la lista de las palabras de ps con

-- las reglas de mayúsculas iniciales de los títulos. Por ejemplo,

-- *Main> tituloRec ["eL","arTE","DE","La","proGraMacion"]

-- ["El","Arte","de","la","Programacion"]

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

tituloRec :: [String] -> [String]

tituloRec [] = []

tituloRec (p:ps) = mayusculaInicial p : tituloRecAux ps

where tituloRecAux [] = []

tituloRecAux (p:ps) = transforma p : tituloRecAux ps

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

-- Ejercicio 4.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_titulo :: [String] -> Bool

prop_titulo xs = titulo xs == tituloRec xs

-- La comprobación es

-- *Main> quickCheck prop_titulo

-- +++ OK, passed 100 tests.

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

-- Ejercicio 5.1. Definir, por comprensión, la función

-- buscaCrucigrama :: Char -> Int -> Int -> [String] -> [String]

-- tal que (buscaCrucigrama l pos lon ps) es la lista de las palabras de

-- la lista de palabras ps que tienen longitud lon y poseen la letra l en

-- la posición pos (comenzando en 0). Por ejemplo,

-- *Main> buscaCrucigrama 'c' 1 7 ["ocaso", "casa", "ocupado"]

-- ["ocupado"]

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

buscaCrucigrama :: Char -> Int -> Int -> [String] -> [String]

buscaCrucigrama l pos lon ps =

[p | p <- ps,

length p == lon,

0 <= pos, pos < length p,

p !! pos == l]

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

-- Ejercicio 5.2. Definir, por recursión, la función

-- buscaCrucigramaRec :: Char -> Int -> Int -> [String] -> [String]

-- tal que (buscaCrucigramaRec l pos lon ps) es la lista de las palabras

-- de la lista de palabras ps que tienn longitud lon y posen la letra l

-- en la posición pos (comenzando en 0). Por ejemplo,

-- *Main> buscaCrucigramaRec 'c' 1 7 ["ocaso", "acabado", "ocupado"]

-- ["acabado","ocupado"]

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

buscaCrucigramaRec :: Char -> Int -> Int -> [String] -> [String]

buscaCrucigramaRec letra pos lon [] = []

buscaCrucigramaRec letra pos lon (p:ps)

| length p == lon && 0 <= pos && pos < length p && p !! pos == letra

= p : buscaCrucigramaRec letra pos lon ps

| otherwise

= buscaCrucigramaRec letra pos lon ps

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

-- Ejercicio 5.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_buscaCrucigrama :: Char -> Int -> Int -> [String] -> Bool

prop_buscaCrucigrama letra pos lon ps =

buscaCrucigrama letra pos lon ps == buscaCrucigramaRec letra pos lon ps

-- La comprobación es

-- *Main> quickCheck prop_buscaCrucigrama

-- +++ OK, passed 100 tests.

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

-- Ejercicio 6.1. Definir, por comprensión, la función

-- posiciones :: String -> Char -> [Int]

-- tal que (posiciones xs y) es la lista de la posiciones del carácter y

-- en la cadena xs. Por ejemplo,

-- posiciones "Salamamca" 'a' == [1,3,5,8]

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

posiciones :: String -> Char -> [Int]

posiciones xs y = [n | (x,n) <- zip xs [0..], x == y]

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

-- Ejercicio 6.2. Definir, por recursión, la función

-- posicionesRec :: String -> Char -> [Int]

-- tal que (posicionesRec xs y) es la lista de la posiciones del

-- carácter y en la cadena xs. Por ejemplo,

-- posicionesRec "Salamamca" 'a' == [1,3,5,8]

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

posicionesRec :: String -> Char -> [Int]

posicionesRec xs y = posicionesAux xs y 0

where

posicionesAux [] y n = []

posicionesAux (x:xs) y n | x == y = n : posicionesAux xs y (n+1)

| otherwise = posicionesAux xs y (n+1)

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

-- Ejercicio 6.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_posiciones :: String -> Char -> Bool

prop_posiciones xs y =

posiciones xs y == posicionesRec xs y

-- La comprobación es

-- *Main> quickCheck prop_posiciones

-- +++ OK, passed 100 tests.

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

-- Ejercicio 7.1. Definir, por recursión, la función

-- contieneRec :: String -> String -> Bool

-- tal que (contieneRec xs ys) se verifica si ys es una subcadena de

-- xs. Por ejemplo,

-- contieneRec "escasamente" "casa" == True

-- contieneRec "escasamente" "cante" == False

-- contieneRec "" "" == True

-- Nota: Se puede usar la predefinida (isPrefixOf ys xs) que se verifica

-- si ys es un prefijo de xs.

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

contieneRec :: String -> String -> Bool

contieneRec _ [] = True

contieneRec [] ys = False

contieneRec xs ys = isPrefixOf ys xs || contieneRec (tail xs) ys

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

-- Ejercicio 7.2. Definir, por comprensión, la función

-- contiene :: String -> String -> Bool

-- tal que (contiene xs ys) se verifica si ys es una subcadena de

-- xs. Por ejemplo,

-- contiene "escasamente" "casa" == True

-- contiene "escasamente" "cante" == False

-- contiene "casado y casada" "casa" == True

-- contiene "" "" == True

-- Nota: Se puede usar la predefinida (isPrefixOf ys xs) que se verifica

-- si ys es un prefijo de xs.

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

contiene :: String -> String -> Bool

contiene xs ys = sufijosComenzandoCon xs ys /= []

-- (sufijosComenzandoCon xs ys) es la lista de los sufijos de xs que

-- comienzan con ys. Por ejemplo,

-- sufijosComenzandoCon "abacbad" "ba" == ["bacbad","bad"]

sufijosComenzandoCon :: String -> String -> [String]

sufijosComenzandoCon xs ys = [x | x <- sufijos xs, isPrefixOf ys x]

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

-- sufijos "abc" == ["abc","bc","c",""]

sufijos :: String -> [String]

sufijos xs = [drop i xs | i <- [0..length xs]]

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

-- Ejercicio 7.3. Comprobar con QuickCheck que ambas definiciones son

-- equivalentes.

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

-- La propiedad es

prop_contiene :: String -> String -> Bool

prop_contiene xs ys =

contieneRec xs ys == contiene xs ys

-- La comprobación es

-- *Main> quickCheck prop_contiene

-- +++ OK, passed 100 tests.

Se puede imprimir o compartir con