www.jammni.de

Logo - Kleiner Drache
Login
Username:

Passwort:

Daten merken
Auto-Login
Registrieren
 
Online
niemand
 
Forumsuche
Suche nach:

Logo - DracheHaskell-Forum

  1 2 nächste Seite

Rome

Gepostet:
01.07.2007 22:43

Garbage Collection Problem ?!?  
Servus,

ich schreibe derzeit an ein Programm zur schnellen Onlinemultplikation, d.h. der Algorithmus berechnet die führenden Stellen zuerst.
Soweit läuft alles auch schön schnell, nur habe ich derzeit ein Problem und weiss nicht woran es liegen könnte.
Bis zur 32777ten Stelle rechnet er ohne Probleme, hält dann aber die Ausgabe ohne Fehlermeldung an. Dabei nimmt er von der Eingabeparametern verschiedene Stellen bis einschliesslich die 32800ten , um diese Stelle zu bestimmen. Ich compiliere das Ganze mit GHC Ver. 6.6.1 und der Option -O2 . Die Ausgabe einer einzelnen Zeile erfolgt durch eine IO-Funktion, die sich selbst rekursiv mit aktualisierten Parametern aufruft.
Die Ausgabe der Digits erfolgt Zeilenweise, d.h. etwa so:

dig11 dig21 --> erg1
dig11 dig21 --> erg1
dig11 dig21 --> erg1
.
.
. usw

Ich habe die Garbage-Collection in Verdacht, habe aber keine Ahnung wie ich das prüfen könnte, oder ob es doch "nur" ein Denkfehler meinerseits ist und es wo ganz anders dran liegt.

Für irgendwelche Ideen oder Anregungen wäre ich sehr dankbar.

Gruß
Rome

Zum Seitenanfang    
 
Siracusa

Gepostet:
01.07.2007 23:07

   
Hallo,

magst du mal den Code posten? Ist sonst nicht wirklich nachzuvollziehen wo der Fehler liegen könnte.

Ansonsten kompiliere doch mal mit den GHC-Optionen -prof -auto-all und starte die erzeugte exe-Datei mit den Optionen +RTS -p. Dann wird dir eine Datei programmname.prof erzeugt, in der einige nützliche Hinweise zur Speicherallokierung und Funktionsaufrufen stehen. Soweit ich weiß ist beim GHC die Heap-Größe standardmäßig unbegrenzt, er sollte dir also eher den Speicher vollschaufeln, als das Programm wegen Speicher-Problemen anzuhalten.

Viele Grüße,

Siracusa
Zum Seitenanfang    
 
Rome

Gepostet:
02.07.2007 09:56

   
Servus,

also hier der Code, ist n bissel mehr, da es meine Diplomarbeit ist, für evtl. Erklärungen des Codes hab ich mal ne Entwurfsversion der Arbeit auf meine HP gestellt: www.romeinf04.de

Der Typ SignedDigitBounded ist ne Liste von Digits, quasi Binärzahlen mit nem zusätzlichen Bit "-1". Damit können Zahlen aus dem Intervall [-1, 1] dargestellt werden.
In dem Modul stehen einfache arithmetische Funktionen zur Verfügung.
Der Typ SignedDigit ist nun ein Tupel, dessen zweite Komponente ein Integer ist, der die Anzahl der gültigen Vorkommastellen angibt, Shifts werden so ziemlich einfach und man erhält eine totale Erweiterung der Darstellung.

Der Algorithmus arbeitet mit nem Scheduling, was ich als Rechteckstream realisiert habe

module Schedule (
Rectangle
, Stream
, newInAr -- :: Integer -> Stream -> ([Rectangle],Stream)
, rectangleStream -- :: Stream
)
where

-- Typdefintion eines Rechtecks als Tupel von Koordinaten, wobei die Reihenfoilge /links oben/, /rechts oben/, /links unten/ und /rechts unten/ ist.
type Rectangle = ((Integer,Integer),(Integer,Integer))
-- Typdefinition eines vollständigen Streams von Rechtecken aller Typen als Tupel von unendlichen Listen
-- von Rechtecken des jeweiligen Typs (a,b und c)
type Stream = ([[Rectangle]],[Rectangle],[Rectangle])

-- /rectangleStream/ ist ein Rechteck-Stream der drei Typen von Rechtecken für das Scheduling des Algorithmus.
rectangleStream :: Stream
rectangleStream = (setAaStream,setAbStream,setAcStream)

-- /setAa/ berechnet eine Liste von Rechtecklisten des Rechtecktyps a) zur Stufe /k/. Eine einzelne Liste
-- entspricht Rechtecken gleicher Größe in der Stufe /k/. Das größte Rechteck der jeweiligen Stufe wird separat
-- berechnet und an das Ende der Liste hinzugefügt, dadurch werden Dubletten vermieden.
setAa :: Integer -> [[Rectangle]]
setAa 0 = [[]] -- /k=0/ als Spezialfall
-- Index /l/ hier nur bis /k-1/, da das größte Rechteckt separat berechnet wird
setAa k = [ rectList k l | l<-[1..k-1] ] ++ [[head(rect k k 0)]]
-- /rectList/ berechnet zu den beiden Parametern /k/ und /l/ die Liste gleichgroßer Rechtecke.
where rectList k l = [ r | m<-[0..(2^(k-l)-1)], r<-rect k l m ]
-- /rect/ berechnet zu den drei Parametern /k/, /l/ und /m/ ein Rechteck und sein korreliertes.
rect k l m = [(a,b),(b,a)] -- /a/ und /b/ sind die jeweiligen Eck-Koordinaten eines Rechtecks.
where a = ((2^k+m*2^l)+k,(2^k+(m+1)*2^l)-1+k)
b = (2^l+k,(2^(l+1)-1+k))

-- /setAaStream/ erzeugt einen Stream von Rechtecklisten.
setAaStream :: [[Rectangle]]
setAaStream = [ rectStream | k<-[1..], rectStream<-setAa k ] -- /k/ durchläuft die natürlichen Zahlen und ist Paramter für /setAa/

-- /setAb/ berechnet alle Rechtecke der Stufe /k/ vom Typ b).
setAb :: Integer -> [Rectangle]
setAb 0 = [((1,1),(1,1))] -- /k=0/ als Spezialfall
setAb k = [ r | n<-[0..(2^k-1)], r<-rectB k n] -- Liste aller Rechtecke der Hilfsfunktion /rectB/, aufgerufen mit den Parametern /k/ und /n/
where rectB k n = [((2^k+n+k,2^k+n+k),(1,1+k)),((1,1+k),(2^k+n+k,2^k+n+k))]
-- /rectB/ berechnet zur Stufe /k/ und Index /n/ die beiden zugehörigen Rechtecke.

-- /setAbStream/ erzeugt einen sortierten Stream von Rechtecken.
-- Hierbei wird zunächst das am weitesten oben links liegende Rechteck und sein korreliertes berechnet.
setAbStream :: [Rectangle]
setAbStream = [rect | k<-[0..], rect<-setAb k ] -- /k/ durchläuft die natürlichen Zahlen und ist Paramter für /setAb/

-- /setAc/ berechnet die beiden Rechtecke der Stufe /k/ vom Typ c).
setAc :: Integer -> [Rectangle]
setAc 0 = [((1,2),(2,2)), ((2,2),(1,1))] -- /k=0/ als Spezialfall
setAc k = [((i,i),(1,i-1)), ((1,i),(i,i))] -- sonst wird eine Liste mit zwei Rechtecken berechnet,
where i = 2^(k+1)+k -- wobei /i/ die obere Grenze ist.

-- /setAcStream/ erzeugt einen sortierten Stream von Rechtecken.
-- Hierbei wird zunächst das am weitesten oben links liegende Rechteck und sein korreliertes berechnet.
setAcStream :: [Rectangle]
setAcStream = [rect | k<-[0..], rect<-setAc k ] -- /k/ durchläuft die natürlichen Zahlen und ist Paramter für /setAc/

