import "tut08.hs" (suc,p,compose,pr)
import "Turing.hs"
--Aufgabe 1
qs [] = []
qs (a:as) = (qs [x | x<-as, length x <= length a]) ++ [a] ++ (qs [x | x<-as, length x > length a])
-- Aufgabe 2
data Nom = N Int | PlusUnendlich | MinusUnendlich | Undefiniert deriving (Show,Eq)
add,sub,mul,diV :: Nom -> Nom -> Nom
add (N a) (N b) = N (a+b)
add (N _) x = x
add x (N _) = x
add a b = if (a==b) then a else Undefiniert
sub (N a) (N b) = N (a-b)
sub (N _) PlusUnendlich = MinusUnendlich
sub (N _) MinusUnendlich = PlusUnendlich
sub _ Undefiniert = Undefiniert
sub a b = if (a/=b) then a else Undefiniert
-- !!! im Tutorium vergessen: 0 * PlusUnendlich == 0 * MinusUnendlich == 0 * Undefiniert == 0 !!!
mul (N a) (N b) = N (a*b)
mul (N 0) _ = N 0
mul (N a) x
| a<0 && x== PlusUnendlich = MinusUnendlich
| a<0 && x== MinusUnendlich = PlusUnendlich
| otherwise = x
mul x (N b) = mul (N b) x
mul Undefiniert _ = Undefiniert
mul _ Undefiniert = Undefiniert
mul a b = if (a==b) then PlusUnendlich else MinusUnendlich
diV _ Undefiniert = Undefiniert
diV Undefiniert _ = Undefiniert
diV (N a) (N b)
| a == 0 && b == 0 = Undefiniert
| a > 0 && b == 0 = PlusUnendlich
| a < 0 && b == 0 = MinusUnendlich
| otherwise = N (div a b)
diV (N a) x = N 0
diV PlusUnendlich (N b) = if (b<0) then MinusUnendlich else PlusUnendlich
diV MinusUnendlich (N b) = if (b<0) then PlusUnendlich else MinusUnendlich
diV a b = Undefiniert
testF f = (putStr.concat) [show (a,b) ++ "->"++ show( f a b)++"\n" | a<-testList, b<-testList]
testList = [N 0, N 5,N (-5),MinusUnendlich,PlusUnendlich,Undefiniert]
-- Aufgabe 3
-- nur zum testen! - verlangt war die formale Definition!!!!
mulPR = pr mulPR (const 0) (compose addPR [p 1,p 3])
addPR = pr addPR (p 1) (compose suc [p 1])
{-
(++.1) [] ++ xs = xs
(++.2) (a:as) ++ xs = a:(as++xs)
(drop.1) drop 0 as = as
(drop.2) drop (n+1) [] = []
(drop.3) drop (n+1) (a:as) = drop n as
(take.1) take 0 as = []
(take.2) take (n+1) [] = []
(take.3) take (n+1) (a:as) = a:(take n as)
Beh.: take n l ++ drop n l = l gilt für alle endlichen Listen l und alle n N
Vollständige Induktion über l
I.A.: l==[] z.z.: take n [] ++ drop n [] = [] gilt für alle n N
1. Fall: n==0
take 0 [] ++ drop 0 [] = [] ++ drop 0 [] // take.1
= [] ++ [] // drop.1
= [] // ++.1
2. Fall: n>0
take (n+1) [] ++ drop (n+1) []
= [] ++ drop (n+1) [] // take.2
= [] ++ [] // drop.2
= [] // ++.1
I.V.: take n l ++ drop n l = l gilt für eine bestimmte Liste l und alle n N
I.S.: l -> a:l z.z.: take n (a:l) ++ drop n (a:l) = a:l gilt für alle n N
1. Fall: n==0
take 0 (a:l) ++ drop 0 (a:l) = [] ++ drop 0 (a:l) // take.1
= [] ++ (a:l) // drop.1
= a:l // ++.1
2. Fall: n>0
take (n+1) (a:l) ++ drop (n+1) (a:l)
= (a:take n l) ++ drop (n+1) (a:l) // take.3
= (a:take n l) ++ (drop n l) // drop.3
= a:(take n l ++ drop n l) // ++.2
= a:l // I.V.
-}
-- Aufgabe 4
base4 :: [TuringBefehl]
base4 =
[ (1,'A',2,'A','l'),
(1,'*',1,'*','r'),
(2,'0',3,'X','l'),
(2,'1',4,'Y','l'),
(2,'X',2,'X','l'),
(2,'Y',2,'Y','l'),
(2,'B',10,'B','r'),
(3,'0',5,'X','l'),
(3,'1',6,'Y','l'),
(3,'B',10,'B','r'),
(4,'0',7,'X','l'),
(4,'1',8,'Y','l'),
(4,'B',7,'B','l'),
(5,'_',1,'0','r'),
(5,'*',5,'*','l'),
(7,'_',1,'1','r'),
(7,'*',7,'*','l'),
(6,'_',1,'2','r'),
(6,'*',6,'*','l'),
(8,'_',1,'3','r'),
(8,'*',8,'*','l'),
(10,'A',11,'A','l'),
(10,'X',10,'0','r'),
(10,'Y',10,'1','r'),
(11,'_',0,'C','s'),
(11,'*',11,'*','l')
]
-- Aufgabe 5
data (Ord a) => Tree a = Empty | B (Tree a) a (Tree a)
insert :: Ord a => Tree a -> a -> Tree a -- <-- Ord a muß man doch hinschreiben !!!
insert Empty x = B Empty x Empty
insert (B links wert rechts) x
| x == wert = B links wert rechts
| x <= wert = B (insert links x) wert rechts
| x > wert = B links wert (insert rechts x)
isIn :: Ord a => a -> Tree a -> Bool
isIn x Empty = False
isIn x (B links wert rechts)
| x == wert = True
| x <= wert = isIn x links
| x > wert = isIn x rechts
minElem :: Ord a => Tree a -> a
minElem Empty = error "not found"
minElem (B Empty x _) = x
minElem (B links _ _) = minElem links
sortTree :: Ord a => Tree a -> [a]
sortTree Empty = []
sortTree (B links wert rechts) = sortTree links ++ [wert] ++ sortTree rechts
---
listToTree :: Ord a => [a] -> Tree a
listToTree = foldl insert Empty
instance (Show a,Ord a) => Show (Tree a) where
show tree = local tree 0 "=|"
where local Empty n w = replicate (n*k) ' ' ++w++"-]"
local (B l x r) n w = local r (n+1) ",-" ++"\n"++replicate (n*k) ' '++w++show x++"\n"++local l (n+1) "`-"
k = 3