Tema 13: Programas interactivos

1 Programas interactivos

Ejemplo de programa interactivo

ghci> longitudCadena
Escribe una cadena: "Hoy es lunes"
La cadena tiene 14 caracteres
longitudCadena :: IO ()
longitudCadena = do
  putStr "Escribe una cadena: "
  xs <- getLine
  putStr "La cadena tiene "
  putStr (show (length xs))
  putStrLn " caracteres"

2 El tipo de las acciones de entrada/salida

3 Acciones básicas

ghci> putChar 'b'
bghci> it
()

4 Secuenciación

ghci> ejSecuenciacion
b f
('b','f')
ejSecuenciacion :: IO (Char,Char)
ejSecuenciacion = do
   x <- getChar
   getChar
   y <- getChar
   return (x,y)

5 Primitivas derivadas

getLine :: IO String
getLine = do x <- getChar
             if x == '\n' then return []
                else do xs <- getLine
                        return (x:xs)
putStr :: String -> IO ()
putStr []     = return ()
putStr (x:xs) = do putChar x
                   putStr xs
putStrLn :: String -> IO ()
putStrLn xs = do putStr xs
                 putChar '\n'
ghci> sequence_ [putStrLn "uno", putStrLn "dos"]
uno
dos
ghci> it
()
sequence_ :: [IO a] -> IO ()
sequence_ []     = return ()
sequence_ (a:as) = do a
                      sequence_ as

Ejemplo de programa con primitivas derivadas

ghci> longitudCadena
Escribe una cadena: "Hoy es lunes"
La cadena tiene 14 caracteres
longitudCadena :: IO ()
longitudCadena = do
   putStr "Escribe una cadena: "
   xs <- getLine
   putStr "La cadena tiene "
   putStr (show (length xs))
   putStrLn " caracteres"

6 Ejemplos de programas interactivos

6.1 Juego de adivinación interactivo

Main> juego
Piensa un numero entre el 1 y el 100.
Es 50? [mayor/menor/exacto] mayor
Es 75? [mayor/menor/exacto] menor
Es 62? [mayor/menor/exacto] mayor
Es 68? [mayor/menor/exacto] exacto
Fin del juego
juego :: IO ()
juego =
    do putStrLn "Piensa un numero entre el 1 y el 100."
       adivina 1 100
       putStrLn "Fin del juego"

adivina :: Int -> Int -> IO ()
adivina a b =
    do putStr ("Es " ++ show conjetura ++ "? [mayor/menor/exacto] ")
       s <- getLine
       case s of
         "mayor"  -> adivina (conjetura+1) b
         "menor"  -> adivina a (conjetura-1)
         "exacto" -> return ()
         _        -> adivina a b
    where
      conjetura = (a+b) `div` 2
Main> juego2
Tienes que adivinar un numero entre 1 y 100
Escribe un numero: 50
 es bajo.
Escribe un numero: 75
 es alto.
Escribe un numero: 62
 Exactamente
import System.Random (randomRIO)
juego2 :: IO ()
juego2 = do n <- randomRIO (1::Int,100)
            putStrLn "Tienes que adivinar un numero entre 1 y 100"
            adivina' n

adivina' :: Int -> IO ()
adivina' n = 
    do putStr "Escribe un numero: "
       c <- getLine
       let x = read c 
       case (compare x n) of
         LT -> do putStrLn " es bajo."
                  adivina' n
         GT -> do putStrLn " es alto."
                  adivina' n
         EQ -> putStrLn " Exactamente"

6.2 Calculadora aritmética

Acciones auxiliares

import I1M.Analizador
import System.IO
getCh :: IO Char
getCh = do hSetEcho stdin False
           c <- getChar
           hSetEcho stdin True
           return c
limpiaPantalla :: IO ()
limpiaPantalla = putStr "\ESC[2J"
type Pos = (Int,Int)

irA :: Pos -> IO ()
irA (x,y) = putStr ("\ESC[" ++ 
                    show y ++ ";" ++ show x ++ 
                    "H")

escribeEn :: Pos -> String -> IO ()
escribeEn p xs = do irA p
                    putStr xs

Calculadora

calculadora :: IO ()
calculadora = do limpiaPantalla
                 escribeCalculadora
                 limpiar

escribeCalculadora :: IO ()
escribeCalculadora =  
    do limpiaPantalla
       sequence_ [escribeEn (1,y) xs 
                  | (y,xs) <- zip [1..13] imagenCalculadora]
       putStrLn ""