-- Menge der Rechtecke, die in der Stufe /r/ neu zur Menge /A_r/ hinzukommen,
-- zunächst werden aus allen Rechteck-Streams diejenigen Rechtecke mittels /tooSmall/ gefiltert, deren Koordinaten
-- zu klein für die Stufe /r/ sind, dann werden solange neue Rechtecke aus den Streams genommen, wie deren Koordinaten noch
-- unter die obere Schranke /r/ passen. Der Rückgabewert ist ein Tupel aus einer Liste der passenden Rechtecke und dem Eingabestream aus welchem
-- genau diese Rechtecke gefiltert wurden.
newInAr :: Integer -> Stream -> ([Rectangle],Stream)
newInAr r (streamA,streamB,streamC) = ([recs | recs<-recsA]++ -- Die entsprechenden Rechtecke vom Typ a) werden in der Funktion newInRTypeA berechnet.
[recs | recs<-recsB]++
[recs | recs<-recsC],(streamAfiltered, streamBfiltered, streamCfiltered))
-- fitsBC --> alle Koordinaten eines Rechtecks sind kleiner gleich /r/.
where fitsBC ((a1,a2),(b1,b2)) = (a1==r && a2==r) || (b1==r && b2==r)
-- Ermitteln der entsprechenden Rechtecke und anschliessendes Filtern dieser, damit die bereits "benutzten"
-- Rechtecke nicht erneut berechnet werden müssen
(recsA, streamAfiltered) = newInRTypeA r streamA -- Rechtecke vom Typ a) und deren gefilterter Stream werden separat durch /newInRTYpeA/ berechnet
(recsB, streamBfiltered) = span fitsBC streamB -- sonst wird pro Rechtecktyp ein Tupel berechnet, dessen erste Komponente
(recsC, streamCfiltered) = span fitsBC streamC -- die passenden Rechtecke sind und dessen zweite Komponente der gefilterte Stream des
-- jeweiligen Typs

-- /newInRTypeA/ berechnet zur Stufe /r/ die passenden Rechtecke vom Typ a).
-- Die Funktion bestimmt aus dem Stream von Rechtecklisten /mengeAaStream/ die entsprechenden Rechtecke.
newInRTypeA :: Integer -> [[Rectangle]] -> ([Rectangle],[[Rectangle]]) -- hierbei wird die Funktion /takeA/ auf jeden passenden Stream angewandt
newInRTypeA r streamA = (concat[recs | recs <-(map takeFromStream streamsFitting)], dropWhile null streamFiltered)
-- /takeFromStream/ bestimmt aus einem einzelnen Stream die passenden Rechtecke mittels der
-- beiden Hilfsfunktionen /rectFits/ und /tooSmall/
where takeFromStream rectList = takeWhile rectFits rectList
-- /streamsFitting/ liefert die passenden Streams der Stufe /r/
streamsFitting = findStreams streamA
-- /findStreams/ prüft in einer Liste von Rechteck-Streams,
-- welche Rechteck-Streams neue Rechtecke zur Stufe /r/ liefern könnten.
findStreams rectangleStreams = takeWhile streamFits rectangleStreams
-- /streamFits/ prüft, ob ein einzelner Rechteck-Stream neue Rechtecke zur Stufe /r/ liefern könnte.
-- Dies ist der Fall, wenn die größte Koordinate des ersten Rechtecks eines Streams kleiner gleich /r/ ist.
streamFits singleStream = snd(fst(head singleStream))<=r
-- /rectFits/ prüft, ob ein einzelnes Rechteck zur Stufe /r/ passt oder nicht.
-- Ein Rechteck passt zur Stufe /r/ gdw. seine größten Koordinaten kleiner gleich /r/ sind
rectFits (a,b) = (snd a)<=r && (snd b) <= r
streamFiltered = (map filterRectangleList streamsFitting)++(dropWhile streamFits streamA)
filterRectangleList rectList = dropWhile rectFits rectList

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------


Der eigentliche Algortihmus ist im folgenden Modul aufgehangen, er benötigt weiter noch eine "normale" Mulitplikatiosnsubroutine, die ich in 3 Extra-Module gepackt habe.

module Algorithm (
module SignedDigit
, buffInit -- :: Array Int Digit -> Array Int Digit -> Stream -> (SD,Stream)
, buffn -- :: Array Int Digit -> Array Int Digit -> Digit -> SD -> Int -> Stream -> (SD, Stream)
, next -- :: SD -> Digit
, mult -- :: SDBounded -> SDBounded -> SDBounded
, p
)
where

import Schedule
import SignedDigit
import qualified Naive
import qualified Karatsuba
import qualified SchoenhageStrassen
import Array
import Data.List hiding (genericReplicate)

-- Überschreiben der vordefinierten Version von /genericReplicate/, da bei der vordefinierten Version ein Bug aufgetreten ist.
genericReplicate :: Integer -> a -> [a]
genericReplicate n x
| n <= 0 = []
| otherwise = genericTake n (repeat x)
{-
-- /resultOfMult/ berechnet das Ergebnis der Multiplikation der Ausschnitte der beiden Zahlen /p/ und /q/, die aufgrund des Rechtecks /(r1,r2)/ miteinander multipliziert
-- werden müssen. Für /p/ gelten die Indizes von /r1/ , für /q/ die von /r2/.
-- Das Ergebnis ist ein Tupel, dessen Komponenten die entsprechenden Ausschnitte von /p/ und /q/ sind.
-- Sollten die Zahlen /p/ und /q/ von endlicher Genauigkeit sein, so werden entsprechend Nullen angefügt.
resultOfMult :: Rectangle -> Array Integer Digit -> Array Integer Digit -> Int -> SDBounded
resultOfMult (r1,r2) p q method =
case method of
1 -> Naive.mult partOfP partOfQ
2 -> Karatsuba.mult partOfP partOfQ
3 -> SchoenhageStrassen.mult partOfP partOfQ
where partOfP = ([p!(i) | i<-[(fst r1)..maxIndexP] ] ++ (genericReplicate diffZeroesP Z))
partOfQ = ([q!(i) | i<-[(fst r2)..maxIndexQ] ] ++ (genericReplicate diffZeroesQ Z))
maxIndexP = min upperBoundP (snd r1) -- der maximale Index, der benutzt werden kann, ist das Minimum
maxIndexQ = min upperBoundQ (snd r2) -- von /upperBound/ und der letzten Komponente des Rechtecks
diffZeroesP = (snd r1) - upperBoundP -- Anzahl evtl fehlender impliziter Nullen bei /p/
diffZeroesQ = (snd r2) - upperBoundQ -- Anzahl evtl fehlender impliziter Nullen bei /q/
upperBoundP = snd(bounds p) -- obere Grenze des Parameters /p/
upperBoundQ = snd(bounds q) -- obere Grenze des Parameters /q/
-- werden diese Grenzen nicht eingehalten,
-- tritt eine /Index out of Bounds/-Exception auf

-- /newr/ ist die Summe der Ergebnisse der "Multiplikationen" der Rechtecke der Stufe /r/
newr :: Integer -> SDBounded -> SDBounded -> Stream -> Int -> (SD,Stream)
newr r psd qsd stream method = ( (result,i), streamFiltered)
where p = listArray (1, genericLength psd) psd
q = listArray (1, genericLength qsd) qsd
(result,i) = sumUp[shift((mu rect) + genericLength(resultOfMult rect p q method)) (resultOfMult rect p q method, 0) | rect <- rectangles]
-- das Ergebnis der Multiplikation wird mittels /mu/ geshiftet bis es mit der letzten Stelle an der richtigen Stelle steht
(rectangles, streamFiltered) = newInAr r stream -- Berechnung der in Stufe /r/ neu hinzugekommenen Rechtecke

-}
resultOfMult :: Rectangle -> SDBounded -> SDBounded -> Int -> SDBounded
resultOfMult (r1,r2) p q method =
case method of
1 -> Naive.mult partOfP partOfQ
2 -> Karatsuba.mult partOfP partOfQ
3 -> SchoenhageStrassen.mult partOfP partOfQ
where partOfP = ([genericIndex p (i-1) | i<-[(fst r1)..maxIndexP] ] ++ (genericReplicate diffZeroesP Z))
partOfQ = ([genericIndex q (i-1) | i<-[(fst r2)..maxIndexQ] ] ++ (genericReplicate diffZeroesQ Z))
maxIndexP = min (upperBoundP) (snd r1) -- der maximale Index, der benutzt werden kann, ist das Minimum
maxIndexQ = min (upperBoundQ) (snd r2) -- von /upperBound/ und der letzten Komponente des Rechtecks
diffZeroesP = (snd r1) - upperBoundP -- Anzahl evtl fehlender impliziter Nullen bei /p/
diffZeroesQ = (snd r2) - upperBoundQ -- Anzahl evtl fehlender impliziter Nullen bei /q/
upperBoundP = (genericLength p) -- obere Grenze des Parameters /p/
upperBoundQ = (genericLength q) -- obere Grenze des Parameters /q/
-- werden diese Grenzen nicht eingehalten,
-- tritt eine /Index out of Bounds/-Exception auf

-- /newr/ ist die Summe der Ergebnisse der "Multiplikationen" der Rechtecke der Stufe /r/
newr :: Integer -> SDBounded -> SDBounded -> Stream -> Int -> (SD,Stream)
newr r p q stream method = ( (result,i), streamFiltered)
where -- p = listArray (1, genericLength psd) psd
-- q = listArray (1, genericLength qsd) qsd
(result,i) = sumUp[shift((mu rect) + genericLength(resultOfMult rect p q method)) (resultOfMult rect p q method, 0) | rect <- rectangles]
-- das Ergebnis der Multiplikation wird mittels /mu/ geshiftet bis es mit der letzten Stelle an der richtigen Stelle steht
(rectangles, streamFiltered) = newInAr r stream -- Berechnung der in Stufe /r/ neu hinzugekommenen Rechtecke




-- /mu/ wird benötigt, um das Ergebnis der Multiplikations-Subroutine an die richtige Stelle zu shiften.
mu :: Rectangle -> Integer
mu rect = -( snd(fst rect) + snd(snd rect) ) -- die Shifts entsprechen der negativen Summe der größten Indizes des Rechtecks

-- /buffInit/ ist der Initialisierungsfall des Algorithmus, !ausnahmsweise! wird dieser Pufferinhalt über die Funktion /alphar/ berechnet
buffInit :: SDBounded -> SDBounded -> Stream -> (SD,Stream)
buffInit p q stream = (bufferInitialized, streamFiltered)
where (bufferInitialized, streamFiltered) = alphar 3 p q stream

-- /buffn/ stellt den Pufferinhalt dar, dieser wird in Abhängigkeit von den Eingabe SD-Darstellungen und dem bisherigen Ergebnis berechnet
-- Die Ergebnisse der "Multiplikationen" der Rechtecke werden auf den vorherigen Pufferinhalt mit entsprechenden Shifts aufaddiert
buffn :: SDBounded -> SDBounded -> Digit -> SD -> Integer -> Stream -> Int -> (SD, Stream)
buffn p q lastDig bufferOld n stream method = ( ((shift n newValue) `sub` (shift 1 ([lastDig],1))) `add` (shift 1 bufferOld), streamFiltered)
where r = n+3 -- /r/ ist die zu betrachtende "Stufe" der Digits --> Lookahead des Algorithmus
(newValue, streamFiltered) = newr r p q stream method -- Aufruf von /newr/ mit den entsprechenden Parametern, das Ergebnis
-- wird dann geshiftet und auf den vorherigen Pufferinhalt aufaddiert.

-- /next/ bestimmt das nächste Ausgabe-Digit in Abhängigkeit von den ersten drei Digits des Eingabe-Puffers /buf/.
next :: SD -> Digit
next (buf,i)
| bn >= (-3) && bn <= (-3/8) = N -- unterer Wertebereich, es wird eine /-1/ zurückgegeben.
| bn <= (5/8) && bn >= (-5/8) = Z -- mittlerer Wertebereich, es wird eine /0/ zurückgegeben.
| bn >= (3/8) && bn <= 3 = O -- oberer Wertebereich, es wird eine /1/ zurückgegeben.
| otherwise = error "Buffer out of bounds, maximum value of the buffer is 3" -- sonst wurde der zulässige Bereich überschritten
where bn = sdValue(take 3 buf,i) -- Es genügt die ersten drei Digits des Puffers zu lesen
-- und damit das nächste Ausgabe-Digit zu bestimmen, die vollständige Wertbestimmung von /buf/
-- würde die Komplexität zerstören.

-- rekursive Definition der alpha_r, diese Funktion wird !nur für die Initialisierung! des Algorithmus benötigt,
-- sie darf nicht für den Algorithmus selbst benutzt werden, da sie sonst die geforderte Komplexität zerstört.
-- Die Funktion erhält als EingabeParameter die aktuelle Stufe /r/, die beiden Zahlen /p/ und /q/, sowie einen Rechteck-Stream /stream/.
alphar :: Integer -> SDBounded -> SDBounded -> Stream -> (SD, Stream)
alphar 0 _ _ _ = error "only defined for values >= 1"
alphar 1 p q stream = newr 1 p q stream 1 -- Basisfall für /r=1/, die Funktion /newr/ wird mit den Eingabeparametern aufgerufen.
alphar r p q stream = (add newValues recursiveValues , streamFiltered) -- Rückgabewerte sind die Summe der neuen Werte in
-- Stufe /r/ und der vorherigen Stufen, sowie der entsprechend gefilterte Rechteckstream
where (newValues, streamFiltered) = (newr r p q streamFilteredRecursive 1) -- Berechnung der neuen Werte mittels des gefilterten Streams
(recursiveValues, streamFilteredRecursive) = (alphar (r-1) p q stream) -- rekursiver Aufruf zur Bestimmung des vorherigen Wertes und des
-- gefilterten Streams

-- /mult/ multipliziert zwei Zahlen in der /SDBounded/-Darstellung miteinander, die Funktion arbeitet nach dem vorgestellten
-- Online-Algorithmus und stützt sich dabei auf die Hilfsfunktion /multHlp/. In dieser Funktion wird der Puffer und der
-- Rechteck-Stream initialisiert und an die o.g. Hilfsfunktion übergeben.
mult :: SDBounded -> SDBounded -> SDBounded
mult [] _ = []
mult _ [] = []
mult p q = multHlp p q streamInitFiltered Z buffInitialized 1
where (buffInitialized, streamInitFiltered) = buffInit p q rectangleStream

-- /multHlp/ ist die Hilfsfunktion für die Multiplikation zweier Zahlen in der SD-Darstellung
multHlp :: SDBounded -> SDBounded -> Stream -> Digit -> SD -> Integer -> SDBounded
multHlp p q stream lastDig buffOld n
= newDig:(multHlp p q streamFiltered newDig buffer (n+1))
where (buffer, streamFiltered) = buffn p q lastDig buffOld n stream 3
newDig = next buffer


Die Main dient nur der Visualisierung, eigentlich soll man später mal über die Funktion "mult" im vorherigen Modul damit arbeiten können, aber so gings einfacher fand ich. Die Funktion "step" ruft sich rekursiv immer wieder mit aktualisierten Parametern auf:


module Main where

import Algorithm
import Schedule
import qualified Random
import Array
import System.IO
import Data.IORef

