anagramas :: String -> [String] -> [String]

λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]
["Roma","moRa"]
λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]
["aMar","aRma"]

module Anagramas where

import Data.List (delete, sort, permutations)
import Data.Char (toLower)
import Data.Function (on)
import Data.Map (Map, fromListWith)
import Test.Hspec (Spec, describe, hspec, it, shouldBe)

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

anagramas :: String -> [String] -> [String]
anagramas _ [] = []
anagramas x (y:ys)
  | sonAnagramas x y = y : anagramas x ys
  | otherwise        = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por
-- ejemplo,
--    sonAnagramas "amor" "Roma"  ==  True
--    sonAnagramas "amor" "mola"  ==  False
sonAnagramas :: String -> String -> Bool
sonAnagramas xs ys =
  sort (map toLower xs) == sort (map toLower ys)

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

anagramas2 :: String -> [String] -> [String]
anagramas2 _ [] = []
anagramas2 x (y:ys)
  | sonAnagramas2 x y = y : anagramas2 x ys
  | otherwise         = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool
sonAnagramas2 xs ys =
  (sort . map toLower) xs == (sort . map toLower) ys

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

anagramas3 :: String -> [String] -> [String]
anagramas3 _ [] = []
anagramas3 x (y:ys)
  | sonAnagramas3 x y = y : anagramas3 x ys
  | otherwise         = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool
sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que
--    (f `on` g) x y
-- es equivalente a
--    f (g x) (g y)
-- Por ejemplo,
--    λ> ((*) `on` (+2)) 3 4
--    30

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

anagramas4 :: String -> [String] -> [String]
anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

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

anagramas5 :: String -> [String] -> [String]
anagramas5 x = filter (`sonAnagramas` x)

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

anagramas6 :: String -> [String] -> [String]
anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

-- 7ª solución
-- ===========

anagramas7 :: String -> [String] -> [String]
anagramas7 _ [] = []
anagramas7 x (y:ys)
  | sonAnagramas7 x y = y : anagramas7 x ys
  | otherwise         = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool
sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)
  where
    aux [] [] = True
    aux [] _  = False
    aux (u:us) vs | u `notElem` vs = False
                  | otherwise      = aux us (delete u vs)

-- 8ª solución
-- ===========

anagramas8 :: String -> [String] -> [String]
anagramas8 x = filter (`sonAnagramas8` x)

sonAnagramas8 :: String -> String -> Bool
sonAnagramas8 xs ys =
  frecuencias (map toLower xs) == frecuencias (map toLower ys)

frecuencias :: String -> Map Char Int
frecuencias xs = fromListWith (+) (zip xs (repeat 1))

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

specG :: (String -> [String] -> [String]) -> Spec
specG anagramas' = do
  it "e1" $
    anagramas' "amor" ["Roma","mola","loma","moRa", "rama"] `shouldBe`
    ["Roma","moRa"]
  it "e2" $
    anagramas' "rama" ["aMar","amaRa","roMa","marr","aRma"] `shouldBe`
    ["aMar","aRma"]

spec :: Spec
spec = do
  describe "def. 1" $ specG anagramas
  describe "def. 2" $ specG anagramas2
  describe "def. 3" $ specG anagramas3
  describe "def. 4" $ specG anagramas4
  describe "def. 5" $ specG anagramas5
  describe "def. 6" $ specG anagramas6
  describe "def. 7" $ specG anagramas7
  describe "def. 8" $ specG anagramas8

-- La verificación es
--    λ> verifica
--    16 examples, 0 failures

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

