程序代做 {-# OPTIONS_GHC -Wall #-}

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

Copyright By PowCoder代写 加微信 powcoder

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeApplications #-}

module Submission1 where

import Prelude hiding (maximum)

import Data.Maybe (fromJust)
import Data.Function (on)

import Control.DeepSeq
import Data.Coerce (coerce)

import Data.Array
import Data.List (unfoldr, nub, sortBy, (\\))
import Data.Map (Map)
import qualified Data.Map as M

import qualified Data.Binary as B
import GHC.Generics

data Player = Player1 | Player2

data Planet = Planet Owner Ships Growth
newtype Ships = Ships Int
newtype Growth = Growth Int

data Owner = Neutral | Owned Player

newtype PlanetId = PlanetId Int

type Planets = Map PlanetId Planet

data Wormhole = Wormhole Source Target Turns

newtype Source = Source PlanetId
newtype Target = Target PlanetId
newtype Turns = Turns Int

newtype WormholeId = WormholeId Int

type Wormholes = Map WormholeId Wormhole

data Fleet = Fleet Player Ships WormholeId Turns

type Fleets = [Fleet]

data GameState = GameState Planets Wormholes Fleets

data Order = Order WormholeId Ships

fib :: Int -> Integer
fib n = fib (n-2) + fib (n-1)

fib’ :: Int -> Integer
fib’ n = table ! n
table :: Array Int Integer
table = tabulate (0, n) mfib

mfib 0 = 0
mfib 1 = 1
mfib n = table ! (n-1) + table ! (n-2)

tabulate :: Ix i => (i,i) -> (i -> a) -> Array i a
tabulate (u,v) f =
array (u,v) [ (i, f i) | i <- range (u, v)] example1 :: GameState example1 = GameState planets wormholes fleets where planets = M.fromList [ (PlanetId 0, Planet (Owned Player1) (Ships 300) (Growth 0)) , (PlanetId 1, Planet Neutral (Ships 200) (Growth 50)) , (PlanetId 2, Planet Neutral (Ships 150) (Growth 10)) , (PlanetId 3, Planet Neutral (Ships 30) (Growth 5)) , (PlanetId 4, Planet Neutral (Ships 100) (Growth 20)) wormholes = M.fromList [ (WormholeId 0, Wormhole homePlanet (Target 1) (Turns 1)) , (WormholeId 1, Wormhole homePlanet (Target 2) (Turns 1)) , (WormholeId 2, Wormhole homePlanet (Target 3) (Turns 1)) , (WormholeId 3, Wormhole homePlanet (Target 4) (Turns 1)) ] where homePlanet = Source 0 fleets = [] targetPlanets :: GameState -> Source -> [(PlanetId, Ships, Growth)]
targetPlanets st s
= map (planetDetails . target) (M.elems (wormholesFrom s st))
planetDetails :: PlanetId -> (PlanetId, Ships, Growth)
planetDetails pId = (pId, ships, growth)
where Planet _ ships growth = lookupPlanet pId st

shipsOnPlanet :: GameState -> PlanetId -> Ships
shipsOnPlanet st pId = ships
where Planet _ ships _ = lookupPlanet pId st

lookupPlanet :: PlanetId -> GameState -> Planet
lookupPlanet pId (GameState ps _ _) = fromJust (M.lookup pId ps)

wormholesFrom :: Source -> GameState -> Wormholes
wormholesFrom pId (GameState _ ws _)
= M.filter (\(Wormhole s _ _) -> s == pId) ws

wormholesTo :: Target -> GameState -> Wormholes
wormholesTo pId (GameState _ ws _)
= M.filter (\(Wormhole _ t _) -> t == pId) ws

knapsack :: forall name weight value .
(Ord weight, Num weight, Ord value, Num value) =>
[(name, weight, value)] -> weight -> value
knapsack wvs c = maximum 0 [ v + knapsack wvs (c – w)
| (_,w,v) <- wvs , w <= c ] maximum :: Ord a => a -> [a] -> a
maximum x xs = foldr max x xs

knapsack’ :: forall name weight value .
(Ix weight, Num weight, Ord value, Num value) =>
[(name, weight, value)] -> weight -> value
knapsack’ wvs c = table ! c
table :: Array weight value
table = tabulate (0,c) mknapsack

mknapsack :: weight -> value
mknapsack c = undefined

knapsack”
:: forall name weight value .
(Ix weight, Num weight, Ord value, Num value) =>
[(name, weight, value)] -> weight -> (value, [name])
knapsack” wvs c = table ! c
table :: Array weight (value, [name])
table = tabulate (0,c) mknapsack

mknapsack :: weight -> (value, [name])
mknapsack c = undefined

bknapsack :: forall name weight value .
(Ord weight, Num weight, Ord value, Num value) =>
[(name, weight, value)] -> weight -> (value, [name])
bknapsack = undefined

maxBy :: Ord b => (a -> b) -> a -> a -> a
maxBy f x y = case compare (f x) (f y) of

bknapsack’ :: forall name weight value .
(Ord weight, Num weight, Ord value, Num value) =>
[(name, weight, value)] -> Int ->
weight -> (value, [name])
bknapsack’ = undefined

bknapsack” :: forall name weight value .
(Ord name, Ix weight, Ord weight, Num weight,
Ord value, Num value) =>
[(name, weight, value)] -> weight -> (value, [name])
bknapsack” = undefined

optimise :: GameState -> Source -> (Growth, [PlanetId])
optimise st p)
= bknapsack” (targetPlanets st s) (shipsOnPlanet st p)

type Weight = Integer

class Eq v => Edge e v | e -> v where
source :: e -> v
target :: e -> v
weight :: e -> Weight

instance Edge (String, String, Integer) String where
source (s, _, _) = s
target (_, t, _) = t
weight (_, _, i) = i

instance Edge Wormhole PlanetId where
source (Wormhole (Source s) _ _) = s
target (Wormhole _ (Target t) _) = t
weight (Wormhole _ _ (Turns turns)) = toInteger turns

instance Edge (WormholeId, Wormhole) PlanetId where
source (_, w) = source w
target (_, w) = target w
weight (_, w) = weight w

data Path e = Path Weight [e]

pathFromEdge :: Edge e v => e -> Path e
pathFromEdge e = Path (weight e) [e]

extend :: Edge e v => Path e -> e -> Path e
extend (Path _ []) _ = error “extend: Empty path”
extend (Path d (e:es)) e’
| target e == source e’ = Path (d + weight e’) (e’:e:es)
| otherwise = error “extend: Incompatible endpoints”

pathFromEdges :: Edge e v => [e] -> Path e
pathFromEdges (x : xs) = foldl extend (pathFromEdge x) xs
pathFromEdges [] = error “pathFromEdges: Empty list of edges”

instance Edge e v => Edge (Path e) v where
source (Path _ es) = source (last es)
target (Path _ es) = target (head es)
weight (Path w _) = w

class Edge e v => Graph g e v | g -> e where
vertices :: g -> [v]
edges :: g -> [e]
edgesFrom :: g -> v -> [e]
edgesTo :: g -> v -> [e]
velem :: v -> g -> Bool
eelem :: e -> g -> Bool

instance (Eq e, Edge e v) => Graph [e] e v where
vertices es = nub (map source es ++ map target es)
edges es = es
edgesFrom es v = [ e | e <- es, v == source e ] edgesTo es v = [ e | e <- es, v == target e ] velem v es = v `elem` vertices es eelem v es = v `elem` edges es example2 :: [(String, String, Integer)] example2 = [("s","t",10), ("s","y",5), ("t","x",1), ("t","y",2), ("y","t",3), ("y","x", 9), ("x","z",4), ("z","x",6), ("y","z",2), ("z","s",7)] instance Graph GameState (WormholeId, Wormhole) PlanetId where vertices (GameState ps _ _) = M.keys ps edges (GameState _ ws _) = M.assocs ws edgesTo st pId = M.toList (wormholesTo (Target pId) st) edgesFrom st pId = M.toList (wormholesFrom (Source pId) st) velem pId (GameState ps _ _) = M.member pId ps eelem (wId, _) (GameState _ ws _) = M.member wId ws lt :: (a -> a -> Ordering) -> (a -> a -> Bool)
lt cmp x y = cmp x y == LT

gt :: (a -> a -> Ordering) -> (a -> a -> Bool)
gt cmp x y = cmp x y == GT

lte :: (a -> a -> Ordering) -> (a -> a -> Bool)
lte cmp x y = cmp x y /= GT

eq :: (a -> a -> Ordering) -> (a -> a -> Bool)
eq cmp x y = cmp x y == EQ

class PQueue pqueue where
toPQueue :: (a -> a -> Ordering) -> [a] -> pqueue a
toPQueue cmp xs = foldr insert (empty cmp) xs

fromPQueue :: pqueue a -> [a]
fromPQueue = unfoldr unqueue
| isEmpty q = Nothing
| otherwise = Just (detach q)

priority :: pqueue a -> (a -> a -> Ordering)

empty :: (a -> a -> Ordering) -> pqueue a
isEmpty :: pqueue a -> Bool

insert :: a -> pqueue a -> pqueue a

extract :: pqueue a -> a
discard :: pqueue a -> pqueue a
detach :: pqueue a -> (a, pqueue a)
detach q = (extract q, discard q)

data PList a = PList (a -> a -> Ordering) [a]

instance PQueue PList where

toPQueue cmp xs = PList cmp (sortBy cmp xs)

fromPQueue (PList _ xs) = xs

empty cmp = PList cmp []

isEmpty (PList _ xs) = null xs

priority (PList cmp _) = cmp

insert x (PList cmp []) = PList cmp [x]
insert x cmp xs)
| x <= y = cons x ps | otherwise = cons y (insert x ys) where (<=) = lte cmp (y, ys) = detach ps cons x (PList cmp xs) = PList cmp (x:xs) extract (PList cmp (x:xs)) = x discard (PList cmp (x:xs)) = PList cmp xs cmpPath :: Path v -> Path v -> Ordering
cmpPath (Path d _) (Path d’ _) = compare d d’