-- Die Hauptprozedur des Programms
main :: IO()
main = do putStrLn "Online Multiplication of Numbers in Signed-Digit-Representation\n"
method <- getMethod
mode <- modeSelect -- Aufruf von /modeSelect/ bestimmt den Betriebsmodus des Programms, interaktiv oder Demonstration
let stream = rectangleStream
(pArray, qArray, buf, streamInitFiltered)<-initialize mode stream -- Aufruf von /initialize/ mit den Parametern /mode/
-- und /stream/ initialisiert den Algorithmus, bzw den Puffer.
-- Aufruf des Algorithmus erfolgt durch den Aufruf von /step/ mit den entsprechenden Parametern
catch (step pArray qArray buf Z 1 mode streamInitFiltered method) -- das erste zu benutzende Digit ist /Z/
(\err -> do terminate)

return() -- Terminierung des Programms

-- /modeSelect/ lässt den Benutzer den Betriebsmodus des Programms wählen,
-- /1/ für eine Demonstration, /2/ für die interaktive Abfrage der einzelnen Digits.
modeSelect :: IO Int
modeSelect = catch (do putStrLn "please press\n"
putStrLn "1 ---> Demo-Mode"
putStrLn "2 ---> Interactive-Mode"
modeEntered <- readLn
mode <- getMode modeEntered
return mode)
(\err -> do putStrLn "Please enter only 1 or 2\n"
modeSelect)
where getMode 1 = do putStrLn "Demo-Mode selected" -- Auswahl des Modus anhand des eingelesenen Parameters
return 1 -- Rückgabewert des Demonstrations-Modus
getMode 2 = do putStrLn "Interactive-Mode selected"
return 2 -- Rückgabewert des interaktiven Modus
getMode _ = ioError (userError "Error, only mode 1 or mode 2 allowed")

-- /getMethod/ lässt den Benutzer die Multiplikations-Subroutine zu wählen
getMethod :: IO Int
getMethod = catch (do putStrLn "please press\n"
putStrLn "1 ---> Naive-Multiplication"
putStrLn "2 ---> Karatsuba-Multiplication"
putStrLn "3 ---> Schoenhage-Strassen-Multiplication"
methodEntered <- readLn
method <- getMethodHlp methodEntered
return method)
(\err -> do putStrLn "Please enter only 1, 2 or 3\n"
getMethod)
where getMethodHlp 1 = do putStrLn "Naive-Multiplication selected" -- Auswahl des Modus anhand des eingelesenen Parameters
return 1 --
getMethodHlp 2 = do putStrLn "Karatsuba-Multiplication selected"
return 2 --
getMethodHlp 3 = do putStrLn "Schoenhage-Strassen-Multiplication selected"
return 3 --
getMethodHlp _ = ioError (userError "Error, only mode 1, mode 2 or mode 3 allowed")

-- /initialize/ liest die ersten drei Digits der beiden Zahlen für die Initialisierung des Algorithmus ein (interaktiver Modus),
-- oder bestimmt die ersten drei zufällig für den Demonstrations-Modus.
initialize :: Int -> Stream -> IO(SDBounded, SDBounded, SD, Stream)
initialize mode stream
= do if mode==2 then do putStr "Enter the first three Digits of the first Number one per Line:\n"
dig11 <- getSingleInteractiveDigit -- einlesen der ersten drei Digits der ersten Zahl
dig12 <- getSingleInteractiveDigit
dig13 <- getSingleInteractiveDigit
putStr "Enter the first three Digits of the second Number one per Line:\n"
dig21 <- getSingleInteractiveDigit -- einlesen der ersten drei Digits der zweiten Zahl
dig22 <- getSingleInteractiveDigit
dig23 <- getSingleInteractiveDigit
putStr "Now enter the following Digits\n"
let p = [dig11,dig12,dig13]
let q = [dig21,dig22,dig23]
let (buffer, streamFiltered) = buffInit p q stream -- Initialisierung des Puffers mit den eingelesenen Werten
return(p, q, buffer, streamFiltered) -- Rückgabe der eingelesenen und berechenten Werte
else do (dig11,dig21)<-createDemoDigits -- erstellen von drei zufälligen Digit-Paaren
(dig12,dig22)<-createDemoDigits
(dig13,dig23)<-createDemoDigits
let p = [dig11,dig12,dig13] -- die ersten Komponenten werden in einer Liste gespeichert
let q = [dig21,dig22,dig23] -- die zweiten Komponenten werden in einer Liste gespeichert
let (buffer, streamFiltered) = buffInit p q stream -- Initialisierung des Puffers mit den erstellten Werten
-- Ausgabe der erstellten Digits
putStr((show dig11)++" " ++(show dig21)++"\n"++(show dig12)++" " ++(show dig22)++"\n"++(show dig13)++" " ++(show dig23)++"\n")
return(p, q, buffer, streamFiltered)-- Rückgabe der erstellten und berechneten Werte


-- /step/ stellt einen einzelnen Schritt des Algorithmus dar, diese Prozedur ruft sich selbst immer wieder mit aktualisierten Parametern auf
step :: SDBounded -> SDBounded -> SD -> Digit -> Integer -> Int -> Stream -> Int -> IO()
step p q bufferOld lastDig n mode stream method
= do (d1,d2)<-getDigits mode -- einlesen der Digits
let nextP = p++[d1] -- neues Digit /d1/ hinten an die Liste /p/ anfügen
let nextQ = q++[d2] -- neues Digit /d2/ hinten an die Liste /q/ anfügen
let (buffer, streamFiltered) = buffn nextP nextQ lastDig bufferOld n stream method -- Aufruf der Funktion /buffn/ mit den entsprechenden Paramtern
let nextDig = next buffer -- Ermitteln des nächsten Ausgabe-Digits
if mode == 1 then do putStr((show r)++" : "++(show d1)++" "++(show d2)++" ---"++(show n)++ "--> " ++(show nextDig)++"\n") -- Ausgeben des nächsten Digits
else do putStr(" ---"++(show n)++"--> " ++(show nextDig)++"\n") -- Die Formatierung der Ausgabe hängt vom Modus ab
step nextP nextQ buffer nextDig (n+1) mode streamFiltered method -- Erneuter Aufruf von /step/ mit aktualisierten Parametern
where r = n+3

-- /getDigits/ bestimmt in Abhängigkeit des Modus die nächsten Digits der Eingabeparameter /p/ und /q/.
getDigits :: Int -> IO(Digit,Digit)
getDigits 1 = do (d1,d2)<-createDemoDigits -- im Demo-Modus werden die nächsten beiden Digits zufällig gewählt
return (d1,d2)
getDigits 2 = do (d1,d2)<-getInteractiveDigits -- im Interaktv-Modus werden die nächsten beiden Digits eingelesen
return (d1,d2)

-- /createDemoDigits/ erzeugt zwei zufällige Digits, die Funktion stützt sich auf die Funktion /getRandom/ , welche eine
-- Zufallszahl aus der Menge {-1,0,1} ermittelt.
createDemoDigits :: IO(Digit, Digit)
createDemoDigits = do d1<-getRandom -- zwei Zufallszahlen werden erstellt
d2<-getRandom
digit1 <- makeDigit d1
digit2 <- makeDigit d2
return(digit1, digit2) -- die Zufallszahlen werden in Digits konvertiert und zurückgegeben

-- /getRandom/ ermittelt eine Zufallszahl aus der Menge {-1,0,1}.
getRandom :: IO Int
getRandom = Random.getStdRandom (Random.randomR (-1,1))

-- /getInteractiveDigits/ liest zwei Digits von der Kommandozeile ein
getInteractiveDigits :: IO(Digit,Digit)
getInteractiveDigits = do digit1 <- getSingleInteractiveDigit -- Aufruf der Hilfsfunktion /getSingleInteractiveDigit/, um ein einzelnes
digit2 <- getSingleInteractiveDigit -- Digit einzulesen
return (digit1,digit2) -- Rückgabe als Tupel zweier Digits

