Reloj Cuántico

Sea polinomio de grado en . Una tabla de diferencias se emplea para convertir una sucesión en la sucesión de coeficientes tales que .

Obteniendo los coeficientes en Haskell. Para este ejemplo utilizaremos el polinomio .

Primero fabricamos una lista infinita con para cada índice en la lista:

 > take 8 $ map (^4) [0..]
[0,1,16,81,256,625,1296,2401]

El ‘take 8′ es solamente para no mostrar la lista completa.

Creamos ahora una función auxiliar ‘diferencia’ sobre la que vamos a iterar la lista infinita.

let diferencia (x:xs) = zipWith (-) xs (x:xs)

Lo que hace esta función es que, dada por ejemplo la lista , y su ‘tail’ , resta término a término, , efectivamente calculando la primera diferencia.

Ahora iteramos indefinidamente sobre la sucesión original (llamémosle xs); esto produce una lista [xs, diferencia xs, diferencia^2 xs, diferencia^3 xs...] de las i-ésimas diferencias de la sucesión.

Ver esa iteración no funcionaría, porque produce una lista infinita de listas infinitas, y nunca vamos a terminar de ver siquiera la primera. Pero para encontrar los coeficientes solamente hacen falta los ‘head’, o primeros términos. Entonces, inmediatamente después de la iteración, los pedimos con ‘map’:

> take 6 $ map head $ iterate diferencia $ map (^4) [0..]
[0,1,14,36,24,0]

Podemos pedir más de seis coeficientes con ‘take’, pero no hace falta; dado que es polinomio de grado 4, solamente hacen falta cinco términos, del sexto en adelante son todos cero.

En lugar de ‘head’ se puede usar ‘take 2′, por ejemplo, para ver más términos de cada lista infinita.

 take 5 $ map (take 2) $ iterate diferencia $ map (^4) [0..]
[[0,1],[1,15],[14,50],[36,60],[24,24]]

Finalmente, para verificar (empleando el ‘binomial’ en Math.Combinat.Numbers):

> let base x = map (binomial x) [0..]
> let coeficientes =
    (map head $ iterate diferencias $ map (^4) [0..])
> sum $ take 6 $ zipWith (*) coeficientes (base 1200)
2073600000000
> 1200^4
2073600000000

‘base’ es la lista , ‘coeficientes’ es lo mismo de arriba, el ‘sum $ zipWith (*)’ hace el producto interior.

Tomemos un conjunto de n fichas que pueden ser blancas o rojas. Demostrar por inducción que todas las fichas del conjunto deben ser del mismo color.

Base de inducción: . Se satisface trivialmente que todas las fichas son del mismo color.

Paso de inducción: Sea un conjunto con fichas. Si escondemos una, queda un conjunto con fichas, que, por hipótesis de inducción, tiene todas sus fichas del mismo color. Repitamos el proceso (aún sobre ) escondiendo una ficha diferente, de donde resulta , que también tiene todas sus fichas del mismo color por el mismo motivo.

Entonces, si la intersección de y no es vacía, tenemos que y tienen todas sus fichas del mismo color, porque cada conjunto (por hipótesis) tiene todas sus fichas del mismo color, y comparten al menos una ficha en la intersección.

¿Qué sucede en el otro caso, cuando la intersección es vacía? Que no se puede decir nada respecto a y . Pueden tener fichas de colores diferentes. Y eso es lo que puede suceder con , que tomamos como base de inducción. Si , entonces , (o viceversa), y la intersección debe ser vacía.

Entonces no es buena base. Y a partir de ya no se satisface que todas las fichas deban ser del mismo color; no hay buena base para este paso de inducción.

Tomemos un conjunto de fichas que pueden ser blancas o rojas. Demostrar por inducción que todas las fichas del conjunto deben ser del mismo color.

Base de inducción: . Se satisface trivialmente que todas las fichas son del mismo color.

Paso de inducción: Sea un conjunto con fichas. Si escondemos una, queda un conjunto con fichas, que, por hipótesis de inducción, tiene todas sus fichas del mismo color. Repitamos el proceso (aún sobre ) escondiendo una ficha diferente, de donde resulta , que también tiene todas sus fichas del mismo color por el mismo motivo.

