1
0
This repository has been archived on 2025-03-31. You can view files and clone it, but cannot push or open issues or pull requests.
opal-examples/Blatt04/Blatt4.impl
2013-10-19 01:17:37 +02:00

254 lines
7.0 KiB
Plaintext

IMPLEMENTATION Blatt4
IMPORT Nat COMPLETELY
Seq COMPLETELY
-- Aufgabe 1 ------------------------------------------------------------------
-- Aufgabe 1.1 ----------------------------------------------------------------
/*
-- nicht optimierte Variante
FUN primeFactorDecomposition: nat -> seq[nat]
DEF primeFactorDecomposition(n) == primeFactors(2, n)
-- primeFactors(k, n) berechnet die Sequenz der Primfaktoren
-- von n unter der Voraussetzung, daß n keine Primfaktoren
-- besitzt, die kleiner als k sind.
FUN primeFactors: nat ** nat -> seq[nat]
DEF primeFactors(k, n) ==
IF n = 1 THEN <>
OTHERWISE
IF n%k = 0 THEN k :: primeFactors(k, n/k)
ELSE primeFactors(k+1, n)
FI
*/
-- optimierte Variante
FUN primeFactorDecomposition: nat -> seq[nat]
DEF primeFactorDecomposition(n) == primeFactors(2, 1, n)
-- primeFactors(k, step, n) berechnet die Sequenz der Primfaktoren
-- von n unter der Voraussetzung, daß n keine Primfaktoren
-- besitzt, die kleiner als k sind.
-- Dabei muß step=1 gelten, wenn k gerade ist
-- und step=2, wenn k ungerade ist.
-- (... eine derartige Funktion darf niemals eine "Benutzerfunktion" sein,
-- da derart seltsame Anwendungsbedingungen nur für eine Hilfsfunktion
-- akzeptabel sind)
FUN primeFactors: nat ** nat ** nat -> seq[nat]
DEF primeFactors(k, step, n) ==
IF n = 1 THEN <>
OTHERWISE
IF n%k = 0 THEN k :: primeFactors(k, step, n/k)
ELSE primeFactors(k+step, 2, n)
FI
-- Aufgabe 1.2 ----------------------------------------------------------------
FUN ascendingPrefix: seq[nat] -> seq[nat] ** seq[nat]
DEF ascendingPrefix(S) ==
IF S <>? THEN (<>,<>)
ELSE
LET
n == ft(S)
R == rt(S)
IN
IF R <>? THEN (S,<>)
OTHERWISE
IF n <= ft(R) THEN
(n::S1, S2)
WHERE
(S1, S2) == ascendingPrefix(R)
ELSE
(n::(<>), R)
FI
FI
-- Aufgabe 2 ------------------------------------------------------------------
-- Aufgabe 2.1 (Tut) ----------------------------------------------------------
FUN ascendingParts: seq[nat] -> seq[seq[nat]]
DEF ascendingParts(S) ==
IF S <>? THEN <>
ELSE
LET
(part, rest) == ascendingPrefix(S)
IN
part :: ascendingParts(rest)
FI
-- Aufgabe 2.2 (Tut) ----------------------------------------------------------
/*
-- nicht optimierte Variante
FUN powerSet: seq[nat] -> seq[seq[nat]]
DEF powerSet ==
\\S. IF S <>? THEN <> :: <>
ELSE
powerSubset ++ prepend(ft(S),powerSubset)
WHERE
powerSubset == powerSet(rt(S))
FI
*/
-- prepend(n,S) stellt jeder in S enthaltenen Sequenz die Zahl n voran
FUN prepend: nat ** seq[seq[nat]] -> seq[seq[nat]]
DEF prepend ==
\\n,S. IF S <>? THEN <>
ELSE (n::ft(S))::prepend(n,rt(S))
FI
-- optimierte Variante
FUN powerSet: seq[nat] -> seq[seq[nat]]
DEF powerSet ==
\\S. IF S <>? THEN <> :: <>
ELSE augment(ft(S),powerSet(rt(S)))
FI
-- augment(n,S) = ( prepend(n,S) vereinigt mit S )
FUN augment: nat ** seq[seq[nat]] -> seq[seq[nat]]
DEF augment ==
\\n,S. IF S <>? THEN <>
ELSE (n::ft(S))::ft(S)::augment(n,rt(S))
FI
-- Aufgabe 2.3 ----------------------------------------------------------------
FUN perm: seq[nat] -> seq[seq[nat]]
DEF perm ==
\\S. IF S <>? THEN <> :: <>
ELSE insertInAllLists(ft(S),perm(rt(S)))
FI
-- insertInAllLists(n,S) bildet für jede Sequenz von S alle möglichen
-- Zerlegungen in zwei Teile, fügt jeweils n dazwischen ein und liefert
-- alle resultierenden Sequenzen zurück.
FUN insertInAllLists: nat ** seq[seq[nat]] -> seq[seq[nat]]
DEF insertInAllLists ==
\\n,S. IF S <>? THEN <>
ELSE insertAtAllPositions(n,ft(S))
++ insertInAllLists(n,rt(S))
FI
-- Für jede mögliche Zerlegung von S = S1.S2 erzeugt
-- insertAtAllPositions(n,S) die Sequenz S' = S1.n.S2 und liefert
-- alle diese Sequenzen zurück.
FUN insertAtAllPositions: nat ** seq[nat] -> seq[seq[nat]]
DEF insertAtAllPositions ==
\\n,S. IF S <>? THEN (n :: <>) :: <>
ELSE (n :: S) :: prepend(ft(S),insertAtAllPositions(n,rt(S)))
FI
-- Aufgabe 3 ------------------------------------------------------------------
-- zum Testen
FUN vec1: seq[nat]
DEF vec1 == %(1,2,3,4)
FUN mat1 mat2: seq[seq[nat]]
DEF mat1 == %(%(1,2,3,4),
%(5,6,7,8),
%(9,10,11,12))
DEF mat2 == %(%(1,2,3),
%(4,5,6),
%(7,8,9),
%(10,11,12))
-- zur Kontrolle:
-- mat1 * vec1 = <30,70,110>
-- mat1 * mat2 = << 70, 80, 90>,
-- <158,184,210>,
-- <246,288,330>>
-- mat2 * mat1 = << 38, 44, 50, 56>,
-- < 83, 98,113,128>,
-- <128,152,176,200>,
-- <173,206,239,272>>
-- Funktionen höherer Ordnung dürft ihr in diesem Blatt noch nicht verwenden.
IMPORT SeqZip ONLY zip -- nur für das Skalarprodukt
SeqReduce ONLY / -- nur für das Skalarprodukt
-- Skalarprodukt zweier Vektoren (gleicher Dimension)
FUN skalarProd: seq[nat] ** seq[nat] -> nat
DEF skalarProd(v1,v2) == (+,0) / zip(*)(v1,v2)
-- Aufgabe 3.1 (Tut) ----------------------------------------------------------
-- matVecProd(M,v) setzt voraus, daß die Anzahl der Spalten von M
-- gleich der Anzahl der Elemente (Zeilen) von v ist.
FUN matVecProd : seq[seq[nat]] ** seq[nat] -> seq[nat]
DEF matVecProd(M,v) ==
IF M <>? THEN <>
ELSE skalarProd(ft(M),v) :: matVecProd(rt(M),v)
FI
-- Aufgabe 3.2 ----------------------------------------------------------------
FUN transp: seq[seq[nat]] -> seq[seq[nat]]
DEF transp(M) ==
IF ft(M) <>? THEN <>
ELSE mapFt(M) :: transp(mapRt(M))
FI
-- Extraktion der ersten Spalte einer Matrix
FUN mapFt: seq[seq[nat]] -> seq[nat]
DEF mapFt(M) ==
IF M <>? THEN <>
ELSE ft(ft(M)) :: mapFt(rt(M))
FI
-- Abschneiden der ersten Spalte einer Matrix
-- mit Rückgabe der verbleibenden Untermatrix
FUN mapRt: seq[seq[nat]] -> seq[seq[nat]]
DEF mapRt(M) ==
IF M <>? THEN <>
ELSE rt(ft(M)) :: mapRt(rt(M))
FI
-- Aufgabe 3.3 ----------------------------------------------------------------
-- Produkt zweier Matrizen: C = A x B
-- A und B müssen verkettet sein,
-- d.h. Anzahl der Spalten von A = Anzahl der Zeilen von B
FUN matMatProd : seq[seq[nat]] ** seq[seq[nat]] -> seq[seq[nat]]
/*
-- nicht optimierte Version mit zweimaliger Transposition
DEF matMatProd(M1,M2) ==
transp(matMatProdHelp(M1,transp(M2)))
*/
-- optimierte Version mit einmaliger Transposition
DEF matMatProd(M1,M2) ==
matMatProdHelp(transp(M2),M1)
-- Pseudo-Produkt zweier Matrizen:
-- Argumente sind A und B, berechnet wird (A x Bt)t, d.h. B x At
-- (t = Transposition)
-- A und Bt müssen verkettet sein
FUN matMatProdHelp : seq[seq[nat]] ** seq[seq[nat]] -> seq[seq[nat]]
DEF matMatProdHelp(M1,M2) ==
IF M2 <>? THEN <>
ELSE matVecProd(M1,ft(M2)) :: matMatProdHelp(M1,rt(M2))
FI
-- ----------------------------------------------------------------------------