-- /getSingleInteractiveDigit/ liest ein einzelnes Digit von der Kommandozeile ein, hierbei kann ebenfalls /./ und /end/ gelesen
-- werden.
getSingleInteractiveDigit :: IO Digit
getSingleInteractiveDigit
= do digitStr <- getLine
case digitStr of
"." -> ioError (userError " /./ has been entered")
"end" -> ioError (userError " user wants to shut down program ")
_ -> do catch (do digitInt <- readIO digitStr
dig <- catch (makeDigit digitInt)
(\err -> do putStrLn (show err)
getSingleInteractiveDigit)
return dig)
(\err -> do putStrLn "Error, please enter only Int-Values"
getSingleInteractiveDigit)

-- /makeDigit/ wandelt einen Int-Wert in ein Digit um, hierbei kann eine Exception auftreten, falls der Wert nicht aus der Menge {-1,0,1} ist.
makeDigit :: Int -> IO Digit
makeDigit 1 = return O
makeDigit 0 = return Z
makeDigit (-1) = return N
makeDigit _ = ioError (userError " only 1, -1 or 0 allowed")

terminate :: IO()
terminate = do putStrLn " terminating program "
return()

-----------------------------------------------------------------------------------------------------------------------------------------------




Gruß,
Rome(der sich über die schnelle Antwort auf jeden Fall schonmal freut)
Zum Seitenanfang    
 
Rome

Gepostet:
02.07.2007 14:00

   
Das ist beim Profiling rausgekommen....

	Mon Jul 02 13:57 2007 Time and Allocation Profiling Report  (Final)

Main +RTS -p -RTS

total time = 10843.80 secs (216876 ticks @ 50 ms)
total alloc = 1445,469,318,024 bytes (excludes profiling overheads)

COST CENTRE MODULE %time %alloc