Así se “demuestra” que todas las fichas de son del mismo color; por ejemplo, si tiene 100 fichas, escondiendo dos distintas se construyen y con 99 fichas cada uno; como contiene la ficha oculta a , y contiene la ficha oculta a , entonces toda ficha en es del mismo color. Con esto queda “demostrado” el paso de inducción, y la afirmación debería ser verdadera.

Por supuesto que la afirmación es falsa; es perfectamente posible formar conjuntos de colores mezclados. ¿Dónde está el problema?

Sea una lista xs, con todos sus elementos diferentes (para que sea lo más parecida a un conjunto). Buscamos todos los subconjuntos de esa lista.

binarias = iterate (concatMap (\xs -> [False:xs,True:xs])) [[]]
 
subsets xs =
    map ((map fst) . (filter snd) . (zip xs)) $
    (binarias !!) $
    length xs
 
> subsets "abc"
["","a","b","ab","c","ac","bc","abc"]

Declaro ‘binarias’ de forma similar que en “Cadenas Binarias”, con una diferencia: en lugar de ceros y unos (letras) agrego valores Falso y Verdadero. Las cadenas (ahora listas, que son funcionalmente equivalentes) producidas son idénticas, excepto por ese reemplazo.

Para generar los subconjuntos, primero pide las cadenas binarias de la misma longitud que xs:

(binarias !!) $ length xs

En el ejemplo, como “abc” tiene longitud 3, en ese punto ha producido

> (binarias !!) $ length "abc"
[[False,False,False],[True,False,False],[False,True,False],
[True,True,False],[False,False,True],[True,False,True],
[False,True,True],[True,True,True]]

Después, para cada cadena, ‘zip xs’ hace pares en los que los primeros términos se toman de xs y los segundos de la cadena. Por ejemplo, para la cadena ‘[True,False,True]‘, con xs = “abc”, se forma

> (zip "abc") [True,False,True]
[('a',True),('b',False),('c',True)]

A continuación se filtra, dejando pasar solamente las que tienen Verdadero en el segundo término (con ‘snd’):

> ((filter snd) . (zip "abc")) [True,False,True]
[('a',True),('c',True)]

y se retira el segundo término, que en este punto es siempre verdadero y ya no es necesario.

> ((map fst) . (filter snd) . (zip "abc")) [True,False,True]
"ac"

De esta forma, el subconjunto que corresponte a la cadena binaria “Verdadero, Falso, Verdadero” aplicada a “abc” es “ac”, porque ‘a’ y ‘c’ tienen un Verdadero en sus posiciones respectivas en la cadena binaria.

Esto se hizo con una sola cadena binaria, como ejemplo; el primer ‘map’ en ‘subsets’ aplica esa composición de funciones a todo ‘(binarias !!) $ length xs’, que es una lista de todas las cadenas binarias de la misma longitud que xs. Por lo tanto, genera todos los subconjuntos de xs.

binarias = iterate (concatMap (\xs -> ['0':xs,'1':xs])) [""]

El n-ésimo término de la lista infinita ‘binarias’ es una lista que contiene las cadenas binarias de longitud n; por ejemplo,

> binarias !! 4
["0000","1000","0100","1100","0010","1010","0110","1110",
 "0001","1001","0101","1101","0011","1011","0111","1111"]

Se construyen con la regla de que cada lista en ‘binarias’ es igual a la anterior después de poner un ’0′ y un ’1′ al principio de cada cadena en la lista, iniciando con la lista que contiene a la cadena vacía.

‘concatMap’ es similar a ‘map’, pero permite agregar varios valores al resultado en lugar de sólo uno:

> map (\ k -> k+10) [1..5]
[11,12,13,14,15]
> concatMap (\ k -> [k, k+10]) [1..5]
[1,11,2,12,3,13,4,14,5,15]

Para cada número en [1..5] ‘map’ solamente extiende la lista resultado en uno; ‘concatMap’ aquí la extiende en dos, porque (\ k -> [k, k+10]) regresa una lista con dos elementos.

