Skip to content

Instantly share code, notes, and snippets.

@fetburner
fetburner / sieve1.hs
Last active December 15, 2015 13:49
エラトステネスのふるい
primes :: (Integral a) => [a]
primes = sieve [2 .. ]
where
sieve (p : qs) = p : sieve (filter (\q -> q `mod` p /= 0) qs)
main = print . sum . takeWhile ( <= 2000000) $ primes
@fetburner
fetburner / sieve2.hs
Created March 29, 2013 12:20
配列版エラトステネスのふるい
import Control.Monad (mapM_, forM_, when)
import qualified Data.Array.IArray as IArray
import Data.Array.Unboxed (UArray)
import Data.Array.ST (runSTUArray)
import Data.Array.MArray (newArray, readArray, writeArray)
-- 与えられた数以下の素数
primes :: Int -> [Int]
primes = map fst . filter snd . IArray.assocs . sieve
@fetburner
fetburner / memorize2.ml
Last active December 15, 2015 14:49
メモ化関数
let ( >> ) f g x = g (f x)
let collatz f = function
| 1L -> 1
| n when Int64.rem n 2L = 0L -> 1 + f (Int64.div n 2L)
| n when Int64.rem n 2L = 1L -> 1 + f (Int64.add (Int64.mul 3L n) 1L)
let rec memorize cache f n =
try Hashtbl.find cache n with
| Not_found ->
import qualified Data.Map as Map
import Control.Monad.State (state, runState)
import qualified Control.Monad.State as State
import Control.Monad (foldM, ( <=< ))
collatz :: ((Int -> a) -> Integer -> a) -> (Int -> a) -> Integer -> a
collatz f cont n
| n == 1 = cont 1
| even n = f (cont . succ) $ n `div` 2
| odd n = f (cont . succ) $ 3 * n + 1
let rec memorize cache f n =
try Hashtbl.find cache n with
| Not_found ->
let result = f (memorize cache f) n in
Hashtbl.add cache n result;
result
module IntRef = struct
type t = int ref
let compare a b =
(* Obj.magic注意!無理やりintにしてアドレスを得ている *)
let a_address : int = Obj.magic a in
let b_address : int = Obj.magic b in
(* Pervasivesを付けるのは趣味 *)
Pervasives.compare a_address b_address
end
@fetburner
fetburner / configure-log
Created September 2, 2013 13:54
FreeBSD9.1、GHC7.6.3でAjhcのビルドに失敗した時のログ
checking for a BSD-compatible install... /usr/bin/install -c
checking whether build environment is sane... yes
/home/Masayuki/ajhc/ac-macros/missing: Unknown '--is-lightweight' option
Try '/home/Masayuki/ajhc/ac-macros/missing --help' for more information
configure: WARNING: 'missing' script is too old or missing
checking for a thread-safe mkdir -p... ac-macros/install-sh -c -d
checking for gawk... gawk
checking whether make sets $(MAKE)... yes
checking whether make supports nested variables... yes
checking build system type... i386-unknown-freebsd9.1
@fetburner
fetburner / ajhc-log2
Created September 2, 2013 15:18
ログその2
[Masayuki@progpc ~/ajhc]$ gmake
git log fork-jhc-0.8.0-darcs20120314.. > ChangeLog
echo -n "`head -1 ChangeLog | sed -ne 's/^commit \(.*\)/\1/p'`" > src/data/shortchange.txt
perl ./utils/op_raw.prl src/RawFiles src/data/ViaGhc.hs src/data/prelude.m4 src/data/targets.ini rts/rts/constants.h rts/rts/stableptr.c rts/rts/stableptr.h rts/sys/queue.h rts/HsFFI.h rts/sys/wsize.h rts/sys/bitarray.h ChangeLog src/data/shortchange.txt rts/rts/slub.c rts/rts/gc_jgc.c rts/rts/gc_jgc.h rts/rts/profile.c rts/rts/profile.h rts/rts/cdefs.h rts/rts/rts_support.c rts/rts/rts_support.h rts/rts/gc.h rts/rts/gc_none.c rts/rts/gc_none.h rts/rts/jhc_rts.c rts/rts/jhc_rts.h rts/lib/lib_cbits.c rts/jhc_rts_header.h rts/lib/lib_cbits.h rts/rts/gc_jgc_internal.h rts/rts/conc.c rts/rts/conc.h > src/RawFiles.hs
happy -a -g -c src/FrontEnd/HsParser.y -o src/FrontEnd/HsParser.hs
shift/reduce conflicts: 60
reduce/reduce conflicts: 74
perl ./utils/opt_sets.prl -n src/FlagDump.flags src/FlagDump.flags > src/FlagDump.hs
Use of uninitialized
@fetburner
fetburner / ajhc-log3
Created September 4, 2013 14:07
ログその3
gmake install-am
gmake[1]: ディレクトリ `/usr/home/Masayuki/ajhc' に入ります
cabal configure
Resolving dependencies...
Configuring ajhc-0.8.0.9...
cabal build
Building ajhc-0.8.0.9...
Preprocessing library ajhc-0.8.0.9...
derive: fromParseResult: Parse failed at [/tmp/ghc23438_0/ghc23438_1.hspp] (355:5): Parse error: Last statement in a do-block must be an expression
gmake[1]: *** [cabal-build] エラー 1
@fetburner
fetburner / diffequ.ml
Created January 21, 2014 07:49
改良オイラー法およびルンゲ・クッタ法による常微分方程式の解法
let rec iterate_aux acc f init = function
| 0 -> List.rev acc
| n -> iterate_aux (init :: acc) f (f init) (n - 1)
let iterate f init = iterate_aux [] f init
(* スカラーとベクトルの積 *)
let ( *^ ) x ys = List.map (( *. ) x) ys
(* ベクトル同士の和 *)
let ( +^ ) xs ys = List.map2 ( +. ) xs ys