resultOfMult Algorithm 65.8 62.8
addHlp SignedDigitBounded 12.2 12.6
shift SignedDigit 9.1 8.4
shiftright SignedDigit 3.6 6.2
addSDBounded SignedDigitBounded 2.1 2.0
fixPrefix SignedDigit 1.8 2.0
step Main 1.2 2.1
digValue Digit 1.2 0.2
pad SignedDigit 0.8 1.2
naiveMult Karatsuba 0.6 1.0


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 200 1 0.0 0.0 100.0 100.0
step Main 211 131111 1.2 2.1 100.0 100.0
next Algorithm 309 32777 0.0 0.0 0.0 0.0
sdValue SignedDigit 310 32777 0.0 0.0 0.0 0.0
valueSDBounded SignedDigitBounded 312 32777 0.0 0.0 0.0 0.0
valuehlp SignedDigitBounded 313 92738 0.0 0.0 0.0 0.0
isZeroSDBounded SignedDigitBounded 314 92738 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 315 90977 0.0 0.0 0.0 0.0
sdValuehlp SignedDigit 311 51992 0.0 0.0 0.0 0.0
add SignedDigit 293 32777 0.0 0.0 2.6 2.9
addSDBounded SignedDigitBounded 299 32946 0.2 0.1 2.6 2.9
addHlp SignedDigitBounded 306 522060013 2.2 2.6 2.4 2.8
digValue Digit 308 522893680 0.2 0.1 0.2 0.1
addInit SignedDigitBounded 300 31881 0.0 0.0 0.0 0.0
digValue Digit 307 63688 0.0 0.0 0.0 0.0
fullAdd Digit 303 45819 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 305 84544 0.0 0.0 0.0 0.0
addDigit Digit 304 200613 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 302 84162 0.0 0.0 0.0 0.0
addDigit Digit 301 31881 0.0 0.0 0.0 0.0
pad SignedDigit 296 49992 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 297 63762 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 298 217560 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 294 84602 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 295 111980 0.0 0.0 0.0 0.0
sub SignedDigit 258 32777 0.0 0.0 0.0 0.0
add SignedDigit 333 16847 0.0 0.0 0.0 0.0
addSDBounded SignedDigitBounded 340 33694 0.0 0.0 0.0 0.0
addHlp SignedDigitBounded 349 1031935 0.0 0.0 0.0 0.0
digValue Digit 351 1015088 0.0 0.0 0.0 0.0
addInit SignedDigitBounded 343 16847 0.0 0.0 0.0 0.0
digValue Digit 350 33694 0.0 0.0 0.0 0.0
fullAdd Digit 346 23108 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 348 50541 0.0 0.0 0.0 0.0
addDigit Digit 347 117929 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 345 33694 0.0 0.0 0.0 0.0
addDigit Digit 344 16847 0.0 0.0 0.0 0.0
pad SignedDigit 336 33694 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 337 33694 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 338 101082 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 334 33694 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 335 134776 0.0 0.0 0.0 0.0
negSDBounded SignedDigitBounded 332 17912 0.0 0.0 0.0 0.0
negDigit Digit 339 17912 0.0 0.0 0.0 0.0
shift SignedDigit 219 505466669 2.3 2.4 3.8 3.9
fixPrefix SignedDigit 256 505420089 1.4 1.5 1.5 1.5
con2tag_Digit# Digit 257 505582968 0.1 0.0 0.1 0.0
buffn Algorithm 217 32778 0.0 0.0 92.3 91.1
newr Algorithm 218 65556 0.0 0.0 92.3 91.1
mu Algorithm 248 105041 0.0 0.0 0.0 0.0
shift SignedDigit 237 1726842008 6.6 5.7 10.2 11.9
fixPrefix SignedDigit 250 105041 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 251 105041 0.0 0.0 0.0 0.0
shiftright SignedDigit 249 1726710968 3.6 6.2 3.6 6.2
resultOfMult Algorithm 232 459207 65.8 62.8 73.1 71.0
genericReplicate Algorithm 236 446166 0.0 0.0 0.0 0.0
mult SchoenhageStrassen 233 612294 0.0 0.0 7.3 8.2
mult Karatsuba 243 586296 0.0 0.0 7.3 8.2
karatsuba Karatsuba 355 3157899 0.2 0.2 7.2 8.2
pad SignedDigit 422 1158389 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 423 1360560 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 424 1359308 0.0 0.0 0.0 0.0
sub SignedDigit 403 1360560 0.0 0.0 0.5 0.4
add SignedDigit 405 1360560 0.0 0.0 0.4 0.3
addSDBounded SignedDigitBounded 412 1360680 0.0 0.0 0.3 0.3
addHlp SignedDigitBounded 419 23889424 0.2 0.2 0.3 0.2
digValue Digit 421 44325614 0.0 0.0 0.0 0.0
addInit SignedDigitBounded 413 1360546 0.0 0.0 0.0 0.0
digValue Digit 420 2462024 0.0 0.0 0.0 0.0
fullAdd Digit 416 1846933 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 418 3663831 0.0 0.0 0.0 0.0
addDigit Digit 417 8190532 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 415 3322017 0.0 0.0 0.0 0.0
addDigit Digit 414 1360546 0.0 0.0 0.0 0.0
pad SignedDigit 408 2439635 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 409 6052518 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 410 6090676 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 406 3011044 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 407 3021210 0.0 0.0 0.0 0.0
negSDBounded SignedDigitBounded 404 1360560 0.0 0.1 0.0 0.1
negDigit Digit 411 25261794 0.0 0.0 0.0 0.0
add SignedDigit 390 2721120 0.0 0.0 1.5 1.8
addSDBounded SignedDigitBounded 396 2711487 0.2 0.1 1.3 1.4
addHlp SignedDigitBounded 425 152115126 1.0 1.2 1.1 1.2
digValue Digit 427 245863982 0.1 0.0 0.1 0.0
addInit SignedDigitBounded 397 2711387 0.0 0.0 0.1 0.1
digValue Digit 426 5350156 0.0 0.0 0.0 0.0
fullAdd Digit 400 3841879 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 402 7667634 0.0 0.0 0.0 0.0
addDigit Digit 401 17712268 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 399 7093140 0.0 0.0 0.0 0.0
addDigit Digit 398 2711387 0.0 0.0 0.0 0.0
pad SignedDigit 393 5171535 0.1 0.3 0.2 0.3
fixPrefix SignedDigit 394 5426925 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 395 5427219 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 391 6112011 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 392 6112148 0.0 0.0 0.0 0.0
shift SignedDigit 387 39496818 0.1 0.2 0.1 0.2
fixPrefix SignedDigit 388 1361420 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 389 1361420 0.0 0.0 0.0 0.0
naiveMult Karatsuba 356 14755928 0.6 1.0 5.0 5.6
add SignedDigit 364 13272639 0.1 0.1 3.8 3.9
addSDBounded SignedDigitBounded 374 11794838 0.4 0.3 2.8 2.5
addHlp SignedDigitBounded 381 232373883 1.8 1.9 2.0 1.9
digValue Digit 384 420439062 0.2 0.0 0.2 0.0
addInit SignedDigitBounded 375 11794838 0.2 0.2 0.4 0.3
digValue Digit 382 23229028 0.0 0.0 0.0 0.0
fullAdd Digit 378 17336415 0.1 0.1 0.2 0.2
con2tag_Digit# Digit 380 34668845 0.0 0.0 0.0 0.0
addDigit Digit 379 80072511 0.1 0.1 0.1 0.1
con2tag_Digit# Digit 377 31620597 0.0 0.0 0.0 0.0
addDigit Digit 376 11794838 0.0 0.0 0.0 0.0
pad SignedDigit 370 23540025 0.6 0.9 0.8 1.2
fixPrefix SignedDigit 371 87789648 0.2 0.3 0.2 0.3
con2tag_Digit# Digit 372 83649895 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 368 24289368 0.1 0.1 0.1 0.1
con2tag_Digit# Digit 369 24301942 0.0 0.0 0.0 0.0
scalMult SignedDigitBounded 362 13272639 0.1 0.0 0.4 0.5
negSDBounded SignedDigitBounded 385 4541148 0.1 0.2 0.2 0.2
negDigit Digit 386 69664513 0.1 0.0 0.1 0.0
genericReplicate SignedDigitBounded 365 4257175 0.2 0.3 0.2 0.3
con2tag_Digit# Digit 363 26261305 0.0 0.0 0.0 0.0
shift SignedDigit 359 26545290 0.1 0.1 0.1 0.1
fixPrefix SignedDigit 360 14707389 0.0 0.1 0.0 0.1
con2tag_Digit# Digit 361 14829161 0.0 0.0 0.0 0.0
isZeroSDBounded SignedDigitBounded 357 29509003 0.0 0.0 0.1 0.0
con2tag_Digit# Digit 358 40986074 0.0 0.0 0.0 0.0
pad SignedDigit 352 180508 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 353 311390 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 354 862630 0.0 0.0 0.0 0.0
scalMult SignedDigitBounded 246 87366 0.0 0.0 0.0 0.0
negSDBounded SignedDigitBounded 316 43618 0.0 0.0 0.0 0.0
negDigit Digit 342 338180 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 247 131114 0.0 0.0 0.0 0.0
isZeroSDBounded SignedDigitBounded 244 420168 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 245 486122 0.0 0.0 0.0 0.0
isZeroSDBounded SignedDigitBounded 234 459207 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 235 529774 0.0 0.0 0.0 0.0
sumUp SignedDigit 231 32778 0.0 0.0 9.0 8.1
fixPrefix SignedDigit 254 32777 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 255 30816 0.0 0.0 0.0 0.0
add SignedDigit 239 131039 0.0 0.0 9.0 8.1
addSDBounded SignedDigitBounded 322 74224 1.3 1.4 9.0 8.1
addHlp SignedDigitBounded 329 1224204892 6.9 6.8 7.7 6.8
digValue Digit 331 2446439858 0.8 0.0 0.8 0.0
addInit SignedDigitBounded 323 74224 0.0 0.0 0.0 0.0
digValue Digit 330 148448 0.0 0.0 0.0 0.0
fullAdd Digit 326 74224 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 328 148448 0.0 0.0 0.0 0.0
addDigit Digit 327 371120 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 325 148448 0.0 0.0 0.0 0.0
addDigit Digit 324 74224 0.0 0.0 0.0 0.0
pad SignedDigit 319 74224 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 320 148448 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 321 148448 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 317 148448 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 318 148448 0.0 0.0 0.0 0.0
newInAr Schedule 225 360548 0.0 0.0 0.0 0.0
newInRTypeA Schedule 226 360036 0.0 0.0 0.0 0.0
getDigits Main 212 32778 0.0 0.0 0.0 0.0
createDemoDigits Main 213 32778 0.0 0.0 0.0 0.0
makeDigit Main 215 65556 0.0 0.0 0.0 0.0
getRandom Main 214 65556 0.0 0.0 0.0 0.0
initialize Main 206 1 0.0 0.0 0.0 0.0
buffInit Algorithm 220 2 0.0 0.0 0.0 0.0
alphar Algorithm 221 3 0.0 0.0 0.0 0.0
add SignedDigit 259 2 0.0 0.0 0.0 0.0
addSDBounded SignedDigitBounded 281 2 0.0 0.0 0.0 0.0
addHlp SignedDigitBounded 288 11 0.0 0.0 0.0 0.0
digValue Digit 290 10 0.0 0.0 0.0 0.0
addInit SignedDigitBounded 282 2 0.0 0.0 0.0 0.0
digValue Digit 289 4 0.0 0.0 0.0 0.0
fullAdd Digit 285 2 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 287 4 0.0 0.0 0.0 0.0
addDigit Digit 286 10 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 284 6 0.0 0.0 0.0 0.0
addDigit Digit 283 2 0.0 0.0 0.0 0.0
pad SignedDigit 278 2 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 279 4 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 280 4 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 276 4 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 277 4 0.0 0.0 0.0 0.0
newr Algorithm 222 6 0.0 0.0 0.0 0.0
mu Algorithm 269 3 0.0 0.0 0.0 0.0
shift SignedDigit 268 11 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 271 3 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 272 3 0.0 0.0 0.0 0.0
shiftright SignedDigit 270 6 0.0 0.0 0.0 0.0
resultOfMult Algorithm 261 14 0.0 0.0 0.0 0.0
genericReplicate Algorithm 265 14 0.0 0.0 0.0 0.0
mult Naive 262 8 0.0 0.0 0.0 0.0
scalMult SignedDigitBounded 266 6 0.0 0.0 0.0 0.0
negSDBounded SignedDigitBounded 291 2 0.0 0.0 0.0 0.0
negDigit Digit 292 2 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 267 10 0.0 0.0 0.0 0.0
isZeroSDBounded SignedDigitBounded 263 14 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 264 14 0.0 0.0 0.0 0.0
sumUp SignedDigit 260 3 0.0 0.0 0.0 0.0
fixPrefix SignedDigit 274 3 0.0 0.0 0.0 0.0
con2tag_Digit# Digit 275 3 0.0 0.0 0.0 0.0
add SignedDigit 273 5 0.0 0.0 0.0 0.0
newInAr Schedule 224 31 0.0 0.0 0.0 0.0
newInRTypeA Schedule 227 9 0.0 0.0 0.0 0.0
createDemoDigits Main 207 3 0.0 0.0 0.0 0.0
makeDigit Main 209 6 0.0 0.0 0.0 0.0
getRandom Main 208 6 0.0 0.0 0.0 0.0
modeSelect Main 204 4 0.0 0.0 0.0 0.0
getMethod Main 202 6 0.0 0.0 0.0 0.0
CAF Main 194 25 0.0 0.0 0.0 0.0
step Main 216 0 0.0 0.0 0.0 0.0
initialize Main 210 0 0.0 0.0 0.0 0.0
modeSelect Main 205 2 0.0 0.0 0.0 0.0
getMethod Main 203 4 0.0 0.0 0.0 0.0
main Main 201 0 0.0 0.0 0.0 0.0
CAF Text.Read.Lex 171 8 0.0 0.0 0.0 0.0
CAF GHC.Real 168 1 0.0 0.0 0.0 0.0
CAF GHC.Read 165 2 0.0 0.0 0.0 0.0
CAF GHC.Float 164 9 0.0 0.0 0.0 0.0
CAF GHC.Handle 129 4 0.0 0.0 0.0 0.0
CAF Algorithm 120 1 0.0 0.0 0.0 0.0
CAF SignedDigit 118 6 0.0 0.0 0.0 0.0
pad SignedDigit 341 0 0.0 0.0 0.0 0.0
empty SignedDigit 238 1 0.0 0.0 0.0 0.0
CAF SignedDigitBounded 117 3 0.0 0.0 0.0 0.0
scalMult SignedDigitBounded 366 0 0.0 0.0 0.0 0.0
genericReplicate SignedDigitBounded 367 0 0.0 0.0 0.0 0.0
CAF Digit 116 3 0.0 0.0 0.0 0.0
CAF Karatsuba 115 5 0.0 0.0 0.0 0.0
mult Karatsuba 383 0 0.0 0.0 0.0 0.0
naiveMult Karatsuba 373 0 0.0 0.0 0.0 0.0
CAF Schedule 107 14 0.0 0.0 0.0 0.0
setAcStream Schedule 252 1 0.0 0.0 0.0 0.0
setAc Schedule 253 15 0.0 0.0 0.0 0.0
setAb Schedule 242 2 0.0 0.0 0.0 0.0
setAbStream Schedule 240 1 0.0 0.0 0.0 0.0
setAb Schedule 241 262165 0.0 0.0 0.0 0.0
setAa Schedule 230 5 0.0 0.0 0.0 0.0
setAaStream Schedule 228 1 0.0 0.0 0.0 0.0
setAa Schedule 229 786199 0.0 0.0 0.0 0.0
rectangleStream Schedule 223 1 0.0 0.0 0.0 0.0
CAF System.Random 105 1 0.0 0.0 0.0 0.0
CAF System.CPUTime 102 1 0.0 0.0 0.0 0.0