shortestPaths :: forall g e v. Graph g e v
=> g -> v -> [Path e]
shortestPaths g v = dijkstra g (vertices g \\ [v]) ps where
ps :: PList (Path e)
ps = toPQueue cmpPath (map pathFromEdge (edgesFrom g v))

example3 :: GameState
example3 = GameState planets wormholes fleets where
planets = M.fromList
[ (PlanetId 0, Planet (Owned Player1) (Ships 300) (Growth 0))
, (PlanetId 1, Planet Neutral (Ships 200) (Growth 50))
, (PlanetId 2, Planet Neutral (Ships 150) (Growth 10))
, (PlanetId 3, Planet Neutral (Ships 30) (Growth 5))
, (PlanetId 4, Planet Neutral (Ships 100) (Growth 20))
, (PlanetId 5, Planet Neutral (Ships 100) (Growth 20))
wormholes = M.fromList
[ (WormholeId 0, Wormhole homePlanet (Target 1) (Turns 1))
, (WormholeId 1, Wormhole homePlanet (Target 2) (Turns 2))
, (WormholeId 2, Wormhole homePlanet (Target 3) (Turns 3))
, (WormholeId 3, Wormhole homePlanet (Target 4) (Turns 4))
, (WormholeId 4, Wormhole (Source 4) (Target 5) (Turns 1))
, (WormholeId 5, Wormhole (Source 2) (Target 5) (Turns 1))
] where homePlanet = Source 0
fleets = []

dijkstra :: forall g e v pqueue.
(Graph g e v, PQueue pqueue) =>
g -> [v] -> pqueue (Path e) -> [Path e]
dijkstra g [] ps = []
dijkstra g us ps
| isEmpty ps = []
| t `elem` us =
let us’ :: [v]
us’ = undefined
ps” :: pqueue (Path e)
ps” = undefined
in p : dijkstra g us’ ps”
| otherwise = dijkstra g us ps’
(p, ps’) = detach ps
t = target p

data Heap a = Heap (a -> a -> Ordering) (Tree a)
data Tree a = Nil | Node Int (Tree a) a (Tree a)

rankTree :: Tree a -> Int
rankTree Nil = 0
rankTree (Node h l x r) = h

rankHeap :: Heap a -> Int
rankHeap (Heap _ t) = rankTree t

node :: Tree a -> a -> Tree a -> Tree a
node l x r
| hl < hr = Node (hl + 1) r x l | otherwise = Node (hr + 1) l x r hl = rankTree l hr = rankTree r mergeHeap :: Heap a -> Heap a -> Heap a
mergeHeap (Heap cmp l) (Heap _ r) = Heap cmp (mergeTree cmp l r)

mergeTree :: (a -> a -> Ordering) -> Tree a -> Tree a -> Tree a
mergeTree cmp l r = undefined

instance PQueue Heap where
priority :: Heap a -> (a -> a -> Ordering)
priority = undefined

empty :: (a -> a -> Ordering) -> Heap a
empty p = undefined

isEmpty :: Heap a -> Bool
isEmpty = undefined

insert :: a -> Heap a -> Heap a
insert = undefined

extract :: Heap a -> a
extract = undefined

discard :: Heap a -> Heap a
discard = undefined

shortestPaths’ :: forall g e v . Graph g e v
=> g -> v -> [Path e]
shortestPaths’ g v = dijkstra g (vertices g \\ [v]) ps where
ps :: Heap (Path e)
ps = foldr insert (empty cmpPath)
(map pathFromEdge (edgesFrom g v))

newtype AdjList e v = AdjList [(v, [e])]

instance (Eq e, Edge e v) =>
Graph (AdjList e v) e v where
vertices (AdjList ves) = undefined
edges (AdjList ves) = undefined
edgesFrom (AdjList ves) s = undefined
edgesTo (AdjList ves) t = undefined
velem v (AdjList ves) = undefined
eelem e (AdjList ves) = undefined

conflictZones :: GameState -> PlanetId -> PlanetId
-> ([PlanetId], [PlanetId], [PlanetId])
conflictZones st p q = undefined

deriving instance Eq Player
deriving instance Show Player
deriving instance Read Player
deriving instance Generic Player
instance B.Binary Player
deriving instance Eq Owner
deriving instance Show Owner
deriving instance Read Owner
deriving instance Generic Owner
instance B.Binary Owner
deriving instance Show Planet
deriving instance Read Planet
deriving instance Generic Planet
instance B.Binary Planet
deriving instance Show Fleet
deriving instance Read Fleet
deriving instance Generic Fleet
instance B.Binary Fleet

deriving instance Show Wormhole
deriving instance Read Wormhole
deriving instance Eq Wormhole
deriving instance Generic Wormhole
instance B.Binary Wormhole

deriving instance Show Order
deriving instance Read Order
deriving instance Generic Order
instance B.Binary Order
deriving instance Show GameState
deriving instance Read GameState
deriving instance Generic GameState
instance B.Binary GameState

deriving instance Id
deriving instance Eq PlanetId
deriving instance Num PlanetId
deriving instance B.Binary PlanetId
instance Show PlanetId where
show (PlanetId x) = show x
instance Read PlanetId where
readsPrec = coerce (readsPrec @Int)

deriving instance
deriving instance Eq Turns
deriving instance Num Turns
deriving instance B.Binary Turns
instance Show Turns where
show (Turns x) = show x
instance Read Turns where
readsPrec = coerce (readsPrec @Int)

deriving instance
deriving instance Eq Source
deriving instance B.Binary Source
instance Show Source where
show (Source x) = show x
instance Read Source where
readsPrec = coerce (readsPrec @Int)

deriving instance Num Growth
deriving instance
deriving instance Eq Growth
deriving instance B.Binary Growth
instance Show Growth where
show (Growth x) = show x
instance Read Growth where
readsPrec = coerce (readsPrec @Int)

deriving instance Ix Ships
deriving instance Num Ships
deriving instance
deriving instance Eq Ships
deriving instance B.Binary Ships
instance Show Ships where
show (Ships x) = show x
instance Read Ships where
readsPrec = coerce (readsPrec @Int)

deriving instance
deriving instance Eq Target
deriving instance B.Binary Target
instance Show Target where
show (Target x) = show x
instance Read Target where
readsPrec = coerce (readsPrec @Int)

deriving instance Eq WormholeId
deriving instance Id
deriving instance B.Binary WormholeId
instance Show WormholeId where
show (WormholeId x) = show x
instance Read WormholeId where
readsPrec = coerce (readsPrec @Int)

deriving instance Eq e => Eq (Path e)
deriving instance Read e => Read (Path e)
deriving instance Show e => Show (Path e)
instance Show a => Show (PList a) where
show (PList _ xs) = show xs

deriving instance Generic PlanetId
deriving instance Generic WormholeId
deriving instance Generic Ships
deriving instance Generic (Path a)

instance NFData PlanetId
instance NFData Order
instance NFData WormholeId
instance NFData Ships
instance NFData a => NFData (Path a)

deriving instance Eq a => Eq (Tree a)
instance Eq a => Eq (Heap a) where
(Heap _ h1) == (Heap _ h2) = h1 == h2
deriving instance Generic (Heap a)
instance NFData a => NFData (Heap a)
deriving instance Generic (Tree a)
instance NFData a => NFData (Tree a)

deriving instance (Show a, Show b) => Show (AdjList a b)

程序代写 CS代考 加微信: powcoder QQ: 1823890830 Email: powcoder@163.com