HaHaHa!(old)

2006-08-19

ShowS型

数値を16進表記の文字列に変換したい - 趣味的にっきより.

ShowS のありがたみってあまり解りやすくないんですよねぇ.

http://www.sampou.org/haskell/tutorial-j/stdclasses.html#sect8.3

すこし解説があります.蓄積引数を使うことで再帰途中の(++)による効率の

低下を防いでいるということです.

ha-tan さんのコードを難読化してみました.(^^;)

module Main (main) where

import Numeric (showHex)
import System.Environment (getArgs)

pprHexS :: Integral a => a -> ShowS
pprHexS n = ("[ 0x"++) . showHex n . (" ]"++)

main :: IO ()
main = getArgs >>= putStr . flip id "\n" . foldr (.) id . map (pprHexS . read)

実行例は

% runhaskell pprHex.hs 123 1234 12345
[ 0x7b ][ 0x4d2 ][ 0x3039 ]

ディリクレの算術級数

ディリクレの算術級数定理 - HaHaHa!(old) - haskellにいただいたコメントで示された応用問題

a と d が互いに素な正の整数とする。

a から始まり d ずつ増える等差数列に含まれる、自然数n以下の素数pの

個数をA(a,d,n)で表す。

たとえば、n=10の場合

A(1,4,10)={5}の要素数=1

A(3,4,10)={3,7}の要素数=2

さて、

A(1,4,n)、A(3,4,n)

の大小を比較をn=30000まで比較し

(i)30000以下のnについては、A(1,4,n) ≦ A(3,4,n) が成り立つ

または

(ii)A(1,4,n) > A(3,4,n) なるnがある場合には、最小のnを求める

を示してください。

ふむ.これは素数列を4で割った余りでフィルターすればいいのしらん.

というわけで,めちゃ素朴に.

fst3 (x,_,_) = x

type Table = ([Int],[Int],[Int])

primes = concatMap fst3 $ iterate sieve ([2],[2],[2..])

sieve :: Table -> Table
sieve (ps,q:qs,ss)
 = let (xs,ys) = span (q*q >) ss
   in (xs,qs++xs,filter ((/=0) . (`mod` q)) ys)

lem :: Int -> Int -> Int -> Int
lem a d n = length $ filter (\ m -> mod m d == a) $ takeWhile (n >=) primes

l14 = lem 1 4
l34 = lem 3 4

rng   = filter (\ m -> elem (mod m 4) [1,3]) [2..30000]
check = map fst $ filter snd $ zip rng $ zipWith (>) (map l14 rng) (map l34 rng)

で check を評価すると

Main> check
[26861]

というわけで, (ii) の場合になって, n = 26861 .かな.

タナカタナカ2006/08/19 18:57正解!。返答して頂いてありがとうございます。
速答している様子が目に見えるようです。
ついでに、A(1,4,n)、A(3,4,n)の増加の様子も出しておいても良かったかな…
実は、A(1,4,n)、A(3,4,n)はn→∞では無限回大小が変わるそうです。
Littlewoodという数学者が証明したそうです。(1914年)
証明される前は、チェビシェフChebyshevが、A(1,4,n)<=A(3,4,n)と予想していたとか。
最小数が26861なのは、1957年に分かったとか。
LL-Ringの"キミならどう書く"には数学に近すぎ(て好みの分かれ)る問題カナ?
http://homepage2.nifty.com/hiranouchi/asir/pari300.html
参考文献:「数論Ⅰ」加藤 他 著 岩波書店 p.272

2006-08-05

簡単移調ツール

簡単移調ツールをつくってみました。 - 趣味的にっき を見て

私も書いてみました.インデックスを使うかわりに循環リストを使っています.

module Main (main) where

import System.Environment (getArgs, getProgName)

data Note = C | C' | D | Eb | E | F | F' | G | G' | A | Bb | B
  deriving (Eq,Ord,Enum)