imagenCalculadora :: [String]
imagenCalculadora = ["+---------------+",
                     "|               |",
                     "+---+---+---+---+",
                     "| q | c | d | = |",
                     "+---+---+---+---+",
                     "| 1 | 2 | 3 | + |",
                     "+---+---+---+---+",
                     "| 4 | 5 | 6 | - |",
                     "+---+---+---+---+",
                     "| 7 | 8 | 9 | * |",
                     "+---+---+---+---+",
                     "| 0 | ( | ) | / |",
                     "+---+---+---+---+"]
    

Los primeros cuatro botones permiten escribir las órdenes:

Los restantes botones permiten escribir las expresiones.

limpiar :: IO ()
limpiar = calc ""

calc :: String -> IO ()
calc xs = do escribeEnPantalla xs 
             c <- getCh
             if elem c botones 
                then procesa c xs
                else do calc xs

escribeEnPantalla xs = 
    do escribeEn (3,2) "             "
       escribeEn (3,2) (reverse (take 13 (reverse xs)))

botones :: String
botones = standard ++ extra
    where
      standard = "qcd=123+456-789*0()/"
      extra    = "QCD \ESC\BS\DEL\n"

procesa :: Char -> String -> IO ()
procesa c xs
   | elem c "qQ\ESC"    = salir
   | elem c "dD\BS\DEL" = borrar xs
   | elem c "=\n"       = evaluar xs
   | elem c "cC"        = limpiar
   | otherwise          = agregar c xs

salir :: IO ()
salir = irA (1,14)

borrar :: String -> IO ()
borrar "" = calc ""
borrar xs = calc (init xs)

evaluar :: String -> IO ()
evaluar xs = case analiza expr xs of
             [(n,"")] -> calc (show n)
             _        -> do calc xs

agregar :: Char -> String -> IO ()
agregar c xs = calc (xs ++ [c])

6.3 El juego de la vida

Descripción del juego de la vida

Funciones anteriores

import Data.List (nub)

type Pos = (Int,Int)

irA :: Pos -> IO ()
irA (x,y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")

escribeEn :: Pos -> String -> IO ()
escribeEn p xs = do irA p
                    putStr xs

limpiaPantalla:: IO ()
limpiaPantalla= putStr "\ESC[2J"

El tablero del juego de la vida

type Tablero = [Pos]
ancho :: Int
ancho = 5

alto :: Int
alto = 5

El juego de la vida

ejTablero :: Tablero
ejTablero = [(2,3),(3,4),(4,2),(4,3),(4,4)]
 1234
1
2   O
3 O O
4  OO
vida 100000 ejTablero  
vida :: Int -> Tablero -> IO ()
vida n t = do limpiaPantalla
              escribeTablero t
              espera n
              vida n (siguienteGeneracion t)
escribeTablero :: Tablero -> IO ()
escribeTablero t = sequence_ [escribeEn p "O" | p <- t]
espera :: Int -> IO ()
espera n = sequence_ [return () | _ <- [1..n]]
ghci> siguienteGeneracion ejTablero  
[(4,3),(3,4),(4,4),(3,2),(5,3)]  
siguienteGeneracion :: Tablero -> Tablero
siguienteGeneracion t = supervivientes t ++ nacimientos t
supervivientes ejTablero  ==  [(4,3),(3,4),(4,4)]  
supervivientes :: Tablero -> [Pos]
supervivientes t = [p | p <- t, 
                        elem (nVecinosVivos t p) [2,3]]
nVecinosVivos ejTablero (3,3)  ==  5
nVecinosVivos ejTablero (3,4)  ==  3
nVecinosVivos :: Tablero -> Pos -> Int
nVecinosVivos t = length . filter (tieneVida t) . vecinos
vecinos (2,3) == [(1,2),(2,2),(3,2),(1,3),(3,3),(1,4),(2,4),(3,4)]
vecinos (1,2) == [(5,1),(1,1),(2,1),(5,2),(2,2),(5,3),(1,3),(2,3)]
vecinos (5,2) == [(4,1),(5,1),(1,1),(4,2),(1,2),(4,3),(5,3),(1,3)]
vecinos (2,1) == [(1,5),(2,5),(3,5),(1,1),(3,1),(1,2),(2,2),(3,2)]
vecinos (2,5) == [(1,4),(2,4),(3,4),(1,5),(3,5),(1,1),(2,1),(3,1)]
vecinos (1,1) == [(5,5),(1,5),(2,5),(5,1),(2,1),(5,2),(1,2),(2,2)]
vecinos (5,5) == [(4,4),(5,4),(1,4),(4,5),(1,5),(4,1),(5,1),(1,1)]
vecinos :: Pos -> [Pos]
vecinos (x,y) = map modular [(x-1,y-1), (x,y-1), (x+1,y-1), 
                             (x-1,y),            (x+1,y), 
                             (x-1,y+1), (x,y+1), (x+1,y+1)] 
modular (6,3)  ==  (1,3)
modular (0,3)  ==  (5,3)
modular (3,6)  ==  (3,1)
modular (3,0)  ==  (3,5)
modular :: Pos -> Pos
modular (x,y) = (1 + (x-1) `mod` ancho, 
                 1 + (y-1) `mod` alto)
tieneVida ejTablero (1,1)  ==  False
tieneVida ejTablero (2,3)  ==  True
tieneVida :: Tablero -> Pos -> Bool
tieneVida t p = elem p t
noTieneVida ejTablero (1,1)  ==  True
noTieneVida ejTablero (2,3)  ==  False
noTieneVida :: Tablero -> Pos -> Bool
noTieneVida t p = not (tieneVida t p)
nacimientos ejTablero  ==  [(3,2),(5,3)]  
nacimientos' :: Tablero -> [Pos]
nacimientos' t = [(x,y) | x <- [1..ancho],
                          y <- [1..alto],
                          noTieneVida t (x,y),
                          nVecinosVivos t (x,y) == 3]
