The sort of crowd that read my blog I'd expect to be using Firefox, but maybe not such a high percentage. Pretty pleased that Safari is in second, and not totally sure what Mozilla is, but probably just the other mozilla based browsers like IceWeasel. Also a little surprised with the amount of Opera users, but not too much. But the biggest surprise was IE, I never expected I'd get so few IE users, and I'm very happy about this!
Even though I have taken to not hacking my site so much, I'm still pleased that I can basically ignore having to even try making my site IE compatible. I know I'm likely to get some responses to this saying that I should still do it, but you know what? Screw that! if people are stupid enough to still be using IE (even if it has improved in some very good ways in recent times), then I don't care what sort of experience they have on my site. They're in the vast minority, and they annoy me, so stuff 'em.
Yep, not a terribly indepth or interesting post, I know, but I needed to post something... my hits were dropping!
'Till next time,
-- Axman
]]>While i was having a look at the code, I noticed that the haskell entry was forkIO'ing a lot of threads, which is exactly what we want. But we weren't quite forking enough; one of the 503 threads was the main thread. Bad idea!
I learnt a few weeks ago, while working on my AVar package, that communicating between bound and non bound threads (forkIO'd vs. main) when using things like MVars can be really slow. And this is exactly what was happening:
main = do a <- newMVar . read . head =<< getArgs z <- foldM new a [2..ring] thread 1 z a
as you can see, the last/first thread was being run in main, so once per loop around the ring, we were talking to main via an MVar, and then talking to another forkIO'd thread via another MVar. So here's what I did:
main = do a <- newMVar . read . head =<< getArgs z <- foldM new a [2..ring] ret <- newEmptyMVar forkIO (thread 1 z a >>= putMVar ret) takeMVar ret
Two and a half lines of code. What were the results? Well, when the program was run with n = 50,000,000, the original ran in ~14.2s, with -N{1,2,3,4}, my modified one took on average ~9.3s, which is about a 33% improvement. It should be noted that when both programs are compiled without -threaded, there is almost no difference in speed at all (and they both run considerably faster than the non threaded version). Need to talk to the shootout peeps and find out if it's against the rules to compile without -threaded, and get an even more massive speed boost.
-- Axman
]]>This semester I'm doing some rather interesting courses (and some not so much...)
COMP2300 - Introduction to Computer Systems
Which is about.. well computer systems. It covers topics like binary representations of numbers, C, computer architecture, etc. The thing I am however most looking forward to the most will be the third assignment, which will be based around the uni's new T2 (the one Ben Lippmeier is using for most of his GHC on SPARC work)
COMP2100 - Software Construction
This seems to be more about how to write larger software, than actual programming (though it does emphasise programming weekly to get into good habits). I'm interested to see for the Personal Software Process (PSP) stuff goes, it seems to me that it can make you a more productive programmer quite easily. After only an hour of using the time keeping for it, i've noticed i don't get distracted as much, because it's not programming time, so all i do is program in this time. Means i distract myself less, which is very helpful.
ENGN2211 - Electronic Circuits
This is a second year electronics course, and should be fairly interesting too. Not much to say about this one...
ENGN2226 - Engineering Systems Analysis
This course is taught by a pretty cool German maths PhD, and focuses mostly on modelling systems, which is obviously an integral part of engineering. We'll have to use MATLAB for this, which from what I've heard from others may not be very fu at all. Could be a good place to use some of the nice statistical packages for haskell...
Anyway, I'll try and keep up with the haskelling, but I'll be doing a lot of non haskell this semester (C, Java, ASM, MATLAB), so it may have to fall by the way side for now :(
-- Axman
]]>So what's new? Well, i split it up a bit, into three modules: Data.AVar, the classic interface, Data.AVar.Unsafe, the same as Data.AVar, but it throws any exceptions encountered by the variable, instead of passing them back to the user, and Data.AVar.Internal, which contains the code for the actual for AVars, and the datatypes used by them.
I think this is a nice way of doing things, and hopefully will make using the system a little easier if you don't expect to cause exceptions.
So as always, if you have any suggestions, please let me know.
-- Axman
]]>With the current release, i think that all exceptions that may occur from functions passed by the user to the variable should be caught by and handled correctly by the variable. I guess in a sense, AVars are smart variables that know what is and isn't good for them, and will refuse to hurt themselves (hopefully!).
If you're interested in seeing what AVar can do, check out the Hackage page. I really have no idea how it might be useful, but I'd love to hear others thoughts on it.
If you have any requests, please let me know, and I'll see what I can do (proper transactional ... transactions are not something I want to tackle, especially with uni starting on monday)
]]>So, the new features I've added are mainly to do with exception handling, so that variables don't 'die' if you call tail on [], they report the error, and don't change the 'state'. I've also deleted the Swap constructor, and replaced it with a more general Mod' constructor:
data Transaction a = Put a | Get (MVar a) | Mod (a -> a) (MVar (Maybe E.SomeException)) | forall b. Mod' (a -> (a,b)) (MVar (Either E.SomeException b)) | Atom (a -> Bool) (a -> a) (a -> a) (MVar Bool)
This you provide a function which takes the current 'state', possibly modifies it, and returns something else, and return that something else back to you. This works a lot like the State monad, but allows concurrency.
I've changed handler as well to look like this:
handler :: Chan (Transaction a) -> a -> IO b handler chan !x = do req <- readChan chan case req of Put a -> handler chan a Get mvar -> do putMVar mvar x handler chan x Mod f mvar -> do let x' = f x p <- E.catch (E.evaluate x' >> return Nothing) (\e -> return (Just e)) putMVar mvar p case p of Nothing -> handler chan x' _ -> handler chan x Mod' f mvar -> do let y@(a,b) = f x p <- E.try (E.evaluate a >> E.evaluate b) case p of Right _ -> do putMVar mvar (Right b) handler chan a (Left e) -> do putMVar mvar (Left e) handler chan x Atom test y n res -> if test x then do putMVar res True handler chan (y x) else do putMVar res False handler chan (n x)
As you can see, I've added some exception handling, but I still need to add some more to the Atom/condModAVar case. What I want is something that can keep running even after there's been an exception. I mean, who wants a mutable variable to just stop working huh?. I think once I get that done, along with haddock docs, I'll stick it on hackage.
]]>It turned out to be really simple to implement, and I think just showing you the code would explain what I'm on about more than anything else. I don't know how else this could be extended (I'm sure it could be though, for some fairly interesting ideas), and since it has been written in the wee hours of the morning, I may be doing some pretty stupid stuff...
So, I'd love to hear some discussion (though yes, I do already know this could probably be done with MVars or TVars or what have you) and ideas, and here's the code:
module ASTM where import Control.Concurrent import Control.Concurrent.MVar import Control.Concurrent.Chan data Transaction a = Put a | Get (MVar a) | Mod (a -> a) | Atom (a -> Bool) (a -> a) (a -> a) (MVar Bool) data AVar a = AVar (Chan (Transaction a)) newAVar :: a -> IO (AVar a) newAVar x = do chan <- newChan :: IO (Chan (Transaction a)) forkIO (handler chan x) return (AVar chan) where handler chan x = do req <- readChan chan case req of Put a -> handler chan a Get mvar -> do putMVar mvar x handler chan x Mod f -> handler chan (f x) Atom test y n res -> if test x then do putMVar res True handler chan (y x) else do putMVar res False handler chan (n x) putAVar (AVar chan) x = writeChan chan (Put x) modAVar (AVar chan) f = writeChan chan (Mod f) getAVar (AVar chan) = do res <- newEmptyMVar writeChan chan (Get res) takeMVar res condModAVar (AVar chan) p t f = do res <- newEmptyMVar writeChan chan (Atom p t f res) takeMVar res]]>
The main problem seems to be that GHC is allocating a lot of RAM, which must be related to the need for Integers. The current program uses up 500+MB by the time it finishes. Not good.
So, I'm putting a call out to see if anyone else can either think of a better way to get the answer than the current entry, or any tips about reducing memory usage. If you come up with anything, I'd love to hear from you.
Cheers, ~ Axman
]]>For this benchmark, each language is limited by the speed of the regex library it's using.
Right... let me see. Here's what I did;
I am not certain, but it seems that forcing the evaluation of s1, s2 and s3 (the blobs of input data) before parallelizing the processing gave better CPU utilisation. I also changed the part at the end where it does large numbers of pattern substitutions, so that it updated everything in-place in a mutable buffer. I found that splitting the pattern substitutions into chunks sped things up by a factor of three. It looks like there's some sort of overhead incurred on large buffers when the regex 'match' function creates its AllMatches array.
The reason why I needed memmove instead of memcpy is that memmove can work on overlapping buffers.
These changes improved the performance from 1:00 user / 0:42.2 real to 0:40.1 user / 0:25.12 real on my dual core, compared with 23.3 sec user for the slower non-parallel one of the two C++ implementations. (The parallel one wouldn't build for me.)
You can see the details of the submission here, and the actual code. He also adds:
I took my unsafePerformIO's out too. I have a reputation to maintain!
It's good to see that someone else is working on making haskell look good (and doing a much better job than me thankfully!). Maybe soon we'll be topping the list, or at least beating Java to move up to 4th place.
]]>If you're wondering what I'm on about, take a look at this post for the story of my n-bodies program so far, and this port for what my code looked like before.
So how did I do it this time? Well, I decided STRefs weren't necessary, and could easily be replaces with accumulating parameters in basically all of my code that used them. I did this in the hope they would be kept in registers, but even if they're not, it's still faster. I also saved about 3 seconds by inlining all my read* and write* functions with {-# INLINE #-} pragmas that would write or fetch the various parts of the Body's info. So here's the code, first the original one:
advance dt ps = do forM_ index1 $ \i -> do -- (B p v m) <- readBody ps i p <- readPos ps i v <- readVel ps i m <- readMass ps i vvar <- newSTRef v forM_ (index2 i) $ \j -> do -- (B p' v' m') <- readBody ps j p' <- readPos ps j v' <- readVel ps j m' <- readMass ps j let dp = p .-. p' dst = mag dp magnit = dt / (dst * dst * dst) change = magnit *. dp (sca1,sca2) = (m' *. change, m *. change) writeVel ps j (v' .+. sca2) modifySTRef vvar (.-. sca1) vvar'@(V nx ny nz) <- readSTRef vvar -- unsafeIOToST (print vvar') writeVel' ps i nx ny nz writePos ps i $ move' dt (B p vvar' m)
And the new one, with an inner loop:
advance dt ps = forM_ index1 $ \i -> do -- (B p v m) <- readBody ps i p <- readPos ps i v <- readVel ps i m <- readMass ps i let loop2 !j !v@(V !x !y !z) | j > numPs = return v | otherwise = do p' <- readPos ps j v' <- readVel ps j m' <- readMass ps j let dp = p .-. p' dst = mag dp magnit = dt / (dst * dst * dst) change = magnit *. dp (sca1,sca2) = (m' *. change, m *. change) writeVel ps j (v' .+. sca2) loop2 (j+1) (v .-. sca1) v' <- loop2 (i+1) v -- unsafeIOToST (print v') writeVel ps i v' writePos ps i $ move' dt (B p v' m)]]>
I've been using the changes while he's been working on them, and they certainly do make the code look quite a bit better. I'll be happy when haskell is a first class language in TextMate, and this is the first big step in getting it there. Hooray!
~ Axman
]]>First I should explain the problem. What needs to happen is I take 5 planets and the sun, each with an initial position and velocity, and a mass. Then I set about modifying each body's position and velocity according to the gravitational pull of all the other bodies. For the purposes of this problem, in the end we're only interested in the total energy in the system, which changes as time goes along. For the actual shootout, the bodies must be iterated 50,000,000 times, with a delta time of 0.1 (Not actually sure what that's 0.1 of, possibly days).
The reason I got interested in this problem was because I decided to take a look at the current haskell submission. I was a little horrified when I say it as all pointer nonsense and back magic. Full of stuff haskell can do fine (And possibly better and more safely that other languages), but should really be avoided where possible. I wanted to see if you could write a fast version, using more accessible techniques.
So my initial try used lists. I thought about how I could make is faster, and cool at the same time, and failed by using Control.Parallel, and I think all I have to say about this version that I am not proud of it, and when I just tried to run it with n=50000000, I decided to kill it after it reached 3.3GB of RAM usage in under a minute. Yeah, not great at all.
So my next iteration of the problem basically continued on from the list version, but this using parallel arrays. As I'd basically followed in the same steps I'd used for the list version, its performance was on par with that of the list version; it was also killed after using 3GB of RAM in about 30 seconds, and again, I was not proud. It should also be mentioned that neither the list of parallel array versions produced the correct answers with n=1000, so they were never going to be contenders
It was about this time I discovered the ST monad, and I fell in love (Sort of). The ST monad allows you to write imperative programs, using mutable variables and arrays, in a totally pure way. It's a little like the State monad, but it has a generic state of 'forall s'. I'm not going to go into the details of ST, but if you're interested, check out SPJ's paper on the subject of Lazy Functional State Threads (.ps.Z).
This is where I finally started to get some good results. The program runs in about 1.4MB RAM (:O), which means I could actually time its runtime. So I did that, and well, at least it finished. The runtime was 14m46.957s according to time, which is still considerably faster than both Pythons, JavaScript under TraceMonkey, ruby, perl, php, and ruby again, but it's slower than Lua, which is 24x slower than the current fastest C++. But I was getting somewhere!
I could see this was the way to go, with memory usage being the most important thing so far, ST made keeping it really low easy as can be.
Now for some speed...
I can't remember where I found out about STUArrays, but I could see they were the obvious solution. They're almost as close to C arrays as you're going to get in nice haskell, while still remaining pure, and not so ugly. Basically STUArrays are unboxed arrays (U) in the ST monad (ST). This means that when out put a type into them, instead of putting a pointer to the data in the type inside the array, you put the actual data into the array, so it's all sitting next to each other.
This of course restricts the type you can out into an array somewhat to things like Doubles, Ints, Words, and the few other things with single constructors (This rules out Bools and Integers). There is quite a speed advantage to using STUArrays, but writing your own instance for say MArray (STUArray s) Body (ST s) is a little off putting. Luckily I had talked with Dons about what I was working on, and he'd already started working on something similar. So I nicked his MArray instance, modified it, and... Failed.
For some reason, I kept getting segfaults when trying to get this STUArray stuff to work with my Body type with n > 22:
data Vec3 = V !Double !Double !Double data Body = B { pos :: {-# UNPACK #-} !Vec3, vel :: {-# UNPACK #-} !Vec3, mass :: !Double }
I was not happy! And I still have no idea what went wrong.
But I moved on.
I decided I'd avoid the MArray instance completely and use Double STUArrays directly. This turned out to be a good idea indeed, bringing some nice performance benefits.
By doing this, I didn't need to worry about taking out redundant data from the array by fetching a whole Body each time, I could pick out the data I needed, be it the Velocity, Mass or Position, or all three if I needed them all.
With this work, I brought the runtime down to around 2m40 (I think), an approx. 80% improvement in runtime! This was massive! I was certainly onto something. I was now sitting behind Erlang at 5.9x and below Scheme PLT at 9.1x.
Ok, I'd come this far, but I was now stuck for ways to increase the speed. I'd done some algorithm rejiggering to see if I could gain any speed, and I managed to cut another 10 seconds or so off, but that wasn't going to cut it.
So, I took a look at the performance pages on the wiki. The Arrays page was most useful, suggesting that the use of unsafeRead and unsafeWrite could make huge improvments by removing redundant bounds checking. The floating point page also helped a little, with the suggestion of using the -fexcess-precision flag to speed up the floating point calculations. With these two changes, I managed to cut a whole minute 15 off the time. Yes, I just got a 50% speedup! Now I was getting happy. I was now beating Erlang HiPE, but sadly I was nowhere near C#'s 45 seconds, and definitely nowhere near C++'s 21 seconds. Still, how often do you get to produce a 50% speedup in some already relatively fast code?
So what next? Well, I think I can save some more time be using explicit loops with accumulation parameters instead of using STRefs which I have a feeling may carry some overhead. I don't know what kind of gains I can expect, but I doubt they'll be that large. I might also consider making my code even more C like, by directly accessing parts of the arrays directly. I may even get rid of the whole ST thing, and working in IO and with more primitive operations, but by doing that, I'll be moving away from the easier to understand code I have now.
So, what can I conclude from all this? Well, Haskell sure can be fast, while still remaining beautiful. But making it really fast starts to get ugly (Introducing unsafe* does not help :\ ). There are obvious way to do things in haskell, and even some obvious fast ways to do them. But really fast code takes effort (Which is true of most, if not all languages). I've learnt a lot while writing this program, and I've still got a lot to learn. Wish me luck!
]]>I used a few simple tricks from the performance part of the haskell wiki, mainly the use of unsafeRead and unsafeWrite from the Arrays page, and the use of -fexcess-precision to speed up the Double computation.
For those interested in my progress (no one), here's my current code:
{-# OPTIONS -O2 -funbox-strict-fields -fexcess-precision -fvia-C -optc-mfpmath=sse -optc-msse2#-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} module Main where import System.Environment import Data.Array.Base import GHC.Exts import GHC.ST import GHC.Arr import Control.Monad import Control.Monad.ST import Data.List import qualified Data.Array.Unboxed as U import Data.Array.Base import Foreign.Storable import Text.Printf import Data.STRef data Vec3 = V {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double -- deriving (Show) data Body = B { pos :: {-# UNPACK #-} !Vec3, vel :: {-# UNPACK #-} !Vec3, mass :: {-# UNPACK #-} !Double } -- deriving (Show) main = do n <- getArgs >>= \xs -> if null xs then return 1000 else (readIO.head) xs let (e,e') = runST $ do ps <- planets offset ps e1 <- energy ps advn n ps e2 <- energy ps return (e1,e2) prtnum e prtnum e' advn n ps = replicateM_ n (advance deltat ps) ------------------ offset ps = do v <- newSTRef (V 0 0 0) p <- readPos ps 0 ve <- readVel ps 0 forM_ index1 $ \i -> do vel <- readVel ps i m <- readMass ps i modifySTRef v (.+. (m *. vel)) modifySTRef v (./ solar_mass) v' <- readSTRef v writeVel ps 0 (ve .-. v') advance dt ps = do forM_ index1 $ \i -> do -- (B p v m) <- readBody ps i p <- readPos ps i v <- readVel ps i m <- readMass ps i vvar <- newSTRef v forM_ (index2 i) $ \j -> do -- (B p' v' m') <- readBody ps j p' <- readPos ps j v' <- readVel ps j m' <- readMass ps j let dp = p .-. p' dst = mag dp magnit = dt / (dst * dst * dst) change = magnit *. dp (sca1,sca2) = (m' *. change, m *. change) modifySTRef vvar (.-. sca1) writeVel ps j (v' .+. sca2) vvar'@(V nx ny nz) <- readSTRef vvar writeVel' ps i nx ny nz writePos ps i $ move' dt (B p vvar' m) index1 = [0..numPs] -- index1 = map (*7) [0..numPs] index2 i = [(i+1)..numPs] -- index2 = map (\x -> (x*7,x)) [0..numPs] -- index3 = tail . tails $ index1 energy ps = do e <- newSTRef (0 :: Double) forM_ index1 $ \i -> do b1 <- readBody ps i modifySTRef e ((+) (kinetic b1)) forM_ (index2 i) $ \j -> do b2 <- readBody ps j let x = potential b1 b2 modifySTRef e (subtract x) readSTRef e move dt (B p v m) = B (p .+. dt *. v) v m move' dt (B p v m) = p .+. dt *. v ----------------------- writePos :: STUArray s Int Double -> Int -> Vec3 -> ST s () writePos !arr !i !(V x y z) = case i*7 of i'@(I# n) -> do unsafeWrite arr i' x unsafeWrite arr (I# (n +# 1#)) y unsafeWrite arr (I# (n +# 2#)) z writePos' :: STUArray s Int Double -> Int -> Double -> Double -> Double -> ST s () writePos' !arr !i !x !y !z = case i*7 of i'@(I# n) -> do unsafeWrite arr i' x unsafeWrite arr (I# (n +# 1#)) y unsafeWrite arr (I# (n +# 2#)) z writeVel :: STUArray s Int Double -> Int -> Vec3 -> ST s () writeVel !arr !i !(V vx vy vz) = case i*7 of i'@(I# n) -> do unsafeWrite arr (I# (n +# 3#)) vx unsafeWrite arr (I# (n +# 4#)) vy unsafeWrite arr (I# (n +# 5#)) vz writeVel' :: STUArray s Int Double -> Int -> Double -> Double -> Double -> ST s () writeVel' !arr !i !vx !vy !vz = case i*7 of i'@(I# n) -> do unsafeWrite arr (I# (n +# 3#)) vx unsafeWrite arr (I# (n +# 4#)) vy unsafeWrite arr (I# (n +# 5#)) vz -- writeMass :: STUArray s Int Double -> Int -> Double -> ST s () -- writeMass arr i m = -- do -- unsafeWrite arr (i+6) m writeBody :: STUArray s Int Double -> Int -> Body -> ST s () writeBody !arr !i !(B !(V x y z) !(V vx vy vz) m) = case i*7 of i'@(I# n) -> do unsafeWrite arr (i') x unsafeWrite arr (I# (n +# 1#)) y unsafeWrite arr (I# (n +# 2#)) z unsafeWrite arr (I# (n +# 3#)) vx unsafeWrite arr (I# (n +# 4#)) vy unsafeWrite arr (I# (n +# 5#)) vz unsafeWrite arr (I# (n +# 6#)) m readPos :: STUArray s Int Double -> Int -> ST s Vec3 readPos !arr !i = case i*7 of i'@(I# n) -> do x <- unsafeRead arr i' y <- unsafeRead arr (I# (n +# 1#)) z <- unsafeRead arr (I# (n +# 2#)) return (V x y z) readVel :: STUArray s Int Double -> Int -> ST s Vec3 readVel !arr !i = case i*7 of i'@(I# n) -> do vx <- unsafeRead arr (I# (n +# 3#)) vy <- unsafeRead arr (I# (n +# 4#)) vz <- unsafeRead arr (I# (n +# 5#)) return (V vx vy vz) readMass :: STUArray s Int Double -> Int -> ST s Double readMass !arr !i = case i*7 of i'@(I# n) -> unsafeRead arr (i*7+6) readBody :: STUArray s Int Double -> Int -> ST s Body readBody !arr !i = case i*7 of i'@(I# n) -> do x <- unsafeRead arr i' y <- unsafeRead arr (I# (n +# 1#)) z <- unsafeRead arr (I# (n +# 2#)) vx <- unsafeRead arr (I# (n +# 3#)) vy <- unsafeRead arr (I# (n +# 4#)) vz <- unsafeRead arr (I# (n +# 5#)) m <- unsafeRead arr (I# (n +# 6#)) return (B (V x y z) (V vx vy vz) m) ----------------------- solar_mass, deltat, days_per_year :: Double days_per_year = 365.24 dp = days_per_year solar_mass = 4 * pi * pi deltat = 0.01 numPs = length planetsList - 1 -- planets'' = newArray (0,(numPs+1)*7) 0 :: ST s (STUArray s Int Double) -- (B (V 0 0 0) (V 0 0 0) 1) -- ms = U.listArray (0,numPs+1) (map mass planetsList) planets = do arr <- newArray (0,(numPs+1)*7) 0 :: ST s (STUArray s Int Double) -- unsafeReplaceUArray arr (zip index1 planetsList) forM_ (zip index1 planetsList) $ \(i,p) -> do -- unsafeIOToST (print (i, pos p)) writeBody arr i p return arr planetsList = [B (V 0.0 0.0 0.0) (V 0.0 0.0 0.0) solar_mass, B (V (4.84143144246472090e+00) (-1.16032004402742839e+00) (-1.03622044471123109e-01)) (V (1.66007664274403694e-03*dp) (7.69901118419740425e-03*dp) ((-6.90460016972063023e-05)*dp)) (9.54791938424326609e-04 * solar_mass), B (V (8.34336671824457987e+00) (4.12479856412430479e+00) (-4.03523417114321381e-01)) (V ((-2.76742510726862411e-03)*dp) (4.99852801234917238e-03*dp) (2.30417297573763929e-05*dp)) (2.85885980666130812e-04 * solar_mass), B (V (1.28943695621391310e+01) (-1.51111514016986312e+01) (-2.23307578892655734e-01)) (V (2.96460137564761618e-03*dp) (2.37847173959480950e-03*dp) ((-2.96589568540237556e-05)*dp)) (4.36624404335156298e-05 * solar_mass), B (V (1.53796971148509165e+01) (-2.59193146099879641e+01) (1.79258772950371181e-01)) (V (2.68067772490389322e-03*dp) (1.62824170038242295e-03*dp) ((-9.51592254519715870e-05)*dp)) (5.15138902046611451e-05 * solar_mass) ] ----------------------- infix 4 .-. infix 4 .+. -- infix 5 .*. infixr 5 *. infixl 5 ./ {-# INLINE (.+.) #-} {-# INLINE (.-.) #-} -- {-# INLINE (.*.) #-} V x y z .+. V x' y' z' = V (x+x') (y+y') (z+z') V (D# x) (D# y) (D# z) .-. V (D# x') (D# y') (D# z') = V (D# (x -## x')) (D# (y -## y')) (D# (z -## z')) -- V x y z .*. V x' y' z' = V (x*x') (y*y') (z*z') {-# INLINE (*.) #-} n *. (V x y z) = V (n*x) (n*y) (n*z) {-# INLINE (./) #-} V x y z ./ n = V (x/n) (y/n) (z/n) -- {-# INLINE momentum #-} momentum :: Body -> Vec3 momentum (B _ v m) = m *. v {-# INLINE kinetic #-} kinetic x = 0.5 * mass x * (mag2.vel) x -- kinetic' potential a b = let dst = dist' a b in --if dst <= 0 --then 0 --else (mass a * mass b) / dist' a b {-# INLINE mag #-} mag :: Vec3 -> Double mag = sqrt . mag2 {-# INLINE mag2 #-} mag2 (V x y z) = x*x + y*y + z*z {-# INLINE dist #-} dist v1 v2 = sqrt $ dist2 v1 v2 {-# INLINE dist2 #-} dist2 v1 v2 = mag2 $ v1 .-. v2 {-# INLINE dist' #-} dist' b1 b2 = dist (pos b1) (pos b2) prtnum :: Double -> IO () prtnum x = putStrLn $ printf "%.9f" x -------------------- tests thing2 pla = do arr <- pla unsafeIOToST (putStrLn "thing2") forM_ [0..numPs*7] $ \i -> do p <- readArray arr i unsafeIOToST (print (i,p)) thing3 = do arr <- planets offset arr thing2 planets unsafeIOToST (putStrLn "\n") -- thing2 arr e <- energy arr return e]]>
(All the MUArray instance stuff is from Don's work, which I nicked)
So, here we have it:
> {-# OPTIONS -O2 -funbox-strict-fields #-} > {-# LANGUAGE BangPatterns #-} > {-# LANGUAGE UnboxedTuples #-} > {-# LANGUAGE MagicHash #-} > {-# LANGUAGE MultiParamTypeClasses #-} > > module Main where > > import System.Environment > import Data.Array.Base > import GHC.Exts > import GHC.ST > import GHC.Arr > import Control.Monad > import Control.Monad.ST > import Data.List > import Foreign.Storable > import Text.Printf > import Data.STRef > > > data Vec3 = V !Double !Double !Double deriving (Show) > data Body = B { > pos :: {-# UNPACK #-} !Vec3, > vel :: {-# UNPACK #-} !Vec3, > mass :: !Double > } deriving (Show) > > > main = do > n <- getArgs >>= \xs -> if null xs then return 1000 else (readIO.head) xs > let (e,e') = runST $ do > ps <- planets > offset ps > e1 <- energy ps > advn n ps > e2 <- energy ps > return (e1,e2) > prtnum e > prtnum e' > > > offset ps = do > v <- newSTRef (V 0 0 0) > (B p ve m) <- readArray ps 0 > forM_ [0..numPs] $ \i -> do > p <- readArray ps i > modifySTRef v (.+. momentum p) > modifySTRef v (./ solar_mass) > v' <- readSTRef v > writeArray ps 0 (B p (ve.-. v') m) > > > > advn 0 ps = do > return ps > advn n ps = do > advance deltat ps > -- e <- energy ps > -- unsafeIOToST (prtnum e) > advn (n-1) ps > > advance dt ps = do > forM_ [0..numPs] $ \i -> do > (B p v m) <- readArray ps i > vvar <- newSTRef v > forM_ [i+1..numPs] $ \j -> do > (B p' v' m') <- readArray ps j > let dp = p .-. p' > dst = mag dp > magnit = dt / (dst * dst * dst) > change = magnit *. dp > sca1 = m' *. change > sca2 = m *. change > -- writeArray ps I (B p (v .-. sca1) m) > modifySTRef vvar (.-. sca1) > writeArray ps j (B p' (v' .+. sca2) m') > vvar' <- readSTRef vvar > writeArray ps I (move dt (B p vvar' m)) > > > energy ps = do > e <- newSTRef (0 :: Double) > > forM_ [0..numPs] $ \i -> do > b1 <- readArray ps i > modifySTRef e ((+) (kinetic b)1) > > forM_ [i+1..numPs] $ \j -> do > b2 <- readArray ps j > let x = potential b1 b2 > modifySTRef e (subtract x) > e' <- readSTRef e > return e' > > > > move dt (B p v m) = B (p .+. dt *. v) v m > > > > > ----------------------- > solar_mass, deltat, days_per_year :: Double > days_per_year = 365.24 > dp = days_per_year > solar_mass = 4 * pi * pi > deltat = 0.01 > numPs = length planets' - 1 > > planets'' = newArray_ (0,numPs) :: ST s (STUArray s Int Body) > -- (B (V 0 0 0) (V 0 0 0) 1) > > planets = do > arr <- planets'' > forM_ (zip [0..] planets') $ \(i,p) -> do > writeArray arr I p > return arr > > planets' = > [B (V 0.0 > 0.0 > 0.0) > (V 0.0 > 0.0 > 0.0) > solar_mass, > > B (V 4.84143144246472090e+00 > (-1.16032004402742839e+00) > (-1.03622044471123109e-01)) > (V (1.66007664274403694e-03*dp) > (7.69901118419740425e-03*dp) > ((-6.90460016972063023e-05)*dp)) > (9.54791938424326609e-04 * solar_mass), > > B (V 8.34336671824457987e+00 > 4.12479856412430479e+00 > (-4.03523417114321381e-01)) > (V ((-2.76742510726862411e-03)*dp) > (4.99852801234917238e-03*dp) > (2.30417297573763929e-05*dp)) > (2.85885980666130812e-04 * solar_mass), > > B (V 1.28943695621391310e+01 > (-1.51111514016986312e+01) > (-2.23307578892655734e-01)) > (V (2.96460137564761618e-03*dp) > (2.37847173959480950e-03*dp) > ((-2.96589568540237556e-05)*dp)) > (4.36624404335156298e-05 * solar_mass), > > B (V 1.53796971148509165e+01 > (-2.59193146099879641e+01) > 1.79258772950371181e-01) > (V (2.68067772490389322e-03*dp) > (1.62824170038242295e-03*dp) > ((-9.51592254519715870e-05)*dp)) > (5.15138902046611451e-05 * solar_mass) > ] > > > ----------------------- > > infix 4 .-. > infix 4 .+. > -- infix 5 .*. > infixr 5 *. > infixl 5 ./ > > {-# INLINE (.+.) #-} > {-# INLINE (.-.) #-} > -- {-# INLINE (.*.) #-} > V x y z .+. V x' y' z' = V (x+x') (y+y') (z+z') > V x y z .-. V x' y' z' = V (x-x') (y-y') (z-z') > -- V x y z .*. V x' y' z' = V (x*x') (y*y') (z*z') > > {-# INLINE (*.) #-} > n *. (V x y z) = V (n*x) (n*y) (n*z) > {-# INLINE (./) #-} > V x y z ./ n = V (x/n) (y/n) (z/n) > > {-# INLINE momentum #-} > momentum :: Body -> Vec3 > momentum (B _ v m) = m *. v > > {-# INLINE kinetic #-} > kinetic x = 0.5 * mass x * (mag2.vel) x > > > potential a b = > let dst = dist' a b > in if dst <= 0 > then 0 > else (mass a * mass b) / dist' a b > > {-# INLINE mag #-} > mag :: Vec3 -> Double > mag = sqrt . mag2 > > {-# INLINE mag2 #-} > mag2 (V x y z) = x*x + y*y + z*z > > {-# INLINE dist #-} > dist v1 v2 = sqrt $ dist2 v1 v2 > > {-# INLINE dist2 #-} > dist2 v1 v2 = mag2 $ v1 .-. v2 > > {-# INLINE dist' #-} > dist' b1 b2 = dist (pos b1) (pos b2) > > prtnum x = putStrLn $ printf "%.9f" x > > -------------------- > bodyScale :: Int# -> Int# > bodyScale n = (scale *# 7#) *# n > where I# scale = sizeOf (undefined :: Double) > > instance MArray (STUArray s) Body (ST s) where > > {-# INLINE getBounds #-} > getBounds (STUArray l h _ _) = return (l,h) > > {-# INLINE getNumElements #-} > getNumElements (STUArray _ _ n _) = return n > > {-# INLINE unsafeNewArray_ #-} > unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bodyScale -- bytes > > {-# INLINE newArray_ #-} > newArray_ bounds = newArray bounds (B (V 0 0 0) (V 0 0 0) 1) > > > {-# INLINE unsafeRead #-} > unsafeRead (STUArray _ _ _ arr) (I# i) = ST $ \s1 -> > let j = bodyScale i in > case readDoubleArray# arr j s1 of { (# s2, xd #) -> > case readDoubleArray# arr (j +# 1#) s2 of { (# s3, yd #) -> > case readDoubleArray# arr (j +# 2#) s3 of { (# s4, zd #) -> > case readDoubleArray# arr (j +# 3#) s4 of { (# s5, vxd #) -> > case readDoubleArray# arr (j +# 4#) s5 of { (# s6, vyd #) -> > case readDoubleArray# arr (j +# 5#) s6 of { (# s7, vzd #) -> > case readDoubleArray# arr (j +# 6#) s7 of { (# s8, massd #) -> > (# s8, B { pos = V (D# xd) (D# yd) (D# zd) > , vel = V (D# vxd) (D# vyd) (D# vzd) > , mass = D# massd } #) }}}}}}} > > {-# INLINE unsafeWrite #-} > unsafeWrite (STUArray _ _ _ arr) (I# i) > (B (V (D# xd) (D# yd) (D# zd)) (V (D# vxd) (D# vyd) (D# vzd)) (D# massd)) > = ST $ \s1 -> > let j = bodyScale i in > case writeDoubleArray# arr j xd s1 of {s2 -> > case writeDoubleArray# arr (j +# 1#) yd s2 of {s3 -> > case writeDoubleArray# arr (j +# 2#) zd s3 of {s4 -> > case writeDoubleArray# arr (j +# 3#) vxd s4 of {s5 -> > case writeDoubleArray# arr (j +# 4#) vyd s5 of {s6 -> > case writeDoubleArray# arr (j +# 5#) vzd s6 of {s7 -> > case writeDoubleArray# arr (j +# 6#) massd s7 of {s8 -> > (# s8, () #) }}}}}}} >]]>
Treating potential customers like potential thieves makes them feel more inclined to follow these feeling. I'll admit that I've pirated software, but I've also bought a lot of it too. The stuff I've pirated is uaually something that I feel is far overpriced for what they offer. Like Marcus says, software is something you make once, and sell thousands of times; it's making money from nothing. The things I've bought are usually pretty cheap, and that makes me want to buy them, I want to help the developer and reward them for making something which is useful to me, and reasonably priced, or even a bargain.
I do not like being forced to buy your software. I do not like being forced to buy your software to use it for something that is useful, but not exactly (or at all) worth paying $30 for. Nor do I like being told that I have not bought your software. Give me the full thing to try, without restrictions, at all, give me a month and see if I feel I need it. If after that month, (and that's a month of use, not a month from the date of download), I feel I need your software, then I will buy it. If I never hit that month, then no, I will not be buying it, it has not been useful enough for me to consider it. Doesn't mean it's not great, or that it's buggy and annoying (I will tell you if it is), it just means I have no ude for it.
I'll take an example, VMware Fusion. Now, this is made by a very large company, a big, corporate business, that makes expensive software for some rather important tasks. But what happened when Fusion v2.0 came out? they gave it to us for free! I, and I'm sure many others would have paid for this update, they did a lot of work for it, added some very nice new features. But instead of them saying "hey! they're getting new stuff, they HAVE to pay!", they seemed to take the stance that these new features were missing features, and that v2.0 was heading towards making the program more complete, rather than expanding it.
This is an excellent example of how I feel software licencing should work. Be nice to your customers, give them treats, and they will do more than stay quiet about your products, they will tell their friends, or anyone they know who might be interested. They feel an affinity with you and your software, and will go the point of arguing and fighting over which is better, your product, or someone else's. Loyalty will always bring you more than fear, and being nice will bight you in the arse far less often than being a dick.
I don't think I have summed this up as well as Marcus managed to (I've just written this from start to finish, and can't be bothered to re-read it [pan's labyrinth awaits]), but I did feel like showing my support for his views, because he got how I feel so right.
Anyway, more later
~ Axman
]]>