Project Euler Problem 066

import Data.Ord
import Data.List

-- 平方数か
isq :: Integer -> Bool
isq n = r*r==n where r= floor $ (sqrt $ fromIntegral n :: Double)
sqw :: [Integer]
sqw = [i | i<-[1..],not (isq i)]
qn :: Integral a => a -> [a]
qn d = (reverse (tail (reverse (frc d))))
-- 連分数
frc :: Integral a => a -> [a]
frc d = imp 0 1 [] [] where
  fi = fromIntegral
  sd = sqrt $ fi d :: Double
  tai m n = floor ((sd + fi m)/(fi n))
  imp m n a ans | (m,n) `elem` a = ans
  imp m n a ans = imp mm nn ((m,n):a) (ans++[v]) where
    v = tai m n
    mm = n*v - m
    nn = if n == 0 then d - mm*mm else (d - mm*mm)`quot` n
-- メモ化
memoize :: (Enum a, Num a) => ((Int -> a1) -> a -> a1) -> Int -> a1
memoize f = (a!!) where a = map (f (a!!)) [0..]
-- 漸化式                        
xn :: Num a => [a] -> Int -> a
xn q@(x:_) = memoize imp where
  imp _ 0 = 1
  imp _ 1 = x
  imp f n = (q!!(n-1)) * (f(n-1)) + f(n-2)
yn :: Num a => [a] -> Int -> a
yn q = memoize imp where  
  imp _ 0 = 0
  imp _ 1 = 1
  imp f n = (q!!(n-1)) * (f(n-1)) + f(n-2)
fib :: Int -> Integer
fib = memoize imp where
  imp _ 0 = 1
  imp _ 1 = 1
  imp f n = f(n-1)+f(n-2)

tn :: Integral t => t -> (t, t)
tn n = if test == 1 then (x,y) else (x*x+n*y*y,2*x*y) where
  xx = x*x                                  
  yy = y*y
  test = xx - n*yy
  x = xn q lq
  y = yn q lq
  q = qn n
  lq = length q
ans1 :: Integer
ans1 = maximumBy (comparing (fst . tn)) $ takeWhile (<=1000) sqw
--661
main :: IO ()
main = print ans1