Declaratieve Talen/Oplossing haskell buurgraden

--een mogelijke oplossing (zeker niet de beste!)

import List

data Edge a = Boog a a deriving Show
data Graph a = Graaf [a][Edge a] deriving Show

geefBuren :: (Eq a) => Graph a -> a -> [a]
------------------------------------------
geefBuren (Graaf x y) knoop = 
	[b | b <- x, (heeftBoog knoop b y)];


heeftBoog :: (Eq a) => a -> a -> [Edge a] -> Bool
-------------------------------------------------
heeftBoog a b [] = False

heeftBoog a b ((Boog x y):rest) = 
	if ((a == x && b == y) || (b == x && a == y)) then
		True
	else
		heeftBoog a b rest


geefGraad :: (Eq a) => Graph a -> a -> Int
------------------------------------------
geefGraad (Graaf x y) a =
	telgraden y a


telgraden :: (Eq a) => [Edge a] -> a -> Int
-------------------------------------------
telgraden [] a = 0
telgraden ((Boog p q):rest) x =
	if(p == x || q == x) then
		1 + telgraden rest x
	else
		telgraden rest x


buurgraadVanKnoop :: (Eq a) => Graph a -> a -> [Int]
----------------------------------------------------
buurgraadVanKnoop x y = 
	reverse (sort (buurgraadVanBuren x (geefBuren x y)))


buurgraadVanBuren :: (Eq a) => Graph a -> [a] -> [Int]
------------------------------------------------------
buurgraadVanBuren x [] = []
buurgraadVanBuren x (buur:rest) =
	((geefGraad x buur):(buurgraadVanBuren x rest))


buurgraad :: (Eq a) => Graph a -> [([Int], [a])]
------------------------------------------------
buurgraad (Graaf x y) = voegsamen (geefBuurGraden (Graaf x y) x)


geefBuurGraden :: (Eq a) => Graph a -> [a] -> [([Int],[a])]
----------------------------------------------------------
geefBuurGraden a [] = []
geefBuurGraden a (knoop:rest) =
	(((buurgraadVanKnoop a knoop),[knoop]):(geefBuurGraden a rest))


voegsamen :: [([Int], [a])] -> [([Int], [a])]
---------------------------------------------
voegsamen [] = []
voegsamen ( (x, y) : rest) =
	((voegbij (x,y) rest) : voegsamen (verwijder (x,y) rest rest))


voegbij :: ([Int], [a]) -> [([Int], [a])] -> ([Int], [a])
---------------------------------------------------------
voegbij a [] = a
voegbij (x, y) ((a,[b]):rest) =
	if(x == a) then
		voegbij (x,(b:y)) rest
	else
		voegbij (x,y) rest


verwijder :: ([Int], [a]) -> [([Int], [a])] -> [([Int], [a])] -> [([Int], [a])]
---------------------------------------------------------
verwijder a [] b = b
verwijder (x, y) ((a,[b]):rest) ((i,j):rij) =
	if(x == a) then
		verwijder (x,y) rest rij
	else
		verwijder (x,y) rest ((i,j):rij)

Een alternatief

Merk op dat deze oplossing de uitkomst niet sorteert ...

import List

-- Graaf ['a','b','c','d','e','f','g','h'] [Boog 'a' 'b', Boog 'b' 'c', Boog 'e' 'f', Boog 'f' 'g', Boog 'g' 'h', Boog 'h' 'a', Boog 'd' 'g', 
-- Boog 'c' 'd', Boog 'd' 'e', Boog 'a' 'd']

data Graaf a = Graaf [a] [Boog a] deriving Show
data Boog a = Boog a a deriving Show

geef_buren::(Eq a)=>a->Graaf a->[a]
geef_buren knoop (Graaf _ bogen) = [y | (Boog y z) <- bogen, z==knoop] ++ [y | (Boog z y) <- bogen, z==knoop]


graad_knopen::(Eq a)=>[a]->Graaf a->[Int]
graad_knopen [] graaf = []
graad_knopen (knoop:xs) graaf = length (geef_buren knoop graaf) : (graad_knopen xs graaf)

buurgraad::(Eq a)=>a->Graaf a->([Int],[a])
buurgraad knoop graaf =
	let
		buren = geef_buren knoop graaf
	in 	(reverse (sort (graad_knopen buren graaf)) , [knoop])

buurgraad_graaf::(Eq a)=>Graaf a->[([Int],[a])]
buurgraad_graaf (Graaf knopen bogen) = 
	[(buurgraad knoop (Graaf knopen bogen)) | knoop <- knopen]

Nog een alternatief

-- beide deelvragen

import Data.List

data Graaf t = Graaf [t] [Boog t]
data Boog t = Boog t t

buurgraadGraaf :: (Eq t, Ord t) => Graaf t -> [([Int],[t])]
buurgraadGraaf graaf@(Graaf knopen bogen) = res
    where buurgraadparen = map (buurgraadKnoop graaf) knopen
          buurgraden = sortBy buurgraadCompare (nub [ buurgraad | (buurgraad,v) <- buurgraadparen ])
          res = [ (buurgraad, nub [vertex | vertex <- knopen, (buurgraad,vertex) `elem` buurgraadparen]) | buurgraad <- buurgraden ]

nooit_isomorf :: (Eq t, Ord t) => Graaf t -> Graaf t -> Bool
nooit_isomorf graaf1 graaf2 = not $ graadLengte1 == graadLengte2
    where graadgraaf1 = buurgraadGraaf graaf1
          graadgraaf2 = buurgraadGraaf graaf2
          graadLengte1 = knopenNaarLengte graadgraaf1
          graadLengte2 = knopenNaarLengte graadgraaf2
          
knopenNaarLengte :: [([Int],[t])] -> [([Int],Int)]
knopenNaarLengte [] = []
knopenNaarLengte ((buurgraad,knopen):xs) = (buurgraad,length knopen) : knopenNaarLengte xs
          
buurgraadKnoop :: (Eq t) => Graaf t -> t -> ([Int],t)
buurgraadKnoop graaf knoop = (graden,knoop)
    where buren = alleBuren graaf knoop
          graden = sortBy intDesc [ n | buur <- buren, let n = graad graaf buur ]

graad :: (Eq t) => Graaf t -> t -> Int
graad (Graaf knopen bogen) knoop = graad' bogen knoop 0

graad' :: (Eq t) => [Boog t] -> t -> Int -> Int
graad' [] _ num = num
graad' ((Boog a b):xs) knoop num | a == knoop || b == knoop = graad' xs knoop (num + 1)
                                 | otherwise = graad' xs knoop num
                                 
alleBuren :: (Eq t) => Graaf t -> t -> [t]
alleBuren (Graaf knopen bogen) knoop = alleBuren' bogen knoop []

alleBuren' :: (Eq t) => [Boog t] -> t -> [t] -> [t]
alleBuren' [] _ list = list
alleBuren' (Boog a b:xs) knoop alGezien | a == knoop && b `notElem` alGezien = alleBuren' xs knoop (b:alGezien)
                                        | b == knoop && a `notElem` alGezien = alleBuren' xs knoop (a:alGezien)
                                        | otherwise = alleBuren' xs knoop alGezien

maakOngericht :: [(t,t)] -> [(t,t)]
maakOngericht [] = []
maakOngericht ((a,b):xs) = (a,b):(b,a):maakOngericht xs

buurgraadCompare :: (Eq t, Ord t) => [t] -> [t] -> Ordering
buurgraadCompare a b | length a > length b = LT
                     | length a < length b = GT
                     | head a > head b = LT
                     | head a < head b = GT
                     | head a == head b = EQ
                     
intDesc :: Int -> Int -> Ordering
intDesc a b | a < b = GT
            | a > b = LT
            | a == b = EQ

--Thomas Vochten