Manipular la función de extensión permite generar cadenas binarias con propiedades particulares. Por ejemplo, las cadenas binarias que no tienen dos unos juntos:

sinRachas = [""] :
    iterate (concatMap 
        (\xs -> if head xs == '1' 
                  then ['0':xs] 
                  else ['0':xs,'1':xs])) ["0","1"]

Aunque se ve más complicada, es casi exactamente la misma función. La única diferencia es que, en lugar de simplemente agregar un ’0′ y un ’1′, primero pregunta si la cadena a la que está agregando empieza con ’1′ (head xs == ’1′); si es así, extiende solamente con ’0′.

Como está preguntando por el principio de la cadena binaria, no es posible comenzar a iterar con una cadena vacía. Por eso ‘[""] :’ agrega directamente las cadenas binarias sin dos unos juntos que tienen longitud cero (solamente “”) y comienza a iterar con las de longitud uno, ["0","1"].

Como nota interesante, los números de cadenas binarias sin dos unos juntos corresponden a números de Fibonacci:

> map length sinRachas 
[1,2,3,5,8,13,21,34,55,89,144,233,377...

permutaciones = map snd $ iterate inserta (1,[[]]) where
    inserta (n,xs) = (n+1, concatMap (inserta' n) xs)
    inserta' n xs = map
        ((\(a,b) -> a ++ [n] ++ b).((flip splitAt) xs))
        [0..(length xs)]

‘permutaciones’ es una lista infinita, donde el enésimo término es la lista de las permutaciones con n elementos; e.g.

> permutaciones !! 4
[[4,3,2,1],[3,4,2,1],[3,2,4,1],[3,2,1,4],
 [4,2,3,1],[2,4,3,1],[2,3,4,1],[2,3,1,4],
 [4,2,1,3],[2,4,1,3],[2,1,4,3],[2,1,3,4],
 [4,3,1,2],[3,4,1,2],[3,1,4,2],[3,1,2,4],
 [4,1,3,2],[1,4,3,2],[1,3,4,2],[1,3,2,4],
 [4,1,2,3],[1,4,2,3],[1,2,4,3],[1,2,3,4]]

La estrategia es partir del valor inicial ‘(1,[[]])’, que es un par que contiene como primer término el que va a ser elemento nuevo en la próxima lista de permutaciones, y, como segundo, la lista conteniendo la única permutación con cero elementos.

‘iterate’ construye una lista infinita, aplicando la función ‘inserta’ a cada entrada en la lista para obtener la siguiente.

inserta (n,xs) = (n+1, concatMap (inserta' n) xs)

De un lado, con cada paso incrementamos el elemento a agregar, para que toda permutación con n elementos consista de los números entre 1 y n.

Del otro, insertamos el elemento nuevo en todas las posiciones posibles de cada permutación en la lista obtenida el paso anterior, empleando la función auxiliar inserta’:

inserta' n xs = map
    ((\(a,b) -> a ++ [n] ++ b).((flip splitAt) xs))
    [0..(length xs)]

Esta función lee una permutación xs, la divide de todas las formas posibles con ‘map ((flip splitAt) xs)’ sobre todos los valores válidos, y la vuelve a pegar con ‘++’ poniendo n en medio.

En este caso ‘flip’ cambia el orden de los argumentos de ‘splitAt’, que normalmente funciona como ‘splitAt n xs’, y con ‘flip’ es ‘splitAt xs n’ para poder usar el mapa sobre las n.

Ejemplo de dividir una permutación:

> map ((flip splitAt) [1,4,2,3]) [0..4]
[([],[1,4,2,3]),([1],[4,2,3]),([1,4],[2,3]),
([1,4,2],[3]),([1,4,2,3],[])]

y de volver a unir una de las divisiones, insertando un 5 en el corte:

> (\(a,b) -> a ++ [5] ++ b) ([1,4],[2,3])
[1,4,5,2,3]

Por último, el usar ‘map snd’ en la lista final es porque está formada de pares (n+1, nPermutaciones), donde los primeros términos ya no son necesarios después de calcular. Queremos ver solamente los segundos, que son las listas de permutaciones.