Gruß,
Rome
Zum Seitenanfang    
 
Siracusa

Gepostet:
02.07.2007 14:37

   
Hab dein Programm mal laufen lassen. Das Resultat war wie von dir beschrieben. Ein Blick in die Prozessliste brachte dann etwas Erleuchtung: Das Programm hatte eine Speicherauslastung von über 600MB. Smilie

Auf den ersten Blick in das Profiling-Protokoll liegt der Speicherverbraucht bei der Funktion Algorithm.resultOfMult. Aber ich werd mir den Code heute abend mal etwas genauer zu Gemüte führen.

Viele Grüße,

Siracusa
Zum Seitenanfang    
 
Siracusa

Gepostet:
03.07.2007 01:47

   
Hallo nochmal,

zwei Stellen zum Optimieren hab ich gefunden, die laut Profiling sehr häufig durchlaufen werden:

* In der Funktion Algorithmus.resultOfMult erzeugst du eine Teilliste nach folgendem Muster: [genericIndex p (i-1) | i<-[a..b] ]. Das ist bei langen Listen p und großen Abständen a..b sehr uneffizient. genericIndex geht nämlich für jeden Index von Anfang an die ganze Liste durch, bis die entsprechende Position gefunden ist, hat also linearen Aufwand. Hier würde ich mich nicht auf eine Optimierung vom Compiler zu einem konstanen Aufwand verlassen. Zusätzlich wird durch die list comprehension eine zusätzliche Liste der Indizes erzeugt, was überflüssig ist. Da du dir ja nur eine Teilliste aus der originalen Liste "herausschneidest", kannst du mittels take und drop direkt auf die zusammenhängende Originalliste zugreifen. Obiger Ausdruck läßt sich dann zum effizienteren genericTake (b-a) (genericDrop a p) umformen.

* In der Funktion SignedDigit.shift werden u.U. große Links-/Rechts-Shifts in Einzelschritten ausgeführt. Hier könnte ich mir vorstellen, wäre ein ganzer Block-Shift mit nur einem Rekursionsaufruf ebenfalls effizienter. Beim Links-Shift ist das besonders einfach, da du nur die Kommastelle entsprechend ändern mußt. Beim Rechsshift müßte dann evtl. ein ganzer Block von 'Z'-Werten vorangestellt werden.

Das Problem mit dem Speicherallokieren lösen diese Änderungen m.E. aber nicht. Ich hab mir das Speicherverhalten des Programms noch einmal angesehen. Der benötigte Speicher bleibt bis zum unerwarteten Ende des Programms relativ gering, bei mir unter 10MB. Dann, kurz nach dem Halten, explodiert der Speicherverbrauch plötzlich ins Extreme. Daher mag ich nicht so recht an die Schuld des Garbage Collectors glauben. Die letzte berechnete Stelle liegt kurz hinter 2^15. Vielleicht wird intern irgendein Maximalwert (für Listenlängen?) überschritten, der das Programm in eine Endlosschleife stürzt, was dann die rasante Speicherallokierung zur Folge hat. Überhaupt rechnet das Programm sehr ruckelig, hält immer wieder mal für mehrere Sekunden an, bevor es weiterrechnet. Kann ich mir auch nicht wirklich erklären, woran das liegt.
Tritt das Problem eigentlich bei allen 3 Multiplikations-Algorithmen auf? Ich hab es nur mit der letzten versucht. Und versuch mal einen Durchlauf ohne die Compiler-Optimierung anzuschalten. Mehr Ideen hab ich dazu momentan leider auch nicht. Du könntest nur versuchen, den Kern des Problems durch sukzessives Rauswerfen von Quellcode zu lokalisieren.

Viele Grüße,

Siracusa
Zum Seitenanfang    
 
Rome

Gepostet:
03.07.2007 09:49

   
Servus,
hab deine beiden Tipps ma umgesetzt, er scheint ein wenig schneller zu sein, hört aber genau an der gleichen Stelle auf 8/ .
Ich, bzw mein Kumpel hatte noch die Idee, dass es vielleicht an der Rekursionstiefe liegen könnte, da er ja eigentlich den Speicher ne freigeben dürfte, solange er im rekursiven Aufruf steckt. Werde jetzt mal versuchen die Rekursion mittels /iterate/ aufzulösen.

Habe grade was Interessantes festgestellt: Das Problem tritt beim naiven Algorithmus bereits an der Stelle 16392 bzw 16395 auf, genau dort, wo er bei den beiden anderen mittendrin auch kurz hängt, aber dann weiterrechnet. Ich poste mal die beiden Subroutinen für /Naive/ und /Karatsuba/ , den Schönhage-Strassen wird er denke noch ne verwenden, da ich den Turnoverpoint auf 8192 gesetzt habe, vorher wird dort auch /karatsuba/ benutzt.
Weiter habe ich mal mit der Funktion /Algorithm.mult/ mal die Zahl /p = genericReplicate 40000 O/ ,
also 0.1111...., im Interpreter quadriert, er hat mir am Anfang auch brav nur Einsen ausgegeben, aber später dann Nullen, was eigentlich nicht sein darf. Die können eigentlich nur auftreten, wenn er in der Funktion /Algortihm.resultOfMult/ nicht mehr entsprechend auf die beiden Eingabeparamter zugreifen kann und daher diese mit Nullen auffüllt....


-- Dieses Modul dient der Multiplikation zweier Binärzahlen in SD-Darstellung.
-- Die Zahlen stammen aus den Rechtecken des Schedulings, ihre Länge wird
-- durch die Rechtecke bestimmt.
module Naive(
mult -- :: SDBounded -> SDBounded -> SDBounded
)
where

