Programación Funcional con Scheme parte III

;;----------------------------------------------------------------;;
;; Ejercicio 1
;; Contrato: dada una posición en una lista,
;; devuelve el elemento en ESA posición, sin
;; modificar la lista.
;;-----------------------------------------------------------------;;

(define obtener_elemento (lambda (n lista)
(letrec(
(devolver_n (lambda (cont n lista)
(if (null? lista)
"null"
(if (= n cont)
(car lista)
(devolver_n (+ cont 1) n (cdr lista))
);if
);if
);lambda
);devolver_n
)
(devolver_n 1 n lista)
);let
);lambda
);define

(obtener_elemento 1 (list '11 '12 '13 '14 '())) ;=> 11


;;---------------------------------------------------------------------------;;
;; Contrato: dada una posicion en una lista,
;; devuelve el lado izquierdo de la misma.
;;---------------------------------------------------------------------------;;

(define devolver_l_izquierdo (lambda (posicion lista)
(letrec(
(largo (length lista))
(devolver_lista (lambda (cont pos lista)
(if (null? lista)
"null"
(if (= pos cont)
(car lista)
(cons (car lista) (devolver_lista (+ cont 1) pos (cdr lista)))

);if
);if
);lambda
);devolver_n
)

(devolver_lista 1 posicion lista)
);letrec
);lambda
);define

(devolver_l_izquierdo 3 (list '11 '12 '13 '14 '5 '7)) ;=> (11 12 . 13)
(devolver_l_izquierdo 9 (list '11 '12 '13 '14 '5 '7)) ;=> (11 12 13 14 5 7 . "null")


;;---------------------------------------------------------------------------;;
;; Contrato: eliminar de la lista el elemento en
;; la posicion indicada, y devolver el resto de la
;; lista.
;;---------------------------------------------------------------------------;;

(define extraer_elemento (lambda (pos listado)
(letrec (
(funcion (lambda (contador posicion lista)
(if (null? lista)
'()
(if (= contador posicion)
(cdr lista)
(cons (car lista) (funcion (+ contador 1) posicion (cdr lista)))
);if
);if
);lambda
);funcion
)
(funcion 1 pos listado)
);letrec
);lambda
);define

(extraer_elemento 5 (list 10 20 30 40 50));=>(10 20 30 40)


;;---------------------------------------------------------------------------;;
;; Contrato: dada una lista, devolver un nueva
;; lista con los elementos de la primera
;; invertidos.
;; Requiere de: OBTENER_ELEMENTO(N LISTA),
;; EXTRAER_ELEMENTO(N LISTA).
;;---------------------------------------------------------------------------;;

(define invertir_lista (lambda (listado)
(letrec (
(invertir (lambda (contador lista)
(if (null? lista)
'()
(cons (obtener_elemento (length lista) lista) (invertir_lista (extraer_elemento (length lista) lista)))
);if
);lambda
);invertir
)
(invertir 1 listado)
);letrec
);lambda
);define

(invertir_lista (list 5 4 3 2 1 0));=>(0 1 2 3 4 5)


;;---------------------------------------------------------------------------;;
;; Contrato: dadas dos listas, concatenarlas.
;; Donde la segunda lista aparezca en orden
;; inverso.
;;---------------------------------------------------------------------------;;

(define concat-inv (lambda (lista1 lista2)
(letrec(
(concatenar (lambda (l1 l2)
(if (and (null? l1) (null? l2))
'()
(if (null? l1)
(cons (car l2) (concatenar l1 (cdr l2)))
(if (null? l2)
(cons (car l1) (concatenar (cdr l1) '()))
(cons (car l1) (concatenar (cdr l1) l2))
);if
);if
);if
) ;lambda
);concatenar
)
;(concatenar lista1 (reverse lista2)); REVERSE es una función de Scheme.
(concatenar lista1 (invertir_lista lista2))
);let*
);lambda
);define

(concat-inv '(1 2) '(8 7 6 5 4 3)) ;=> (1 2 3 4 5 6 7 8 )


;;--------------------------------------------------------------------------;;
;; Ejercicio 2
;; Contrato: dados una lista y un elemento. Si el
;; elemento se encuentra en la lista devuelve #t,
;; caso contrario #f.
;;---------------------------------------------------------------------------;;

(define elemento_en_lista (lambda (elemento lista)
(if (null? lista)
#f
(if (eqv? elemento (car lista))
#t
(elemento_en_lista elemento (cdr lista))
);if
);if
);lambda
);define

;(elemento_en_lista '5 (list 1 2 3 4 5 6)) ;=> #t


;;---------------------------------------------------------------------------;;
;; Contrato: dadas dos listas y un elemento.
;; Si el elemento se encuentra en AMBAS listas
;; devuelve #t, caso contrario #f.
;;---------------------------------------------------------------------------;;

(define n_en_2_listas (lambda (elemento lista1 lista2)
(if (or (null? lista1) (null? lista2))
#f
(if (and (n_en_lista elemento lista1) (n_en_lista elemento lista2))
#t
#f
);if
);if
);lambda
);define

;(n_en_2_listas '5 (list 3 4 2 1) (list 1 2 3 4 6));=> #f
;(n_en_2_listas '5 (list 3 4 5 2 1) (list 1 2 3 6));=> #f
;(n_en_2_listas '5 (list 3 4 2 1) (list 1 2 3 4 5 6));=> #f
;(n_en_2_listas '5 (list 5 3 4 2 1) (list 5 1 2 3 4 5 6))=> #t


;;--------------------------------------------------------------------------;;
;; Ejercicio 3
;; Dado una lista y un elemento, devolver la cantidad
;; de atomos a la izquierda del elemento.
;;---------------------------------------------------------------------------;;

(define posicion_de_elemento (lambda (elem listado)
(letrec (
(devolver_posicion (lambda (posicion elemento lista)
(if (null? lista)
"null"
(if (eqv? (car lista) elemento)
posicion
(devolver_posicion (+ posicion 1) elemento (cdr lista))
);if
);if
);lambda
);devolver_posicion
)
(devolver_posicion 0 elem listado)
);letrec
);lambda
);define

(posicion_de_elemento 0 (list 'a 'b 'c 4 5 1 'd));=> "null"
(posicion_de_elemento 1 (list 'a 'b 'c 4 5 1 'd));=> 5


;;---------------------------------------------------------------------------;;
;; Ejercicio 4
;; Contrato: dados una lista y un elemento. Si el
;; elemento no se encuentra en la lista es agregado
;; al final de la misma.
;;---------------------------------------------------------------------------;;

(define agregar_en_lista_si_no_esta (lambda (elemento lista)
(if (null? lista)
'()
(if (eqv? (car lista) elemento)
(agregar_en_lista_si_no_esta (cdr lista))
(cons lista elemento)
);if
);if
);lambda
);define

(agregar_en_lista_si_no_esta 42 (list '38 '39 '40 '41 )) ;=> (38 39 40 41 42)


;;---------------------------------------------------------------------------;;
;; Ejercicio 5
;; Contrato: en caso de que el año sea bisiesto
;; devuelve 29, caso contrario devuelve 28.
;;---------------------------------------------------------------------------;;

(define bisiesto (lambda (año)
(if (= (modulo año 400) 0)
29
(if (and (= (modulo año 4) 0) (not(= (modulo año 100) 0)))
29;es bisiesto
28;no bisiesto
);if
);if
);lambda
);define

;(bisiesto 1900);=> 28
;(bisiesto 1700);=>28
;(bisiesto 1600);=>29
;(bisiesto 2004);=>29


;;---------------------------------------------------------------------------;;
;; Contrato: dada una posición en una lista,
;; devuelve el elemento en ESA posición.
;;---------------------------------------------------------------------------;;

(define obtener_elemento (lambda (n lista)
(letrec(
(devolver_n (lambda (cont n lista)
(if (null? lista)
"null"
(if (= n cont)
(car lista)
(devolver_n (+ cont 1) n (cdr lista))
);if
);if
);lambda
);devolver_n
)

(devolver_n 1 n lista)
);let
);lambda
);define

;;---------------------------------------------------------;;
;; Contrato: determinar si una fecha
;; ingresada es valida.
;;---------------------------------------------------------;;

(define fecha_es_valida( lambda (lista)
(let* (
(año (caddr lista))
(mes (cadr lista))
(dia (car lista))
(meses (list 31 (bisiesto año) 31 30 31 30 31 31 30 31 30 31))
)
(if (null? lista)
#f
(if (< año 0)
(display "Ingresaste un año que no es válido")
(if (and (> dia 0) (< dia (+ (obtener_elemento mes meses) 1)))
#t
(display "Cantidad de días no válido para ese mes")
);if
);if
);if
);let*
);lambda
);define

(fecha_es_valida (list 12 12 1986)) ;=> #t
(fecha_es_valida (list 29 02 1900)) ;=> #f (1900 no fue año bisiesto)


;;---------------------------------------------------------------------;;
;; Ejercicio 6
;; Contrato: Insertar un elemento en una lista en
;; la posición indicada.
;;---------------------------------------------------------------------;;

(define insertar_elemento (lambda (pos elem listado)
(letrec (
(largo (length listado))
(insertar (lambda (contador posicion elemento lista)
(if (null? list)
(cons lista elemento)
(if (= contador posicion)
(cons elemento lista)
(cons (car lista)(insertar (+ contador 1) posicion elemento (cdr lista)))
);if
);if
);lambda
);insertar
)
(insertar 1 pos elem listado)
);letrec
);lambda
);define

;(insertar_elemento 6 '6 (list 1 2 3 4 5));


;;---------------------------------------------------------------------------;;
;; Contrato: dados una lista y un elemento.
;; Si el elemento se encuentra en la lista
;; devuelve su posicion, caso contrario "null".
;;---------------------------------------------------------------------------;;

(define posicion_en_lista (lambda (elem listado)
(letrec (
(devolver_posicion (lambda (posicion elemento lista)
(if (null? lista)
"null"
(if (eqv? elemento (car lista))
posicion
(devolver_posicion (+ posicion 1) elemento (cdr lista))
);if
);if
);lambda
);devolver_lista
)
(devolver_posicion 1 elem listado)
);letrec
);lambda
);define

;(posicion_en_lista 's (list 'a 'n 'a 'l 'i 'a 's))


;;---------------------------------------------------------------------------;;
;; Contrato: dados una lista y un elemento.
;; Si el elemento se encuentra en la lista
;; devuelve #t, caso contrario #f.
;;---------------------------------------------------------------------------;;

(define elemento_en_lista (lambda (elemento lista)
(if (null? lista)
#f
(if (eqv? elemento (car lista))
#t
(elemento_en_lista elemento (cdr lista))
);if
);if
);lambda
);define

;(elemento_en_lista '4 (list 1 2 3))


;;---------------------------------------------------------------------------;;
;; Contrato: agrego el elemento junto a los demás
;; elementos iguales de la lista o al final de la
;; misma, en caso de no encontrar semejantes.
;;---------------------------------------------------------------------------;;

(define agrupar_elem_lista (lambda (elemento lista)
(if (null? lista)
(cons lista elemento)
(if (elemento_en_lista elemento lista)
(insertar_elemento (posicion_en_lista elemento lista) elemento lista)
(insertar_elemento (+ (length lista) 1) elemento lista)
);if
);if
);lambda
);define

;(agrupar_elem_lista '4 '(1 2 3 4 5 6 4)) ;=>(1 2 3 4 4 5 6 4)


;;---------------------------------------------------------------------------;;
;; Contrato: la función AGRUPAR recibe dos
;; argumentos: lista y elemento, en cualquier
;; orden. Comprueba cuál de ellos es un elemento
;; y cuál una lista. A continuación agrega el
;; elemento junto a los demás elementos iguales
;; de la lista o al final de la misma, en caso
;; de no encontrar semejantes.
;;---------------------------------------------------------------------------;;

(define agrupar (lambda (parametro1 parametro2)
(if (list? parametro1)
(agrupar_elem_lista parametro2 parametro1)
(agrupar_elem_lista parametro1 parametro2)
);if
);lambda
);define

(agrupar '(a b b c c) 'c);=> (a a b b c c c)
(agrupar 'c '(a b b c c));=> (a a b b c c c)


;;---------------------------------------------------------------------------;;
;; Ejercicio 7
;; Contrato dadas dos listas: l1 y l2, concatena
;; las mismas devolviendo un única lista resultante
;; por los elementos de l1 más los de l2.
;; Aplicable a listas propias e impropias.
;;---------------------------------------------------------------------------;;

(define concatenar_listas (lambda (lista1 lista2)
(if (and (null? lista1) (null? lista2))
'()
(if (not (null? lista1))
(cons (car lista1) (concatenar_listas (cdr lista1) lista2))
(if (not (null? lista2))
(cons (car lista2) (concatenar_listas lista1 (cdr lista2)))
'()
);if
);if
);if
);lambda
);define

;(concatenar_listas (list '0 '1 '2 '3) (list '4 '5 '6));=> (0 1 2 3 4 5 6 ) Probado con listas impropias.


;;---------------------------------------------------------------------------;;
;; Contrato: la función APLANAR reciba como
;; argumento una expresión simbólica y elimina
;; todos los paréntesis que aparezcan en esa
;; expresión, devolviendo como resultado una
;; lista con todos los átomos que aparezcan en
;; el argumento.
;; Requiere de: (CONCATENAR l1 l2)
;;---------------------------------------------------------------------------;;

(define aplanar (lambda (lista)
(if (null? lista)
'()
(if (list? (car lista))
(concatenar_listas (aplanar (car lista)) (aplanar (cdr lista)))
(concatenar_listas (list (car lista)) (aplanar (cdr lista)))
);if
);if
);lambda
);define

(aplanar '( (1 2 3) (9 (2 3 4) ) ( ( ( ( 3 4 ( 7 ) ) ) ) ) ));=> (1 2 3 9 2 3 4 3 4 7)
(aplanar '( 1 2 3)) ;= >(1 2 3)


;;---------------------------------------------------------------------------;;
;; Ejercicio 8
;; Contrato: eliminar de la lista el elemento
;; indicado, y devolver el resto de la lista.
;;---------------------------------------------------------------------------;;

(define extraer_elemento (lambda (pos listado)
(letrec (
(funcion (lambda (contador posicion lista)
(if (null? lista)
'()
(if (= contador posicion)
(cdr lista)
(cons (car lista) (funcion (+ contador 1) posicion (cdr lista)))
);if
);if
);lambda
);funcion
)
(funcion 1 pos listado)
);letrec
);lambda
);define

;(extraer_elemento 1 (list 10 20 30 40 50));=>(10 20 30 40)


;;---------------------------------------------------------------------------;;
;; Contrato: dada una posición en una lista,
;; devuelve el elemento en ESA posición.
;;---------------------------------------------------------------------------;;

(define obtener_elemento (lambda (n lista)
(letrec(
(devolver_n (lambda (cont n lista)
(if (null? lista)
"null"
(if (= n cont)
(car lista)
(devolver_n (+ cont 1) n (cdr lista))
);if
);if
);lambda
);devolver_n
)

(devolver_n 1 n lista)
);let
);lambda
);define

;(obtener_elemento 1 (list '11 '12 '13 '14 '())) ;=> 11


;;------------------------------------------------------------------------;;
;; Contrato: dada una lista, rotar el último
;; elemento hacia la izquierda.
;; Requiere de: (OBTENER_ELEMENTO pos lista)
;; (EXTRAER_ELEMENTO pos lista)
;;------------------------------------------------------------------------;;

(define rotar_izquierda (lambda (lista)
(if (null? lista)
'()
(cons (obtener_elemento (length lista) lista) (extraer_elemento (length lista) lista))
);if
);lambda
);define

;(rotar_izquierda (list 1 2 3 4 5 6 0)); → (0 1 2 3 4 5 6)


;;---------------------------------------------------------------------------;;
;; Contrato dadas dos listas: l1 y l2, concatena
;; las mismas devolviendo un única lista resultante
;; por los elementos de l1 más los de l2.
;; Aplicable a listas propias e impropias.
;;---------------------------------------------------------------------------;;

(define concatenar_listas (lambda (lista1 lista2)
(if (and (null? lista1) (null? lista2))
'()
(if (not (null? lista1))
(cons (car lista1) (concatenar_listas (cdr lista1) lista2))
(if (not (null? lista2))
(cons (car lista2) (concatenar_listas lista1 (cdr lista2)))
'()
);if
);if
);if
);lambda
);define

;(concatenar_listas (list '0 '1 '2 '3) (list '4 '5 '6));=>(0 1 2 3 4 5 6) Probado con listas impropias.


;;---------------------------------------------------------------------------;;
;; Contrato: la función APLANAR reciba como
;; argumento una expresión simbólica y elimina
;; todos los paréntesis que aparezcan en esa
;; expresión, devolviendo como resultado una
;; lista con todos los átomos que aparezcan
;; en el argumento.
;; Requiere de: CONCATENAR_LISTAS(l1 l2)
;;---------------------------------------------------------------------------;;

(define aplanar (lambda (lista)
(if (null? lista)
'()
(if (list? (car lista))
(concatenar_listas (aplanar (car lista)) (aplanar (cdr lista)))
(concatenar_listas (list (car lista)) (aplanar (cdr lista)))
);if
);if
);lambda
);define

;(aplanar '( (1 2 3) (9 (2 3 4) ) ( ( ( ( 3 4 ( 7 ) ) ) ) ) ));=> (1 2 3 9 2 3 4 3 4 7)


;;----------------------------------------------------------------------;;
;; Contrato: dada una lista, rotar el último
;; elemento hacia la derecha.
;; Requiere de: APLANAR(lista) ;;
;;----------------------------------------------------------------------;;

(define rotar_derecha (lambda (lista)
(if (null? lista)
'()
(aplanar (cons (extraer_elemento 1 lista) (list (obtener_elemento 1 lista))))
);if
);lambda
);define

(rotar_derecha (list 5 0 1 2 3 4)); => (0 1 2 3 4 5)


;;----------------------------------------------------------;;
;; Ejercicio 9
;; Contrato: dado un valor, devuelve el
;; cuadrado del mismo.
;;----------------------------------------------------------;;

(define cuadrado (lambda (x)
(expt x 2)
);lambda
);define


;;---------------------------------------------------------------------------;;
;; Contrato: dada una lista de valores, devuelve
;; una lista con cada uno de los cuadrados de la
;; primer lista.
;;---------------------------------------------------------------------------;;

(define calcula_cuadrados (lambda (lista)
(map
(lambda (y)
(cuadrado y)
);lambda
lista
);map
);lambda
);define

(calcula_cuadrados (list 1 2 3 4)); → (1 4 9 16)


;;---------------------------------------------------------------------------;;
;; Ejercicio 10
;; Contrato: eliminar de la lista el elemento
;; indicado, y devolver el resto de la lista.
;;---------------------------------------------------------------------------;;

(define extraer_elemento_e (lambda (elemento lista)
(if (null? lista)
'()
(if (eqv? elemento (car lista))
(extraer_elemento_e elemento (cdr lista))
(cons (car lista) (extraer_elemento_e elemento (cdr lista)))
);if
);if
);lambda
);define

;(extraer_elemento_e 6 '(1 2 3 4 5 6));=> (1 2 3 4 5)


;;---------------------------------------------------------------------------;;
;; Contrato: dados una lista y un elemento.
;; Si el elemento se encuentra en la lista
;; devuelve #t, caso contrario #f.
;;---------------------------------------------------------------------------;;

(define elemento_en_lista (lambda (elemento lista)
(if (null? lista)
#f
(if (eqv? elemento (car lista))
#t
(elemento_en_lista elemento (cdr lista))
);if
);if
);lambda
);define

;(elemento_en_lista '5 (list 1 2 3 4 5 6));=> #t


;;-------------------------------------- ------------------------------------;;
;; Contrato: restar 2 listas. Devolver una lista
;; con los elementos de la primera lista que no
;; están en la segunda.
;; Requiere de: (EXTRAER_ELEMENTO_E e l)
;;---------------------------------------------------------------------------;;

(define restar_listas (lambda (lista1 lista2)
(if (and (null? lista1) (null? lista2))
'()
(if (null? lista2)
lista1
(if (elemento_en_lista (car lista2) lista1)
(restar_listas (extraer_elemento_e (car lista2) lista1) (cdr lista2))
(restar_listas lista1 (cdr lista2))
);if
);if
);if
);lambda
);define

;(restar_listas '(1 2 3 4 5 6 7 8 9) '(2 5 7 9)); => (1 3 4 6 8)
;(restar_listas '(1 2 3 4 5 6 7 8 9) '(1 2 3 4 5)); => (6 7 8 9)


;;---------------------------------------------------------------------------;;
;; Ejercicio 11
;; Contrato dadas dos listas: l1 y l2, concatena
;; las mismas devolviendo un única lista resultado
;; de los elementos de l1 más los de l2.
;;---------------------------------------------------------------------------;;

(define concatenar_listas (lambda (lista1 lista2)
(if (and (null? lista1) (null? lista2))
'()
(if (not (null? lista1))
(cons (car lista1) (concatenar_listas (cdr lista1) lista2))
(if (not (null? lista2))
(cons (car lista2) (concatenar_listas lista1 (cdr lista2)))
'()
);if
);if
);if
);lambda
);define

;(concatenar_listas (list '0 '1 '2 '3) (list '4 '5 '6));Probado con listas impropias.


;;---------------------------------------------------------------------------;;
;; Contrato: la función APLANAR reciba como
;; argumento una expresión simbólica y elimina
;; todos los paréntesis que aparezcan en esa
;; expresión, devolviendo como resultado una
;; lista con todos los átomos que aparezcan en
;; el argumento.
;; Requiere de: (CONCATENAR_LISTAS l1 l2)
;;---------------------------------------------------------------------------;;

(define aplanar (lambda (lista)
(if (null? lista)
'()
(if (list? (car lista))
(concatenar_listas (aplanar (car lista)) (aplanar (cdr lista)))
(concatenar_listas (list (car lista)) (aplanar (cdr lista)))
);if
);if
);lambda
);define

;(aplanar '( (1 2 3) (9 (2 3 4) ) ( ( ( ( 3 4 ( 7 ) ) ) ) ) ));=> (1 2 3 4 2 3 4 3 4 7)


;;---------------------------------------------------------------------------;;
;; Contrato: dados una lista y un elemento.
;; Si el elemento se encuentra en la lista
;; devuelve #t, caso contrario #f.
;;---------------------------------------------------------------------------;;

(define elemento_en_lista (lambda (elemento lista)
(if (null? lista)
#f
(if (eqv? elemento (car lista))
#t
(elemento_en_lista elemento (cdr lista))
);if
);if
);lambda
);define

;(elemento_en_lista '5 (list 1 2 3 4 5 6));=> #t


;;------------------------------------------------------------------------ --;;
;; Contrato: devuelve una lista con los elementos
;; de la primer lista y los de la segunda que no
;; aparecen en la primera.
;; Requiere de: (ELEMENTO_EN_LISTA e, lista)
;; (APLANAR lista)
;;---------------------------------------------------------------------------;;

(define sumar_listas (lambda (lista1 lista2)
(if (and (null? lista1) (null? lista2))
'()
(if (null? lista2)
lista1
(if (elemento_en_lista (car lista2) lista1)
(sumar_listas lista1 (cdr lista2))
(sumar_listas (aplanar (cons lista1 (cons (car lista2) '()))) (cdr lista2))
);if
);if
);if
);lambda
);define

;(sumar_listas '(1 2 3) '(4 5));=>(1 2 3 4 5)
;(sumar_listas '(1 2 3) '(3 4 5 2 1));=>(1 2 3 4 5)
;(sumar_listas '(1 2 3 4 5) '(3 4 5 2 1 0));=>(1 2 3 4 5 0)


;;---------------------------------------------------------------------------;;
;; Ejercicio 12
;; Contrato: obtiene el número máximo de listas
;; anidadas que aparecen en una lista. ;;---------------------------------------------------------------------------;;

(define obtener_profundidad (lambda (lista)
(if (null? lista)
0
(if (list? (car lista))
(if (>= (+ (obtener_profundidad (car lista)) 1) (obtener_profundidad (cdr lista)))
(+ (obtener_profundidad (car lista)) 1)
(obtener_profundidad (cdr lista))
);if
0
);if
);if
);lambda
);define


(obtener_profundidad '((1 (2)) (((5 7))) (((((4))))))); → 5