12
\$\begingroup\$

Your job, for this golf, is to write a program that will take moves of a game of reversi (othello) and display the result to the user.

Input

A string of numbers taken from the range [0-7]. Each pair of numbers represent first the X coordinate, then the Y coordinate. Any characters not in that range should be ignored.

Output

A visual representation of the result of the game, including who is leading when the input ends. This may be graphical or keystroke output, but it must be a visual grid of the game, with a distinct character/graphical symbol for black, white, and empty.

Additionally, your code should output an error message and stop when an illegal move is entered (the same square more than once, or a square that will not flip any tiles).

Skips should be handled gracefully. A skip occurs when one color has no legal move, their turn is skipped and the other player gets to play.

Black always goes first.

Examples

23
........
........
........
..bbb...
...bw...
........
........
........
b

232425140504032627
........
........
........
b.bbb...
bbbww...
b.b.....
..b.....
..b.....
b

2324322513
........
........
........
..bbb...
..www...
........
........
........
e

23242555
........
........
........
..bbb...
..bbw...
..b.....
........
........
e
\$\endgroup\$
  • \$\begingroup\$ How can you tell from what point the piece moved? in your first example there is only 1 possibility, but is it safe to assume there is always 1 possibility? \$\endgroup\$ – Teun Pronk Mar 3 '14 at 15:31
  • \$\begingroup\$ I'm sorry I don't understand the question \$\endgroup\$ – durron597 Mar 3 '14 at 15:34
  • 3
    \$\begingroup\$ @TeunPronk in reversi no piece is moved. Each player takes turn adding pieces to the board. I assume that should answer your question. \$\endgroup\$ – shiona Mar 3 '14 at 18:42
  • \$\begingroup\$ How are we supposed to interpret more than one pair of numbers? \$\endgroup\$ – golfer9338 Apr 17 '14 at 20:21
  • \$\begingroup\$ If an illegal move is entered, must we display the state of the field at the last valid move, or is it enough to just display an error message? \$\endgroup\$ – marinus Jun 7 '14 at 18:21
2
\$\begingroup\$

Haskell - 1493 bytes

In this version, there are no detailed error messages and the output is much more basic. The major change was replacing Either String a with Maybe a and since they are both monads, this was acheived by simply swapping Right a with Just a and Left String with Nothing.