notes,notes' :: [Note]
notes = [C .. B]
notes' = cycle notes

mappings :: Note -> Note -> [(Note, Note)]
mappings from to = zip notes (dropWith diff notes')
  where diff = takeWhile (to /=) $ dropWhile (from /=) notes'

dropWith :: [b] -> [a] -> [a]
dropWith (_:ds) (_:xs) = dropWith ds xs
dropWith []     xs     = xs
dropWith _      []     = []

showmapping :: (Note, Note) -> String
showmapping (n1,n2) = show n1 ++ " => " ++ show n2

usage p =  p ++ " <from> <to>" 

main :: IO ()
main = do prog <- getProgName
          args <- getArgs
          if length args /= 2
            then putStrLn $ usage prog
            else mapM_ putStrLn $ map showmapping $ mappings (read $ args !! 0) (read $ args !! 1)


instance Show Note where
  show C  = "C "
  show C' = "C#"
  show D  = "D "
  show Eb = "Eb"
  show E  = "E "
  show F  = "F "
  show F' = "F#"
  show G  = "G "
  show G' = "G#"
  show A  = "A "
  show Bb = "Bb"
  show B  = "B "

instance Read Note where
  readsPrec _ ('C':'#':rs) = [(C',rs)]
  readsPrec _ ('C':rs)     = [(C,rs)]
  readsPrec _ ('D':rs)     = [(D,rs)]
  readsPrec _ ('E':'b':rs) = [(Eb,rs)]
  readsPrec _ ('E':rs)     = [(E,rs)]
  readsPrec _ ('F':'#':rs) = [(F',rs)]
  readsPrec _ ('F':rs)     = [(F,rs)]
  readsPrec _ ('G':'#':rs) = [(G',rs)]
  readsPrec _ ('G':rs)     = [(G,rs)]
  readsPrec _ ('A':rs)     = [(A,rs)]
  readsPrec _ ('B':'b':rs) = [(Bb,rs)]
  readsPrec _ ('B':rs)     = [(B,rs)]

ちょっと冗長な部分の code を修正しました.必須ではありませんが,

エクスポートリストインポートリストを追加しました.(2006-08-09)

2006-08-01

おてがるパーザコンビネータ

Parsecが便利でよいけど,使い方を思い出せず,調べるのが面倒なときには,

おてがるコンビネータを自分で定義したほうが簡単なんてこともある.

-- Parser Combinators
import Control.Monad.State

type Parser t a = StateT [t] [] a

runParser :: Parser t a -> [t] -> [(a,[t])]
runParser = runStateT

failure :: Parser t a
failure = mzero

succeed :: a -> Parser t a
succeed = return

item :: Parser t t
item = do { (x:xs) <- get ; put xs ; return x }

sat :: (t -> Bool) -> Parser t t
sat p = do { x <- item ; if p x then return x else failure }

tok :: Eq t => t -> Parser t t
tok = sat . (==)

(<|>) :: Parser t a -> Parser t a -> Parser t a
(<|>) = mplus

many,many1 :: Parser t a -> Parser t [a]
many  p = many1 p <|> return []
many1 p = do { x <- p; xs <- many p ; return (x:xs) }

lex' [] = []
lex' xs = lex xs

lexer :: Parser Char [String]
lexer = many (StateT lex')

firstParse :: [(a,[t])] -> a
firstParse rs = case Prelude.filter (Prelude.null . snd) rs of
                  []      -> error "No parse"
                  (r,_):_ -> r

lexing :: String -> [String]
lexing = firstParse . runParser lexer 

SelviSelvi2012/10/03 02:28Hey, that's a cevelr way of thinking about it.

isqffjmycisqffjmyc2012/10/06 14:07HEFYnE , [url=http://ihyzucjrkvxg.com/]ihyzucjrkvxg[/url], [link=http://kewicnaqgizz.com/]kewicnaqgizz[/link], http://gdjbhwjguowl.com/