-- La comparación es
--    λ> ej = take (10^6) (permutations "1234567890")
--    λ> length (anagramas "1234567890" ej)
--    1000000
--    (2.27 secs, 5,627,236,104 bytes)
--    λ> length (anagramas2 "1234567890" ej)
--    1000000
--    (2.80 secs, 5,513,260,584 bytes)
--    λ> length (anagramas3 "1234567890" ej)
--    1000000
--    (1.86 secs, 5,097,260,856 bytes)
--    λ> length (anagramas4 "1234567890" ej)
--    1000000
--    (2.25 secs, 5,073,260,632 bytes)
--    λ> length (anagramas5 "1234567890" ej)
--    1000000
--    (2.14 secs, 5,009,260,616 bytes)
--    λ> length (anagramas6 "1234567890" ej)
--    1000000
--    (1.58 secs, 4,977,260,976 bytes)
--    λ> length (anagramas7 "1234567890" ej)
--    1000000
--    (6.63 secs, 6,904,821,648 bytes)
--    λ> length (anagramas8 "1234567890" ej)
--    1000000
--    (3.90 secs, 9,679,323,632 bytes)

-- (cadena n) es la cadena de los 10 primeros caracteres de la cadena
-- infinita abcabcabc... Por ejemplo,
--    cadena 10  ==  "abcabcabca"
cadena :: Int -> String
cadena n = take n (cycle "abc")

-- (cadenas m n) es la lista otenida repitiendo m veces (adena n). Por
-- ejemplo,
--    cadenas 3 10 == ["abcabcabca","abcabcabca","abcabcabca"]
cadenas :: Int -> Int -> [String]
cadenas m n = replicate m (cadena n)

--    λ> length (anagramas6 (cadena (10^5)) (cadenas 100 (10^5)))
--    100
--    (8.42 secs, 23,126,067,704 bytes)
--    λ> length (anagramas8 (cadena (10^5)) (cadenas 100 (10^5)))
--    100
--    (4.06 secs, 7,220,705,856 bytes)

from collections import Counter
from itertools import cycle, islice, permutations
from timeit import Timer, default_timer

# 1ª solución
# ===========

def anagramas1(x: str, ys: list[str]) -> list[str]:
    return [y for y in ys if son_anagramas(x, y)]

# (son_anagramas(xs, ys)) se verifica si xs e ys son anagramas. Por
# ejemplo,
#    son_anagramas("amor", "Roma")  ==  True
#    son_anagramas("amor", "mola")  ==  False
def son_anagramas(xs: str, ys: str) -> bool:
    return sorted(xs.lower()) == sorted(ys.lower())

# 2ª solución
# =============

def anagramas2(x: str, ys: list[str]) -> list[str]:
    return list(filter(lambda y: son_anagramas(x, y), ys))

# 3ª solución
# ===========

def anagramas3(x: str, ys: list[str]) -> list[str]:
    counter_x = Counter(x.lower())
    return list(filter(lambda y: counter_x == Counter(y.lower()), ys))

# 4ª solución
# ===========

def anagramas4(x: str, ys: list[str]) -> list[str]:
    return [y for y in ys if frecuencias(x.lower()) == frecuencias(y.lower())]

def frecuencias(s: str) -> dict[str, int]:
    dic : dict[str, int] = {}
    for c in s:
        dic[c] = dic.get(c, 0) + 1
    return dic

# Verificación
# ============

def test_anagramas() -> None:
    for anagramas in [anagramas1, anagramas2, anagramas3, anagramas4]:
        assert anagramas("amor", ["Roma","mola","loma","moRa", "rama"]) == \
            ['Roma', 'moRa']
        assert anagramas("rama", ["aMar","amaRa","roMa","marr","aRma"]) ==\
            ['aMar', 'aRma']
        print(f"Verificado {anagramas.__name__}")

# La verificación es
#    >>> test_anagramas()
#    Verificado anagramas1
#    Verificado anagramas2
#    Verificado anagramas3
#    Verificado anagramas4

# Comparación de eficiencia
# =========================

def tiempo(e: str) -> None:
    """Tiempo (en segundos) de evaluar la expresión e."""
    t = Timer(e, "", default_timer, globals()).timeit(1)
    print(f"{t:0.2f} segundos")

# ejemplo(n) es la lista de la n primeras permutaciones de
# "1234567890". Por ejemplo,
#    >>> ejemplo(3)
#    ['1234567890', '1234567809', '1234567980']
def ejemplo(n: int) -> list[str]:
    return [''.join(p) for p in islice(permutations("1234567890"), n)]

