コラッツ予想がとけたらいいな

**１３２人目の素数さん** · 2012/10/14(日) 10:32:39.71

525 名前：１３２人目の素数さん[sage] 投稿日：2012/09/03(月) 18:24:27.22
http://d.hatena.ne.jp/righ1113/
コラッツ予想について、証明を考えてみました。
ご指摘ご意見ご感想など、ぜひよろしくお願いします。

**righ1113** ◆OPKWA8uhcY · 2018/05/06(日) 16:38:47.09

現状のソースも貼っておきます。

import Data.List (nub, sort, findIndex, (\\), intersect)
import Data.Maybe (fromJust)

twoTimes :: Int -> Int -> [Int]
twoTimes x p = take p $ iterate (\y -> y*2 `mod` p) x

makeA :: Int -> [[Int]]
makeA p = nub $ map sort [nub $ twoTimes x p | x <- [0..p-1]]
makeB :: Int -> [[Int]]
makeB p = nub $ map sort [nub $ twoTimes x (3*p) | x <- [0..(3*p)-1], x `mod` 3 /= 0, x `mod` p /= 0]

findA :: Int -> Int -> Int
findA x p = fromJust $ findIndex (elem x) (makeA p)
findB :: Int -> Int -> Maybe Int
findB x p = findIndex (elem x) (makeB p)
findX :: Int -> [(Int, Maybe Int)]
findX p = nub [(findA x p, findB (3*x+1 `mod` p) p) | x <- [0..p-1]]

-- (4)A1,A2,…のうち、全てのBjとの組が得られていないものを調査
makeFour' :: Int -> Int -> Bool
makeFour' x p = [Just y | y <- [0..((length $ makeB p) -1)]] /= sort [v | (k, v) <- findX p, v /= Nothing, k==x]
makeFour :: Int -> [Int]
makeFour p = filter (\x -> makeFour' x p) [0..((length $ makeA p) -1)]

-- 組(A',Bj)が得られていないようなBj を見つける
makeCBefore :: Int -> Int -> [Int]
makeCBefore x p = [0..((length $ makeB p) -1)] \\ [fromJust v | (k, v) <- findX p, v /= Nothing, k==x]
-- Bjの元
makeCBefore2 :: Int -> Int -> [Int]
makeCBefore2 x p = concat [(makeB p) !! y | y <- makeCBefore x p]
makeC :: Int -> Int -> [[Int]]
makeC x p = nub $ map sort [nub $ twoTimes y (9*p) | y <- [0..(9*p)-1], elem (y `mod` (3*p)) (makeCBefore2 x p)]

**righ1113** ◆OPKWA8uhcY · 2018/05/06(日) 16:41:20.99

makeCAfter :: Int -> Int -> [Int]
makeCAfter x p
= concat [(makeB p) !! y | y <- intersect [0..((length $ makeB p) -1)] [fromJust v | (k, v) <- findX p, v /= Nothing, k==x]]
findC :: Int -> Int -> Int -> Maybe Int
findC x y p = findIndex (elem x) (makeC y p)
findY :: Int -> Int -> [(Int, Maybe Int)]
findY x p = nub [(fromJust $ findB y p, findC (3*y+1 `mod` p) x p) | y <- makeCAfter x p]

-- (7)B1,B2,…のうち、全てのCjとの組が得られていないものを調査
makeSeven' :: Int -> Int -> Int -> Bool
makeSeven' x y p = [Just z | z <- [0..((length $ makeC y p) -1)]] /= sort [v | (k, v) <- findY y p, v /= Nothing, k==x]
makeSeven :: Int -> Int -> [Int]
makeSeven y p
= nub $ intersect [k | (k, _) <- findY y p] (filter (\x -> makeSeven' x y p) [0..((length $ makeB p) -1)])

main = do
putStrLn ("素数pを入力してください")
pStr <- getLine
let p = read pStr :: Int
putStrLn ("Z/pZ : " ++ show([0..p-1]))
putStrLn ("A : " ++ show(makeA p))
putStrLn ("Z/3pZ : " ++ show([0..(3*p)-1]))
putStrLn ("B : " ++ show(makeB p))
putStrLn ("(3) tuple : " ++ show(findX p))
putStrLn ("(4) A' No. : " ++ show(makeFour p))
let q1 = 0 -- A' No.
putStrLn ("C : " ++ show(makeC q1 p))
putStrLn ("(6) tuple : " ++ show(findY q1 p))
putStrLn ("(7) B' No. : " ++ show(makeSeven q1 p))
-- 上記3行を繰り返し処理すれば良い
-- let q2 = 0 -- B' No.