nacimientos :: Tablero -> [Pos]
nacimientos t = [p | p <- nub (concatMap vecinos t),
                     noTieneVida t p,
                     nVecinosVivos t p == 3]

7 Representación gráfica de funciones con gnuplot

Instalación de programas

cabal install gnuplot

Uso de gnuplot

import Graphics.Gnuplot.Simple

Representación de funciones con plotFunc

dib0 :: IO ()
dib0 = plotFunc [] [0,0.01..10 :: Double] cos

Rango lineal

xRango 5 (0,10)  ==  [0.0,2.0,4.0,6.0,8.0,10.0]
xRango :: Integer -> (Double,Double) -> [Double]
xRango n i = linearScale n i

Atributos de los gráficos

dib1a = 
    plotFunc [EPS "ej.eps"] (xRango 500 (-10,10)) sin
dib1b = 
    plotFunc [Grid (Just ["x"])] (xRango 500 (-10,10)) sin
dib1c = 
    plotFunc [Grid (Just ["y"])] (xRango 500 (-10,10)) sin
dib1d = 
    plotFunc [Grid (Just [])] (xRango 500 (-10,10)) sin
dib1e = 
    plotFunc [Title "La funcion seno", Key Nothing] 
             (xRango 1000 (-10,10)) sin
dib1f = 
    plotFunc [XLabel "Eje horizontal"] (xRango 1000 (-10,10)) sin

Dibujo de listas de puntos con plotList

dib2 = 
    plotList [] (take 30 fibs)
    where fibs :: [Double] 
          fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

Gráficas conjuntas

dib3 = 
    plotFuncs [] (xRango 1000 (-10,10)) [sin, cos]

Gráfico de curvas paramétricas

dib4 =
    plotParamFunc [Key Nothing] 
                  (xRango 1000 (0,2*pi)) 
                  (\t -> (12*sin(t)-4*sin(3*t),
                          13*cos(t)-5*cos(2*t)-2*cos(3*t)-cos(4*t))) 

Representación de superficies con plotFunc3d

dib5 = 
    plotFunc3d [] [] xs xs (\x y -> exp(-(x*x+y*y)))
    where xs = [-2,-1.8..2::Double]

8 Manejo de ficheros

Lectura de ficheros con readFile

Este fichero tiene tres lineas
esta es la segunda y
esta es la tercera.
λ> :type readFile
readFile :: FilePath -> IO String

λ> readFile "Ejemplo_1.txt"
"Este fichero tiene tres lineas\nesta es la segunda y\nesta es la tercera.\n"

λ> putStrLn it
Este fichero tiene tres lineas
esta es la segunda y
esta es la tercera.

λ> cs <- readFile "Ejemplo_1.txt"
λ> putStrLn cs
Este fichero tiene tres lineas
esta es la segunda y
esta es la tercera.
λ> muestraContenidoFichero "Ejemplo_1.txt"
Este fichero tiene tres lineas
esta es la segunda y
esta es la tercera.

El programa es

muestraContenidoFichero :: FilePath -> IO ()
muestraContenidoFichero f = do
  cs <- readFile f
  putStrLn cs

