can this be written more easily?

Mike T. Machenry dskippy@ccs.neu.edu
Fri, 21 Feb 2003 13:37:26 -0500


Eh, state is not possible. This is a recursive state space search. I need
to branch the state of the game and not allow branches to effect others.
Though I'd really like to represent them as arrays like such:

data Player = Red | Green | Blue deriving (Enum,Eq,Ix)
data Ticket = Taxi | Bus | Underground deriving (Enum,Eq,Ix)
type Tickets = Array Player (Array Ticket Int)

Arrays in Haskell just might be too painful to to this with and I'll have to
use lists. They'er easier to use, but I don't believe they match the data
as closly.

-mike

On Fri, Feb 21, 2003 at 12:50:11PM -0500, Dean Herington wrote:
> [moved to haskell-cafe]
> 
> While I largely agree with what Nils said, it does seem that arrays are a good match
> for your application.  It is true, unfortunately, as you're discovering, that
> mutable arrays are awkward in a pure functional language.  I think the most
> appropriate way to deal with them would depend on the larger perspective of your
> application's control structure.  If the array manipulation is necessarily
> intermixed with input/output, for example, you might consider an essentially
> imperative approach using `IOArray`s in the `IO` monad.  If the input/ouput and
> array manipulation tend to alternate, `STArray`s in the `ST` monad might offer a
> more functional approach.  If the amount of array manipulation is small, then the
> approach you've shown so far might be entirely adequate.
> 
> Dean
> 
> 
> "Mike T. Machenry" wrote:
> 
> >   I guess I figured that Arrays were the natural data type for the tickets
> > since it has a fixed size and the elements all have a specific player
> > associated with them. I am coming from a Scheme background so I am already
> > very fluent in list manipulation. I'm not an imperative programer, so that's
> > not really the problem. I just think that Arrays represent this data much
> > better.
> >
> > -mike
> >
> > On Fri, Feb 21, 2003 at 01:00:30PM +0100, Nils Decker wrote:
> > > "Mike T. Machenry" <dskippy@ccs.neu.edu> wrote:
> > > > Hey Everyone,
> > > >
> > > >   I am having a hard time making a data structure that I can
> > > >   incrimentally
> > > > update. Mostly because dealing with arrays is so tough. Does anyone
> > > > think I'm going about this completely the wrong way? This is what I
> > > > have.
> > > IMO there is normally no need to use arrays in haskell. You should
> > > use lists instead, because it is much more easy to use recursion
> > > over lists. Once you got the pattern, it feels like the natural
> > > way in haskell.
> > > It also helps to define more types than just one large type for everything.
> > >
> > > > data GameState = GameState {
> > > >   dTickets   :: Array Player (Array Ticket Int),
> > > >   fTickets   :: Array FugitiveTicket Int,
> > > >   history    :: [Move],
> > > >   dLocations :: Array Player Stop,
> > > >   fLocations :: Set Stop
> > > > }
> > > >
> > > > removeTicket :: GameState -> Detective -> Ticket -> GameState
> > > > removeTicket s d t =
> > > >   s { tickets = (tickets s) // [(d,[(t,((tickets s)!d!t - 1))])] }
> > >
> > > why not use
> > >
> > > data Ticket = Ticket Int {-value-} deriving (Eq, Show)
> > > type Tickets = [Ticket]
> > >
> > > removeTicket :: Ticket -> Tickets -> Tickets
> > > removeTicket _ [] = fail "not there"
> > > removeTicket x (t:ts)
> > >   | x == t    = ts
> > >   | otherwise = t : (removeTicket x ts)
> > >
> > > Is there a reason, to have different fields and types for detectives?
> > > data PlayerNames = MrX | Red | Green | Blue deriving (Eq,Show)
> > > If MrX needs special treatment ( computed move or information shown
> > > to the player ) you can patternmatch for MrX. For the usage of tickets
> > > and the history of moves there should be no difference.
> > >
> > > There might even be no reason to have PlayerNames as instance of enum.
> > > As i understand, you want to use succ(player) to find the next player
> > > to move.  It can be easier to have a function that recurses over a
> > > list of players to run one round.
> > >
> > > > This remove ticket function is just terrible and it's common for me to
> > > > have to do operations like this. It's been hard to make this a
> > > > function that I can pattern match on, because which piece of data is
> > > > manipulated depends on the parmeter d (Detective)
> > > Just split up the huge record and have tiny functions to deal with
> > > every specific part of it
> > >
> > > Summary in a few words: Use many small functions instead of a few
> > > big ones. Use lists instead of arrays. If you use arrays, first understand
> > > why you can not use lists in that specific case. Learn to recurse
> > > over lists! Learn to use map, foldl and foldr. They save you a lot of
> > > typing and make most functions dealing with lists short and clear.
> > >
> > > You should derive Show for all your types and test every new function
> > > in hugs or ghci.
> > >
> > > Regards
> > >   Nils Decker
> > >
> > > PS: I have learned haskell a year ago after using imperative languages
> > >     all of my life. At first it is hard to get used to some concepts,
> > >     but then they are wonderful.
> > >
> > > PPS: There is another list called haskell-cafe. It is used for discussion
> > >      of problems while this list is meant for short threads and announcements.
> > >      You might want to subscribe to it.
> > >
> > >
> > > --
> > > Freedom of speech is wonderful - right up there with the freedom
> > > not to listen.
> > >
> > > Nils Decker <nils@ndecker.de>
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe