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)
|
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 |