Escritura en ficheros con writeFile

λ> :type writeFile
writeFile :: FilePath -> String -> IO ()
λ> let texto = "Hay\ntres lineas\nde texto"
λ> writeFile "Ejemplo_2.txt" texto
λ> muestraContenidoFichero "Ejemplo_2.txt"
Hay
tres lineas
de texto
λ> muestraContenidoFichero "Ejemplo_1.txt"
Este fichero tiene tres lineas
esta es la segunda y
esta es la tercera.

λ> aMayuscula "Ejemplo_1.txt" "Ejemplo_3.txt"
λ> muestraContenidoFichero "Ejemplo_3.txt"
ESTE FICHERO TIENE TRES LINEAS
ESTA ES LA SEGUNDA Y
ESTA ES LA TERCERA.

El programa es

import Data.Char (toUpper)

aMayuscula f1 f2 = do
  contenido <- readFile f1
  writeFile f2 (map toUpper contenido)  
λ> muestraContenidoFichero "Ejemplo_4a.txt"
Juan Ramos
Ana Ruiz
Luis Garcia
Blanca Perez

λ> ordenaFichero "Ejemplo_4a.txt" "Ejemplo_4b.txt"
λ> muestraContenidoFichero "Ejemplo_4b.txt"
Ana Ruiz
Blanca Perez
Juan Ramos
Luis Garcia

El programa es

import Data.List (sort)

ordenaFichero :: FilePath -> FilePath -> IO ()
ordenaFichero f1 f2 = do
  cs <- readFile f1
  writeFile f2 ((unlines . sort . lines) cs)
λ> :type lines
lines :: String -> [String]
λ> :type unlines
unlines :: [String] -> String

λ> unlines ["ayer fue martes", "hoy es miercoles","de enero"] 
"ayer fue martes\nhoy es miercoles\nde enero\n"
λ> lines it
["ayer fue martes","hoy es miercoles","de enero"]
λ> :type words
words :: String -> [String]
λ> :type unwords
unwords :: [String] -> String

λ> words "ayer fue   martes"
["ayer","fue","martes"]
λ> unwords it
"ayer fue martes"
λ> tablaCuadrados "cuadrados.txt" 9
λ> muestraContenidoFichero "cuadrados.txt"
(1,1) (2,4) (3,9) (4,16) (5,25) (6,36) (7,49) (8,64) (9,81)

El programa es

tablaCuadrados :: FilePath -> Int -> IO ()
tablaCuadrados f n =
  writeFile f (listaDeCuadrados n)

listaDeCuadrados :: Int -> String
listaDeCuadrados n =
  unwords (map show [(x,x*x) | x <- [1..n]])
λ> tablaCuadrados2 "cuadrados.txt" 5
λ> muestraContenidoFichero "cuadrados.txt"
(1,1)
(2,4)
(3,9)
(4,16)
(5,25)

El programa es

tablaCuadrados2 :: FilePath -> Int -> IO ()
tablaCuadrados2 f n =
  writeFile f (listaDeCuadrados2 n)

listaDeCuadrados2 :: Int -> String
listaDeCuadrados2 n =
  unlines (map show [(x,x*x) | x <- [1..n]])
λ> tablaLogaritmos "z.txt" [1,3..20]
λ> muestraContenidoFichero "z.txt"
+----+----------------+
| n  | log(n)         |
+----+----------------+
|  1 | 0.000000000000 |
|  3 | 1.098612288668 |
|  5 | 1.609437912434 |
|  7 | 1.945910149055 |
|  9 | 2.197224577336 |
| 11 | 2.397895272798 |
| 13 | 2.564949357462 |
| 15 | 2.708050201102 |
| 17 | 2.833213344056 |
| 19 | 2.944438979166 |
+----+----------------+

El programa es

import Text.Printf

tablaLogaritmos :: FilePath -> [Int] -> IO ()
tablaLogaritmos f ns = do
  writeFile f (tablaLogaritmosAux ns)

tablaLogaritmosAux :: [Int] -> String
tablaLogaritmosAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %2d | %.12f |\n" n x
            | n <- ns
            , let x = log (fromIntegral n) :: Double]
  ++ linea

linea, cabecera :: String
linea    = "+----+----------------+\n"
cabecera = "| n  | log(n)         |\n"

9 Bibliografía



Universidad de Sevilla

José A. Alonso Jiménez
Grupo de Lógica Computacional
Dpto. de Ciencias de la Computación e I.A.
Universidad de Sevilla