#Haskell - 329

s 1=[]
s n=p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> 39258256 [986.885397s]

Haskell - 329

s 1=[]
s n=p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> 39258256 [986.885397s]

#Haskell - 329

s 1=[]
s n=p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> <too strict didn't wait>

#Haskell - 329

s 1=[]
s n=p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> 39258256 [986.885397s]

#Haskell - 330

s 1=[]
s n =p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> <too strict didn't wait>

#Haskell - 329

s 1=[]
s n=p:(s$div n p)where d=dropWhile((/=0).mod n)[2..ceiling$sqrt$fromIntegral n];p=if null d then n else head d
u=foldr(\v l@((n,c):q)->if v==n then(n,c+1):q else(v,1):l)[(0,1)]
i z=(z<2)||(head w==2)&&(and$zipWith(\(n,_)p->n-1<=p)(tail n)$scanl1(*)$map(\(n,c)->(n*n^c-1)`div`(n-1))n)where w=s z;n=u w
f=((filter i[0..])!!)

Examples:

> f 1
1
> f 13
32
> f 1000
6500

Here's a small testing suite (prepend to the above):

import Data.Time.Clock
import System.IO
test x = do
 start <- getCurrentTime
 putStr $ (show x) ++ " -> " ++ (show $ f x)
 finish <- getCurrentTime
 putStrLn $ " [" ++ (show $ diffUTCTime finish start) ++ "]"
main = do
 hSetBuffering stdout NoBuffering
 mapM_ test [1, 8, 1000, 250000, 1000000, 3000000]

Test results after being compiled with ghc -O3:

1 -> 1 [0.000071s]
8 -> 18 [0.000047s]
1000 -> 6500 [0.010045s]
250000 -> 2764000 [29.084049s]
1000000 -> 12214770 [201.374324s]
3000000 -> <too strict didn't wait>