import SignedDigit
import Data.List

-- /naiveMult/ multipliziert zwei Zahlen in SD-Darstellung miteinander, dabei werden beide Zahlen in SD-Darstellung,
-- die nur aus einem Vorkommateil bestehen, konvertiert und diese dann mittels /multhlp/ multipliziert.
mult :: SDBounded -> SDBounded -> SDBounded
mult a b
| isZeroSDBounded a || isZeroSDBounded b = []
| genericLength a == 1 = scalMult b (head a)
| genericLength b == 1 = scalMult a (head b)
| otherwise = erg
where (sd,i) = (multHlp (a,genericLength a) (b,genericLength b))
erg = sd ++ (genericReplicate (i-(genericLength sd)) Z)

multHlp :: SD -> SD -> SD
multHlp (a,i) (b,j)
| (isZeroSDBounded a) || (isZeroSDBounded b) = empty
| otherwise = add(scalMult a (last b) ,i) (multHlp (shift 1(a,i)) ((init b),j-1))



module Karatsuba(
mult -- :: SDBounded -> SDBounded -> SDBounded
)
where

import SignedDigit
import Data.List

-- /naiveMult/ multipliziert zwei SD-Darstellungen mittels des Schulalgorithmus, die Funktion stützt sich dabei auf die Hilfsfunktion
-- /scalMult/, um eine SD-Darstellung mit einem einzelnen Digit zu multiplizieren.
naiveMult :: SD -> SD -> SD
naiveMult (a,i') (b,j')
| (isZeroSDBounded a) || (isZeroSDBounded b) = empty -- ist einer der beiden Parameter gleich Null, so wird Null zurückgegeben
| otherwise = add (scalMult x (last y) ,i) (naiveMult (shift 1(x,i)) ((init y),j-1)) -- sonst wird das Ergebnis mittels
-- /scalMult/, entsprechenden Shifts und Summation bestimmt.
where (x,i) = (a++(genericReplicate (i'-(genericLength a)) Z),i') -- implizite Nullen werden für die Berechnung benötigt
(y,j) = (b++(genericReplicate (j'-(genericLength b)) Z),j') -- und angefügt

-- /mult/ multipliziert zwei SD-Darstellungen aus dem Intervall [-1,1], die Funktion stützt sich dabei auf die beiden Funktionen /karatsuba/
-- und /scalMult/. Ist einer der beiden Eingabeparamter /p/ und /q/ von der Länge eins, so wird nur eine "Skalar-Multiplikation" mittels
-- /scalMul/ durchgeführt, ansonsten wird der Karatsuba-Algorithmus zur Multiplikation der beiden Zahlen benutzt.
mult :: SDBounded -> SDBounded -> SDBounded
mult p q
| isZeroSDBounded p || isZeroSDBounded q = [] -- ist eine der beiden Zahlen gleich Null, so wird die leere SD-Darstellung zurückgegeben.
| l1 == 1 = scalMult q (head p) -- ist /p/ ein einzelnes Digit, so wird die Funktion /scalMult/ für die Multiplikation benutzt.
| l2 == 1 = scalMult p (head q) -- ist /q/ ein einzelnes Digit, so wird die Funktion /scalMult/ für die Multiplikation benutzt.
| otherwise = result
where l1 = genericLength p -- Bestimmen der Länge der Eingbabeparameter
l2 = genericLength q
(pPadded, qPadded) = pad (p,l1) (q,l2) -- falls einer der Parameter kürzer als der andere ist, werden Padding-Nullen vorne angefügt.
(karaResult,i) = karatsuba pPadded qPadded
result = karaResult++(genericReplicate (i-(genericLength karaResult)) Z) -- evtl implizite Nullen hinten an das Ergebnis anfügen

-- /karatsuba/ multipliziert zwei SD-Darstellungen mittels der Karatsuba-Methode, die Eingabeparameter /p/ und /q/ müssen gleich lang sein,
-- dies wird in der Funktion /mult/ überprüft. Um den Overhead zu vermindern wird bei einer Länge kleiner gleich 2 der normale Schulalgorithmus benutzt.
karatsuba :: SD -> SD -> SD
karatsuba (x,i) (y,j)
| i <= 16 || j <= 16 = naiveMult (x,i) (y,j) -- bei einer Länge der Parameter von kleiner gleich 16, wird der Schulalgorithmus aufgerufen
| odd i = karatsuba (Z:x,i+1) (y,j) -- der erste Eingabeparameter hat ungerade Länge, eine Null wird vorne angefügt
| odd j = karatsuba (x,i) (Z:y,j+1) -- der zweite Eingabeparameter hat ungerade Länge, eine Null wird vorne angefügt
| otherwise = ( (shift n x1y1) `add` (shift m middle) ) `add` x0y0 -- sonst kann der Algorithmus ausgeführt werden
where n = if i==j then i else error "arguments must have same length"
m = div n 2 -- /m/ ist ganzzahlig, da zuvor geprüft wurde, ob /n/ durch /2/ teilbar ist.
(x1,x0) = genericSplitAt m x -- Zahlausschnitte /x1/ und /x0/ mit /x = x1*2^m + x0/
(y1,y0) = genericSplitAt m y -- Zahlausschnitte /y1/ und /y0/ mit /y = y1*2^m + y0/
middle = add(add x1y1 x0y0) x1x0y0y1 -- Zusammensetzen der rekursiven Aufrufe
x1y1 = karatsuba (x1,m) (y1,m) -- rekursiver Aufruf mit den Zahlausschnitten /x1/ und /y1/
x0y0 = karatsuba (x0,m) (y0,m) -- rekursiver Aufruf mit den Zahlausschnitten /x0/ und /y0/
x1x0y0y1 = karatsuba x1x0 y0y1 -- rekursiver Aufruf mit den "gemischten" Zahlausschnitten
(x1x0,y0y1) = pad (sub (x1,m) (x0,m)) (sub (y0,m) (y1,m)) -- da bei der Differenzbildung der
-- "gemischten" Ausdrücke auch ein Übertrag entstehen kann (Signed-Digit-Darstellung!), müssen
-- die Ergebnisse wieder gleichlang gemacht werden.


Also auch ohne Optimierungsoption hängt er an genau der gleichen Stelle...


Gruß,
Rome
Zum Seitenanfang    
 
Rome

Gepostet:
03.07.2007 19:52

   
Also,

mein Kumpel hats mal unter Linux compiliert und folgendes festgestellt:

32779 : 1 1 ---32776--> 0
32780 : 1 0 ---32777--> -1
Main: Ix{Integer}.index: Index (32766) out of range ((0,32765))

Werde das morgen dann mal genauer unter die Lupe nehmen, hab trotzdem vielen dank für deine Mühe...

Gruß,
Rome
Zum Seitenanfang    
 
Rome

Gepostet:
04.07.2007 11:29

   
So,

hab mal wieder was neues herausgefunden:

Habe sämtliche Typen /Integer/ ind /Int/ umgeschrieben und nutze nun die normalen /Prelude/ Listenfuktionen anstelle der /generics/ . Bisher ist er bei über 36000....

mittlerweile bei über 100K....

Gruß
Rome
Zum Seitenanfang    
 
Siracusa

Gepostet:
04.07.2007 18:53

   
Offensichtlich sind die generic-Funktionen für größere Datenmengen ungeeignet:

Prelude> length [1..1000000]
1000000
Prelude> Data.List.genericLength [1..1000000]
*** Exception: stack overflow


Mich würde mal die Speicherauslastung des Programms bei Stelle 100.000 interessieren, ist die durch die Ersetzung gesunken oder allokiert er immer noch gigantische Speichermengen?

Viele Grüße,

Siracusa
Zum Seitenanfang    
 

  1 2 nächste Seite