# La comparación es
#    >>> ej = ejemplo(10**6)
#    >>> tiempo('len(anagramas1("1234567890", ej))')
#    0.85 segundos
#    >>> tiempo('len(anagramas2("1234567890", ej))')
#    0.88 segundos
#    >>> tiempo('len(anagramas3("1234567890", ej))')
#    3.97 segundos
#    >>> tiempo('len(anagramas4("1234567890", ej))')
#    2.38 segundos

# cadena(n) es la cadena de los 10 primeros caracteres de la cadena
# infinita abcabcabc... Por ejemplo,
#    >>> cadena(10)
#    'abcabcabca'
def cadena(n: int) -> str:
    return ''.join(islice(cycle("abc"), n))

# (cadenas m n) es la lista otenida repitiendo m veces (adena n). Por
# ejemplo,
#    >>> cadenas(3, 10)
#    ['abcabcabca', 'abcabcabca', 'abcabcabca']
def cadenas(m: int, n: int) -> list[str]:
    return [cadena(n) for _ in range(m)]

# La comparación es
#    >>> tiempo('len(anagramas1(cadena(10**5), cadenas(100, 10**5)))')
#    0.99 segundos
#    >>> tiempo('len(anagramas2(cadena(10**5), cadenas(100, 10**5)))')
#    1.00 segundos
#    >>> tiempo('len(anagramas3(cadena(10**5), cadenas(100, 10**5)))')
#    0.57 segundos
#    >>> tiempo('len(anagramas4(cadena(10**5), cadenas(100, 10**5)))')
#    2.01 segundos

(ql:quickload "fiveam" :silent t)

(defpackage :anagramas
  (:use :cl
        :fiveam))

(in-package :anagramas)

;;; 1ª solución
;;; ===========