{-# LANGUAGE OverloadedStrings #-}
import Prelude hiding ((>>=),concatMap,filter,foldl,head,last,map,null,replicate)
import Control.Applicative hiding (empty)
import Control.Monad hiding (replicateM)
import Data.Vector hiding ((++),concat,foldM,reverse,zip)
main=getLine>>= \s->h$t<$>(zip$cycle[w,v])<$>b s>>= \m->u(\b(c,x)->case d b x c of r@(Just _)->r;Nothing->if not$null$findIndices(\y->e$d b y c)$t[(x,y)|x<-[0..7],y<-[0..7]];then é;else d b x$not c)k$n m
 where b(x:y:s)=(:)(read [x],read [y])<$>b s;b(_:_)=é;b[]=è[];d b z c=let d=join$m(f b z c)$m(\v->(head v,last v))$replicateM 2$t[-1,0,1];in if null d;then Nothing;else u(\b (x,y)->case b!?y of Just r->(case r!?x of Just _->è$b//[(y,r//[(x,è c)])];Nothing->é);Nothing->é)b$n$d`snoc`z;e(Nothing)=w;e(Just _)=v;f b(x,y)c z@(u,v)=let r=x+u;s=y+v;t=(r,s);in (case g b t of Just(Just d)->if d==c;then l;else (case g b (r+u,s+v) of Just(Just _)->t`cons`f b t c z;_->l);Just(Nothing)->l;Nothing->l);g b(x,y)=(case b!?y of Just col->col!?x;Nothing->é);h(Just b)=p$(o$n$m(\r->o(n$m(\c->case c of Just False->"B";Just True->"W";Nothing->".")r)++"\n")b)++i(q(\(w,b)(rw,rb)->(w+rw,b+rb))(0,0)$m(\r->q(\s@(w,b)c->case c of Just True->(w+1,b);Just False->(w,b+1);_->s)(0,0)r)b);h Nothing=p"e";i(w,b)|w>b="W"++s w|b>w="B"++s b|v="N"++s(w+b);j=r 8 é;k=r 8 j//[(3,j//[(3,è v),(4,è w)]),(4,j//[(3,è w),(4,è v)])];l=empty;m=map;n=toList;o=concat;p=putStrLn;q=foldl;r=replicate;s=show;t=fromList;u=foldM;v=True;w=False;é=Nothing;è=Just
$ printf "232425140504032627" | ./nano-rve 
........
........
........
B.BBB...
BBBWW...
B.B.....
..B.....
..B.....
B11

Original version - 4533 bytes

I will golf when there will be competition! edit It has arrived

{-# LANGUAGE OverloadedStrings #-}
import Prelude hiding ((>>=),concatMap,filter,foldl,map,null,replicate)
import Control.Applicative hiding (empty)
import Control.Monad
import Data.Either
import Data.Vector hiding ((++),concat,foldM,reverse,zip)

type Case = Maybe Bool
type Board = Vector (Vector Case)
type Coord = (Int,Int)

-- fmap (toList) $ replicateM 2 [-1,0,1] -- minus (0,0)
directions :: Vector Coord
directions = fromList [(-1,-1),(-1,0),(-1,1),(0,-1),(0,1),(1,-1),(1,0),(1,1)]

--  [(x,y) | x <- [0..7], y <- [0..7]]
allCoords :: Vector Coord
allCoords = fromList [(0,0),(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,7),(1,0),(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(1,7),(2,0),(2,1),(2,2),(2,3),(2,4),(2,5),(2,6),(2,7),(3,0),(3,1),(3,2),(3,3),(3,4),(3,5),(3,6),(3,7),(4,0),(4,1),(4,2),(4,3),(4,4),(4,5),(4,6),(4,7),(5,0),(5,1),(5,2),(5,3),(5,4),(5,5),(5,6),(5,7),(6,0),(6,1),(6,2),(6,3),(6,4),(6,5),(6,6),(6,7),(7,0),(7,1),(7,2),(7,3),(7,4),(7,5),(7,6),(7,7)]


initBoard :: Board
initBoard = vs // [(3,v1),(4,v2)]
    where va = replicate 8 Nothing
          v1 = va // [(3,Just True),(4,Just False)]
          v2 = va // [(3,Just False),(4,Just True)]
          vs = replicate 8 va

showBoard :: Board -> String
showBoard b = (concat $ toList $ map (showRow) b) ++ (showScore b)
    where showCase :: Case -> String
          showCase c = case c of 
              Just False -> "░B"
              Just True -> "▓W"
              Nothing -> "██"
          showRow :: Vector Case -> String
          showRow r = concat (toList $ map (showCase) r) ++ "\n"

showScore :: Board -> String
showScore b = winner score ++ "\n"
    where scoreCase :: (Int,Int) -> (Maybe Bool) -> (Int,Int)
          scoreCase (w,b) (Just True) = (w+1,b)
          scoreCase (w,b) (Just False) = (w,b+1)
          scoreCase s _ = s
          scoreRow :: Vector Case -> (Int,Int)
          scoreRow r = foldl (scoreCase) (0,0) r
          score :: (Int,Int)
          score = foldl (\(w,b) (rw,rb) -> (w+rw,b+rb)) (0,0) $ map (scoreRow) b
          winner :: (Int,Int) -> String
          winner (w,b) | w > b = "White with " ++ show w ++ " against Black with " ++ show b ++ "."
                       | b > w = "Black with " ++ show b ++ " against White with " ++ show w ++ "."
                       | otherwise = "Nobody with " ++ show (w+b) ++ "."

printBoard :: Board -> IO ()
printBoard b = putStrLn $ showBoard b
pm :: Either String Board -> IO ()
pm (Right b) = printBoard b
pm (Left s)  = putStrLn s

lookupBoard :: Board -> Coord -> Either String Case
lookupBoard b (x,y) = case b !? y of
    Just col -> case col !? x of
        Just c -> Right c
        Nothing -> Left "x is out of bounds"
    Nothing -> Left "y is out of bounds"

updateBoard :: Board -> Coord -> Bool -> Either String Board
updateBoard b (x,y) c = case b !? y of
    Just r -> case r !? x of
        Just _ -> Right $ b // [(y,r // [(x,Just c)])] 
        Nothing -> Left "x is out of bounds"
    Nothing -> Left "y is out of bounds"

makePath :: Board -> Coord -> Bool -> Coord -> Vector Coord
makePath b (x,y) c (px,py) = case lookupBoard b (nx,ny) of
        Right (Just pc) -> if pc == c
            then empty
            else case lookupBoard b (nx+px,ny+py) of
                Right (Just _) -> (nx,ny) `cons` makePath b (nx,ny) c (px,py)
                _ -> empty
        Right (Nothing) -> empty
        Left _ -> empty
    where nx = x+px
          ny = y+py

makeMove :: Board -> Coord -> Bool -> Either String Board
makeMove b xy@(x,y) c = if null cases 
        then Left $ "impossible move " ++ show xy ++ "."
        else foldM (\ob (cx,cy) -> updateBoard ob (cx,cy) c) b $ toList $ cases `snoc` (x,y)
    where cases = join $ map (makePath b (x,y) c) directions

makeMoves :: Board -> Vector (Bool,Coord) -> Either String Board
makeMoves b ms = foldM (\ob (c,xy) -> case makeMove ob xy c of
    rb@(Right _) -> rb
    Left _ -> if not $ null $ findIndices (\xy -> isRight $ makeMove ob xy c) allCoords
        then Left $ "wrong move " ++ show xy ++ "."
        else makeMove ob xy (not c)) b $ toList ms


movesFromString :: String -> Either String (Vector (Bool,Coord))
movesFromString cs = fromList <$> (zip $ cycle [False,True]) <$> coords cs
    where coords (x:y:cs) = (:) (read [x],read [y]) <$> coords cs
          coords (_:cs) = Left "invalid coordinates string"
          coords [] = Right []

isRight :: Either a b -> Bool
isRight (Left _) = False
isRight (Right _) = True

main=getLine>>= \s->pm$movesFromString s>>=makeMoves initBoard

Note : Your second example should be 232425140504032627.

Tests

With screenshots to prevent eye burns.

$ printf "232425140504032627" | ./rve

test 1

$ printf "2324" | ./rve

test 2

$ printf "1" | ./rve
invalid coordinates string
$ printf "24" | ./rve
wrong move (2,4).

Is is possible to get impossible move (x,y) when you use innardics (functions from the innards of the program and that you should not use) and x/y is out of bounds.

\$\endgroup\$
1
\$\begingroup\$

Javascript (E6) 399 412 450

Edit: board display shorter and nicer, cut some char

V=(p,b)=>b[p]==(r=0)&&[1,8,9,10].map(d=>r|=(A=(p,d,c=0)=>b[p+=d]==-v?A(p,d,1)&&(b[p]=v):c&b[p]==v)(p,d)|A(p,-d))|r&&(b[p]=v)
L=console.log
l=prompt().replace(/[^0-7]/g,'')
for(i=B=[];++i<73;)B[i]=i%9?i-31&&i-41?i-32&&i-40?0:1:-1:-B
for(v=i=1;l[i];i+=2,v=-v)V(p=l[i]*9+-~l[i-1],B)||!B.some((x,i)=>V(i,[...B]))&&(V(p,B,v=-v))||L(l='Err')
t=0,L(B.map(x=>(t+=~~x,'\nO ☻'[x+2|0]))+(t?t<0?'O':'☻'+t:'='))

Ungolfed

V = (p, b) =>      // Verify a move and if it is legal, apply the move to the board
b[p]==(r=0) &&     // check if empty cell and init accumulator r
[1,8,9,10].map(d=> // Execute flip check for each of 4 positive direction (and 4 negative too)
  r |= (            
  A=(p,d,c=0) =>   // Recursive function for flip check, if find it valid modify the board during return phase
  b[p+=d] == -v    // If position contains a disk of other color
   ? A(p,d,1) && (b[p]=v) // recursive call. Then if returns true, set the cell in the flip sequence
   : c & b[p]==v   // at end of check, if find the righe disk and if not the first call, return true
  )                // Definition of A function ends here
  (p,d)|A(p,-d)    // Call A 2 times with d and -2 to get all 8 directions
) | r              // now, r is true if any of the 8 flip checks has gone well
&& (b[p]=v);       // if true, set the verified cell too

L=console.log;

l=prompt().replace(/[^0-7]/g,'');            // Get input & discard invalid chars

for (i=B=[];++i<73;) // Create empty board as a single dimension array, NaN mark a row end
  B[i] = i%9 
    ? i-31 && i-41 
      ? i-32 && i-40 
        ? 0: 1: -1: -B //starting values at center, -B evaluate to NaN

for(v=i=1;    // v is the disk color, init to 1 == black
  l[i];       // repeat while inside input string
  i+=2, v=-v) // to char of input at time, set color to opposite
    V( p=l[i]*9+-~l[i-1], B)      // calc position in p from the input, and call Verify
    ||                            // if not valid, could be Error or Skip
      !B.some((x,i)=>V(i,[...B])) // Check if there are no moves for the current color, for each cell call V on a copy of the board
      &&
      (V(p,B,v=-v)) // If no moves found, try to apply the move for the opposite color
    ||
      L(l='Err');   // If failed, it is Error. Change variable l to end the loop

t=0, // Display the board while counting disk difference into 't'
L( 
  B.map(x=>(t+=~~x,'\nO ☻'[x+2|0])) // map array elements to suitable chars, then auto conversion to string give a nice effect
  + (t?t<0?'O':'☻'+t:'=')
) // Display leading and count difference or '='

Test

Test in javascript console (FireFox): 232425140504032627 , , , , , , , , , , , , , , , , , , , , , , , , , , , ,☻, ,☻,☻,☻, , , , ,☻,☻,☻,O,O, , , , ,☻, ,☻, , , , , , , , ,☻, , , , , , , , ,☻, , , , , , ☻9

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.