Profiling trouble
Ferenc Wagner
wferi@afavant.elte.hu
Mon, 27 Jan 2003 17:42:41 +0100
--=-=-=
"Simon Marlow" <simonmar@microsoft.com> writes:
> If you could send us a smaller example that displays the
> problem, we'll be happy to look into it.
Well, here is a definitively smaller, although not too small
example (182 lines total). Options are hardcoded in this
version. Compile with
ghc -o show --make Show2.hs -prof -auto-all
and run as
./show +RTS -p
to get the profile (also attached).
Btw, I also get a warning before linking (only with 5.04-1
got from http://lambda.foldr.org/~michaelw/debian-unoff/
/dists/unstable/binary-i386/):
/tmp/ghc16560.hc:1247: warning: initialization discards qualifiers from pointer target type
I hope I didn't leave out anything. And if you have any
comments regarding the code, I'd be glad to head them, too.
Cheers: Feri.
--=-=-=
Content-Disposition: attachment; filename=Show2.hs
Content-Description: Main module
import Tcsa
import Boson
import Complex
showData :: BaseVector a => Params -> Operator a -> String
showData params pot = unlines ["Version 3.1",
"",
showParams pot params,
"tcsdim: " ++ tcsDim,
"",
"conformal energies:",
diagonals,
"perturbation matrix:"] ++
matrixElements
where
cutStates = {-# SCC "showData1" #-} getStates params
tcsDim = {-# SCC "showData2" #-} show (length cutStates)
diagonals = {-# SCC "showData3" #-} unlines $ map (show . energy) cutStates
matrixElements = {-# SCC "showData4" #-} unlines $ map unwords off
off = {-# SCC "showData5" #-} [map (show . pot outV) (take i cutStates)
| (outV,i) <- zip cutStates [1..]]
main = do let params = Params {cut=5, radius=3, topCharge=0, spin=0, delta=0.55556, prefac=1}
putStr $ showData params (ncVop params)
--=-=-=
Content-Disposition: attachment; filename=Tcsa.lhs
Content-Description: Common definitions
%include lhs2TeX.fmt
%align 33
\begin{code}
module Tcsa (Sector(NS,R),Params(..),Chiral(..),BaseVector(..),Operator,getStates) where
import Complex
data Sector = NS | R deriving (Eq,Show,Read)
data Params = Params { cut::Rational, rs::[Float], sector::Sector, spin::Int,
radius::Rational, topCharge::Int, prefac::Float, delta::Float }
type Operator a = a -> a -> Complex Float
class Chiral a where
weight :: a -> Rational
norm' :: a -> Float
class BaseVector a where
scaleDimension :: a -> Rational
spinOf :: a -> Int
norm :: a -> Float
energy :: a -> Float
baseLevels :: Params -> [[a]]
showParams :: Operator a -> Params -> String -- dummy operator
\end{code}
Here we select the vectors with scaling dimension not greater than
|cut|. The minimal scaling dimensions in the sublists must form a
nondecreasing series.
\begin{code}
cutAbove :: BaseVector a => Rational -> [[a]] -> [a]
cutAbove limit (level:levels)
| null level = {-# SCC "cutAbove1" #-} cutAbove limit levels
| null filtered = {-# SCC "cutAbove2" #-} []
| otherwise = {-# SCC "cutAbove3" #-} filtered ++ cutAbove limit levels
where filtered = {-# SCC "cutAbove4" #-} filter ((limit>=).scaleDimension) level
\end{code}
It's vital to perform the cut before the spin selection: that can ruin
the monotonicity required above.
\begin{code}
spinSelect :: BaseVector a => Int -> [a] -> [a]
spinSelect s vects = filter ((s==).spinOf) vects
getStates :: BaseVector a => Params -> [a]
getStates params = spinSelect (spin params) $ cutAbove (cut params) (baseLevels params)
\end{code}
% Local Variables:
% mode: latex
% mode: auto-fill
% eval: (local-set-key "\C-C\C-c" 'compile)
% TeX-master: "Fermion"
% mmm-classes: literate-haskell
% End:
--=-=-=
Content-Disposition: attachment; filename=Boson.lhs
Content-Description: Free boson Hilbert space and matrix elements
%include lhs2TeX.fmt
%align 33
\begin{code}
module Boson (Boson(Boson),CBoson(CBoson),ncVop) where
import Tcsa
import qualified List
import Complex
-- DECREASING POSITIVE modes (with possible multiplicities)
type Mode = Int
-- p=n/r +- qr/2 (vertex op. momentum)
-- the modes are the multiplicities, starting from mode a_(-1)
newtype CBoson = CBoson (Rational,[Mode]) deriving (Eq,Show)
newtype Boson = Boson (CBoson,CBoson) deriving (Eq,Show)
-- put (m<=) instead of (m<) to get the fermionic version
partitions :: [[[Int]]]
partitions = [[]]:[[n]:concat [map (m:) $ dropWhile ((m<).head) pars
| (m,pars) <- zip [n-1,n-2..1] (tail partitions)]
| n <- [1..]]
incrementalBase :: [[([Mode],[Mode])]]
incrementalBase = map (concat . map pairs) (diagSquare countedParts)
where pairs (cls,crs) = [(cl,cr) | cl <- cls, cr <- crs]
countedParts = map (map (counted 0 . reverse)) partitions
diagSquare cs = [zip (reverse $ take n cs) cs | n <- [1..]]
inModule :: [[([Mode],[Mode])]] -> (Rational,Rational) -> [[Boson]]
levels `inModule` (pl,pr) = map (map attach) levels
where attach (cl,cr) = Boson (CBoson (pl,cl),CBoson (pr,cr))
-- call with prev=0
counted :: Mode -> [Mode] -> [Mode]
counted prev [] = []
counted prev (m:ms) = replicate (m-prev-1) 0 ++ 1+length same:counted m rest
where (same,rest) = span (m==) ms
allTowers :: Int -> Rational -> [[[Boson]]]
allTowers q r = incrementalBase `inModule` (p2,-p2):[bothBases (n/r) | n <- [1..]]
where bothBases p1 = zipWith (++) (incrementalBase `inModule` (p1+p2,p1-p2))
(incrementalBase `inModule` (-p1+p2,-p1-p2))
p2 = fromIntegral q * r/2
-- preconditions: 1. on the next list the element with the same index is not less than this
-- 2. we have infinitely many infinite lists
mergeUp :: [[[Boson]]] -> [[Boson]]
mergeUp towers = List.sortBy scaleCmp heads ++ mergeUp (dropFirst (length heads) towers)
where heads = takeWhile listTest (map head towers)
scaleCmp (a:_) (b:_) = compare (scaleDimension a) (scaleDimension b)
scaleCmp _ _ = EQ
listTest [] = True
listTest (a:_) = (scaleDimension $ head $ head towers !! 1) > scaleDimension a
dropFirst n list = map tail (take n list) ++ (drop n list)
instance Chiral CBoson where
weight (CBoson (p,c)) = p^2/2 + fromIntegral (sum $ zipWith (*) c [1..])
norm' (CBoson (_,ms)) = sqrt $ fromIntegral $ product $ [n^exp*factorial!!exp | (n,exp) <- zip [1..] ms]
instance BaseVector Boson where
scaleDimension (Boson (l,r))
= weight l + weight r
spinOf (Boson (l,r)) = truncate (weight l - weight r)
norm (Boson (l,r)) = norm' l * norm' r
baseLevels params = mergeUp $ allTowers (topCharge params) (radius params)
energy s = fromRational $ scaleDimension s - 1/12
showParams _ params = unlines ["cut: " ++ show (fromRational $ cut params),
"radius: " ++ show (fromRational $ radius params),
"topcharge: " ++ show (topCharge params),
"spin: " ++ show (spin params),
"delta: " ++ show (delta params)]
factorial :: [Int]
factorial = 1:1:zipWith (*) [2..13] (tail factorial) -- avoid overflow
vopMode :: Rational -> Int -> Int -> Int -> Rational
vopMode p n l r = sum [block (-p) r k * block p l (l-r+k) *
fromIntegral (n^(r-k) * factorial!!(r-k)) | k <- [max 0 (r-l)..r]]
where block p top bottom = p^bottom * fromIntegral (binomial top bottom)
binomial n k = round $ fromIntegral (factorial!!n) / fromIntegral (factorial!!k * factorial!!(n-k))
vop :: Rational -> CBoson -> CBoson -> Rational
vop p (CBoson (pOut,cOut)) (CBoson (pIn,cIn))
| pOut - pIn == p = product $ zipWith3 (vopMode p) [1..nMax] (cOut++repeat 0) (cIn++repeat 0)
| otherwise = 0
where nMax = max (length cOut) (length cIn)
ncVop' :: Rational -> Boson -> Boson -> Rational
ncVop' p (Boson (lOut,rOut)) (Boson (lIn,rIn))
= vop p lOut lIn * vop p rOut rIn
ncVop :: Params -> Operator Boson
ncVop params bra ket = prefac params * fromRational (ncVop' p bra ket + ncVop' (-p) bra ket) / (2 * norm bra * norm ket) :+ 0
where p = 1/radius params
\end{code}
% Local Variables:
% mode: latex
% mode: auto-fill
% eval: (local-set-key "\C-C\C-c" 'compile)
% TeX-master: "Fermion"
% mmm-classes: literate-haskell
% End:
--=-=-=
Content-Disposition: attachment; filename=show.prof
Content-Description: Time and allocation profile
Mon Jan 27 17:35 2003 Time and Allocation Profiling Report (Final)
show +RTS -p -RTS
total time = 0.84 secs (42 ticks @ 20 ms)
total alloc = 16,217,528 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
ncVop Boson 21.4 22.5
vopMode Boson 19.0 23.4
showData1 Main 16.7 12.2
showData5 Main 14.3 13.2
vop Boson 11.9 12.6
ncVop' Boson 11.9 3.8
showData4 Main 2.4 5.0
showData3 Main 2.4 2.6
mergeUp Boson 0.0 3.1
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 141 0 0.0 0.3 0.0 0.3
CAF Main 134 15 0.0 0.0 100.0 99.4
main Main 140 1 0.0 0.0 100.0 99.4
ncVop Boson 160 1378 21.4 22.5 64.3 62.3
ncVop' Boson 161 2756 11.9 3.8 42.9 39.7
vop Boson 162 5512 11.9 12.6 31.0 35.9
vopMode Boson 164 736 19.0 23.4 19.0 23.4
showData Main 142 1 0.0 0.3 35.7 37.1
showData2 Main 147 0 0.0 0.0 0.0 0.0
showData3 Main 146 0 2.4 2.6 2.4 2.6
showData4 Main 145 0 2.4 5.0 2.4 5.0
showData5 Main 144 0 14.3 13.2 14.3 13.2
showData1 Main 143 0 16.7 12.2 16.7 16.0
cutAbove Tcsa 150 0 0.0 0.0 0.0 0.3
cutAbove2 Tcsa 159 1 0.0 0.0 0.0 0.0
cutAbove3 Tcsa 158 30 0.0 0.1 0.0 0.1
cutAbove4 Tcsa 157 0 0.0 0.2 0.0 0.2
spinSelect Tcsa 149 1 0.0 0.0 0.0 0.0
getStates Tcsa 148 1 0.0 0.0 0.0 3.4
mergeUp Boson 152 6 0.0 3.1 0.0 3.1
allTowers Boson 151 0 0.0 0.1 0.0 0.3
inModule Boson 153 17 0.0 0.2 0.0 0.2
CAF Data.Complex 132 1 0.0 0.0 0.0 0.0
CAF GHC.Float 116 18 0.0 0.1 0.0 0.1
CAF GHC.Handle 88 2 0.0 0.1 0.0 0.1
CAF Boson 73 49 0.0 0.0 0.0 0.2
factorial Boson 163 1 0.0 0.0 0.0 0.0
partitions Boson 155 1 0.0 0.0 0.0 0.0
incrementalBase Boson 154 1 0.0 0.1 0.0 0.1
counted Boson 156 47 0.0 0.0 0.0 0.0
CAF Tcsa 71 1 0.0 0.0 0.0 0.0
--=-=-=--