;;; (normalizada s) es la cadena s en minúscula y ordenada. Por ejemplo,
;;;    > (normalizada "RoManA")
;;;    "aamnor"
(defun normalizada (s)
  (coerce (sort (map 'list #'char-downcase s) #'char<) 'string))

;;; (son-anagramas xs ys) se verifica si xs e ys son anagramas. Por
;;; ejemplo,
;;;    > (son-anagramas "amor" "Roma")
;;;    T
;;;    > (son-anagramas "amor" "mola")
;;;    NIL
(defun son-anagramas (xs ys)
  (equal (normalizada xs) (normalizada ys)))

(defun anagramas-1 (x ys)
  (cond ((null ys) nil)
        ((son-anagramas x (car ys))
         (cons (car ys) (anagramas-1 x (cdr ys))))
        (t (anagramas-1 x (cdr ys)))))

;;; 2ª solución
;;; ===========

(defun anagramas-2 (x ys)
  (mapcan (lambda (y) (if (son-anagramas x y) (list y) nil)) ys))

;;; 3ª solución
;;; ===========

(defun anagramas-3 (x ys)
  (remove-if-not (lambda (y) (son-anagramas x y)) ys))

;;; 4ª solución
;;; ===========

(defun anagramas-4 (x ys)
  (loop for y in ys
        when (son-anagramas x y)
          collect y))

;;; 5ª solución
;;; ===========

(defun anagramas-5 (x ys)
  (reduce (lambda (acc y)
            (if (son-anagramas x y)
                (append acc (list y))
                acc))
          ys
          :initial-value '()))

;;; 6ª solución
;;; ===========

(defun anagramas-6 (x ys)
  (mapcan (lambda (y)
            (if (son-anagramas x y)
                (list y)
                '()))
          ys))

;;; 7ª solución
;;; ===========

(defun anagramas-7 (x ys)
  (let ((x-normalizada (normalizada x))
        (ys-normalizada (mapcar #'normalizada ys)))
    (loop for y in ys
          for y-normalizada in ys-normalizada
          when (equal x-normalizada y-normalizada)
          collect y)))

;;; 8ª solución
;;; ===========

;;; (frecuencia s) es el diccionario con los caracteres de l cadena s
;;; junto con su número de ocurrencias en s. Por ejemplo,
;;;    > (ql:quickload :alexandria :silent t)
;;;    (:ALEXANDRIA)
;;;    > (alexandria:hash-table-alist (frecuencia "Sevillanas"))
;;;    ((#\n . 1) (#\a . 2) (#\l . 2) (#\i . 1) (#\v . 1) (#\e . 1) (#\s . 2))
(defun frecuencia (s)
  (let ((histograma (make-hash-table :test #'equal)))
    (map nil
         (lambda (c)
           (incf (gethash (char-downcase c) histograma 0)))
         s)
    histograma))

;;; (son-anagramas-frecuencia xs ys) se verifica si xs e ys son anagramas. Por
;;; ejemplo,
;;;    > (son-anagramas-frecuencia "amor" "Roma")
;;;    T
;;;    > (son-anagramas-frecuencia "amor" "mola")
;;;    NIL
(defun son-anagramas-frecuencia (xs ys)
  (let ((hx (frecuencia xs))
        (hy (frecuencia ys)))
    (equalp hx hy)))

(defun anagramas-8 (x ys)
  (let ((hx (frecuencia x)))
    (loop for y in ys
          when (equalp hx (frecuencia y))
            collect y)))


;;; Verificación
;;; ============

(test anagramas
  (mapc (lambda (anagramas)
          (is (equal (funcall anagramas "amor" '("Roma" "mola" "loma" "moRa" "rama"))
                     '("Roma" "moRa")))
          (is (equal (funcall anagramas "rama" '("aMar" "amaRa" "roMa" "marr" "aRma"))
                     '("aMar" "aRma"))))
        '(anagramas-1
          anagramas-2
          anagramas-3
          anagramas-4
          anagramas-5
          anagramas-6
          anagramas-7
          anagramas-8)))

(defun verifica ()
  (run 'anagramas))

;;; La verificación es
;;;    > (verifica)
;;;
;;;    Running test ANAGRAMAS ................

;;; Comparación de eficiencia
;;; =========================


;;; (cadena n) genera una cadena aleatoria con n letras minúsculas. Por
;;; ejemplo,
;;;    ANAGRAMAS> (cadena 10)
;;;    "wozmfbldfe"
;;;    ANAGRAMAS> (cadena 10)
;;;    "qhezbrtxks"
(defun cadena (n)
  (let ((alfabeto "abcdefghijklmnopqrstuvwxyz")
        (longitud (length "abcdefghijklmnopqrstuvwxyz")))
    (coerce
     (loop repeat n
           collect (char alfabeto (random longitud)))
     'string)))

;;; (cadenas m n) es la lista otenida repitiendo m veces (cadena n). Por
;;; ejemplo,
;;;    ANAGRAMAS> (cadenas 3 10)
;;;    ("yznrohjnli" "mpafmnggcn" "oosulshzcq")
(defun cadenas (m n)
  (loop repeat m collect (cadena n)))

;;; La comparación es
;;;    > (setf ej-cadenas (cadenas 100 (expt 10 5))) (values)
;;;    > (time (length (anagramas-1 (first ej-cadenas) ej-cadenas)))
;;;    4.108 seconds of real time
;;;    > (time (length (anagramas-2 (first ej-cadenas) ej-cadenas)))
;;;    4.263 seconds of real time
;;;    > (time (length (anagramas-3 (first ej-cadenas) ej-cadenas)))
;;;    4.179 seconds of real time
;;;    > (time (length (anagramas-4 (first ej-cadenas) ej-cadenas)))
;;;    4.109 seconds of real time
;;;    > (time (length (anagramas-5 (first ej-cadenas) ej-cadenas)))
;;;    4.419 seconds of real time
;;;    > (time (length (anagramas-6 (first ej-cadenas) ej-cadenas)))
;;;    4.129 seconds of real time
;;;    > (time (length (anagramas-7 (first ej-cadenas) ej-cadenas)))
;;;    2.136 seconds of real time
;;;    > (time (length (anagramas-8 (first ej-cadenas) ej-cadenas)))
;;;    0.629 seconds of real time