Find circles for `f(z, c) = z ^ 2 + c` of length 6 in rational numbers

Question

I've found pretty simple problem on Numberphiles channel: suppose we have a recursive function $$ \begin{equation} \begin{split} f_0 &= Z ^ 2+ C \\ f_i &= f_{i-1}^2 + C \; | \; i = 1 \dots \end{split} \end{equation} $$

What values of \$ Z \$ and \$ C \$ should be \$ |\{ f_i | \; i=0..5\}| = 6 \; \cap \; f_5 = Z \$ so that firs 6 elements of the sequence are unique, except last the one which should be equal to the initial \$ Z \$. In this case, lets say that initial pair \$ Z, C \$ forms a cycle of length 6.

As you may notices, there is no solution in integer numbers \$ Z, C \in \mathbf{ℤ} \$, but there may be solution in rational numbers.

So, the final question I'm trying to answer: is there initial pair of rational numbers that forms a cycle of length 6 and which numerator and denominator doesn't exceeds 100 by module $$ Z = \frac{a}{b}, \; C = \frac{c}{d} \\ |a,c| \le 100 ,\; 0 \lt b,d \le 100 \\ a, b, c, d \in \mathbf{ℤ} $$

import Control.Monad (liftM2)
import Data.List
import Data.Maybe
import Data.Ratio
import System.IO

-- Returns list of unique normalized fractions where
--          |numerator| <= abs
--      0 < denominator <= abs
genRange :: Integral a => a -> [Ratio a]
genRange abs = map head $ group $ sort $ liftM2 (%) numerator denominator
    where numerator = [(-abs)..abs]
          denominator = [1..abs]

-- Returns list of initial values (Z, C)
initials :: Integral a => a -> [(Ratio a, Ratio a)]
initials abs = liftM2 (,) zs cs
    where zs = genRange abs
          cs = filter (<0) zs

-- Returns sequence of values of fi, i=[1..]
f :: Integral a => Ratio a -> Ratio a -> [Ratio a]
f z c = [zn] ++ (f zn c)
    where zn = z ^ 2 + c

-- Returns `Just pair`, if it forms a cycle of specified length
hasCircleF :: (Integral a) => Int -> (Ratio a, Ratio a) -> Maybe (Ratio a, Ratio a)
hasCircleF len pair
    | endsWith == z && amountUnique == 6 = Just pair
    | otherwise = Nothing
    where (z, c) = pair
          circle = take len $ (f z c)
          endsWith = last $ circle
          amountUnique = length $ group $ sort circle

collectMatches :: Integral a => [(Ratio a, Ratio a)]
collectMatches = mapMaybe (hasCircleF 6) (initials 100)

main :: IO ()
main = mapM_ (putStrLn . show) collectMatches

Currently, it takes half an hour on my machine.

Answer 1

By inspection, we can eliminate \$a = 0\$ from the search, since that would result in \$f_i = C\$ which yields a cycle of length 1.

Since you are computing \$Z^2\$, we can immediately see \$f_0(\frac{a}{b}) = f_0(\frac{-a}{b})\$ for any value of \$a \gt 0\$, and the same sequence of values results. So instead of searching \$a < 0\$, we can limit our sequence generation to \$a > 0\$, and instead check \$f_5 = \pm Z\$ to account for the negative range. This cuts the search space in half, so should reduce your running time to just 15 minutes on your machine.

---

For clarity, consider searching for a cycle length=3.

At some point, your testing: \$a=1, b=4, c=-29, d=16\$, or \$|Z| = \frac{1}{4}, C = \frac{-29}{16}\$ and discover:

$$f_0 = -7/4$$ $$f_1 = 5/4$$ $$f_2 = -1/4$$

Since \$|f_2| = |Z|\$, we've discovered a solution, but we haven't identified what the solution is yet.

If \$f_2 \gt 0\$, then \$Z = \frac{a}{b}, C = \frac{c}{d}\$ is the solution.

If \$f_2 \lt 0\$, then \$Z = \frac{-a}{b}, C = \frac{c}{d}\$ is the solution.

Therefore, the solution actually is \$Z = \frac{-1}{4}, C = \frac{-29}{16}\$

This same process applies to your cycle=6 search, effectively testing \$a,b,c,d\$ and \$-a,b,c,d\$ simultaneously, and therefore cutting the search space in half.