Any decent solution would handle that anyway, with a little modification. No, I wanted to keep this one simple. Limiting the programs function to solving the problem and outputting a solution seemed like a good way to avoid forcing people to write a whole bunch of messy IO code.

--- Thad ---
developer of ... ?
[ Parent ]

This is supposed to be easy to solve so anyone can enter. It'll be the subjective quality of the solution that will decide the winner. :D

--- Thad ---
developer of ... ?
[ Parent ]

See this comment for details.

--- Thad ---
developer of ... ?
[ Parent ]

program Swapsy;

{$APPTYPE CONSOLE}
Uses SysUtils;

Type
    TPoint= Record
    x,y: Integer;
    end;

procedure Output(APoint: TPoint; colour: char);
begin
writeln(format('%S %D,%D', [colour, APoint.X, APoint.y]));
end;

var
     Board: Array [1..5,1..5] of Integer;
     PointsToFill: Array [0..24] of TPoint;
     TmpPoint: TPoint;
     SwapWith: Integer;
     i: Integer;

     function EmptyNeighbours(APoint: TPoint): Integer;
     begin
     Result := 0;
     if APoint.x > 1 then
         begin
         Result := Result + (Board[APoint.x - 1,APoint.y]);
         end;
     if APoint.y > 1 then
         begin
         Result := Result + (Board[APoint.x,APoint.y - 1]);
         end;
     if APoint.x < 5 then
         begin
         Result := Result + (Board[APoint.x + 1,APoint.y]);
         end;
     if APoint.y < 5 then
         begin
         Result := Result + (Board[APoint.x,APoint.y + 1]);
         end;
     end;

begin
for i := 0 to 24 do
    begin
    PointsToFill[i].x := (i mod 5) + 1;
    PointsToFill[i].y := (i div 5) + 1;
    end;

for i := 24 downto 1 do
    begin
    TmpPoint := PointsToFill[i];
    SwapWith := Random(i + 1);
    PointsToFill[i] := PointsToFill[SwapWith];
    PointsToFill[SwapWith] := TmpPoint;
    end;
for i := 0 to 24 do
    begin
    if EmptyNeighbours(PointsToFill[i]) mod 2 = 1 then
        begin
        Output(PointsToFill[i], 'B');
        end
    else
        begin
        Output(PointsToFill[i], 'R');
        end;
    Board[PointsToFill[i].x, PointsToFill[i].y] := 1;
    end;
end.







should compile with Free pascal compiler (http://www.freepascal.org/) though it's not tested. All it does is add in a random order the appropriate colour depending on whether the sqare it is adding to has an odd or even number of empty neighbours!

Rock Hard Abs are just a sw-sw-swivel away!
[ Parent ]

1. No. I expect I will be testing on an iMac, so availability may be an issue, in which case I will do my best to accommodate.
2. Yes.
3. No. Placing a counter flips directly adjacent counters. No diagonals, no chains.

--- Thad ---
developer of ... ?
[ Parent ]

-
Metus amatores matrum compescit, non clementia.
[ Parent ]

Diagonals are not adjacent.

--- Thad ---
developer of ... ?
[ Parent ]

couldn't you just start with the board you want at the end (i.e. all red), take away tokens one at a time recording their colours and flipping properly, until you're left with an empty board? Or is that what you mean by "against the spirit"? In any case, here is my entry which does just that (output has to be piped through tac :)

#include <stdio.h>
#include <string.h>

char* flip(char* board, int n)
{
    if (board[n] == 'R')
        board[n] = 'B';
    else if (board[n] == 'B')
        board[n] = 'R';
    return board;
}

char* fxy(char* board, int x, int y)
{
    if (x < 0) return board;
    if (x >= 5) return board;
    if (y < 0) return board;
    if (y >= 5) return board;
    return flip(board, y * 5 + x);
}

char* go(char* board, int n)
{
    int x, y;
    x = n % 5;
    y = n / 5;
    printf("%c %d,%d\n", board[n], x + 1, y + 1);
    board[n] = '-';
    fxy(board, x - 1, y);
    fxy(board, x + 1, y);
    fxy(board, x, y - 1);
    fxy(board, x, y + 1);
    return board;
}

void main(void)
{
    int i;
    char* p;
    char board[26] = "RRRRRRRRRRRRRRRRRRRRRRRRR";

    while (strcmp(board, "-------------------------")) {
/*      printf("%s\n", board);*/
        if ((p = strchr(board, 'R')) == NULL)
            p = strchr(board, 'B');
        go(board, p - board);
    }
}


--
<ni> komet: You are functionally illiterate as regards trashy erotica.
[ Parent ]

/* bcpfc.c
 * by Ben Campbell
 */

#include <stdio.h>

int main( int argc, char* argv[] )
{
    int w,h,x,y,right,below;

    /* index this with empty-neighbour-count to get move */
    const char lookup[3] = "RBR";

    /* cmdline parsing */
    if( argc<3 )
    {
        printf( "usage: bcpfc <width> <height>\n" );
        return 1;
    }
    w = atoi(argv[1]);
    h = atoi(argv[2]);

    /* Make a decision for each position...
     * Our scanning order means that slots above and left are _never_ empty, so
     * we don't even need to check. */
    for( y=1; y<=h; ++y )
    {
        /* always a clear spot below, except on last line */
        below = (y==h) ? 0:1;
        for( x=1; x<=w; ++x )
        {
            /* always a clear spot right, except on last column */
            right = (x==w) ? 0:1;
            printf( "%c %d,%d\n", lookup[ below + right ], x, y );
        }
    }
    return 0;
}


[ Parent ]

I wish I hadn't read your post...


"If we do see stacks of ashtrays," she said, "it is tantamount to the potential that people are permitting smoking." - NYC Health Inspector
[ Parent ]

My program uses the same idea komet's does: rather than placing pieces on the board until you get the desired end state, start with a complete board at the desired end state and take pieces away until you have none left. This is a simple, clear, no-fuss-no-muss linear-time algorithm. (Technically implementation doesn't take linear time due to a representation choice, but I could easily fix that if scalability were a goal of the problem.)

My solution differs from komet's primarily because my program uses a novel representation of a board as a function that maps x,y coordinates to colors: see the function reverse for the best illustration of that. Due to this representation choice, it's trivial to scale the program to any size board (though it becomes increasingly inefficient), but note the funny quirk that in fact my board representation has a color mapping not just for 1,1 through 5,5 but for any number pair you present it with, and you could think of my loop as removing a 5*5 area from an infinite field of red tiles.

Anyway, here's the program:


(define-values (RED BLACK EMPTY) (values #\R #\B 'empty))
(define-struct move (color h w))
(define (show-move m) (printf "~a ~a,~a\n" (move-color m) (move-h m) (move-w m)))


(define init-board (lambda (h w) RED))
(define (remove x y b)
  (lambda (x2 y2)
    (cond
      [(and (= x2 x) (= y2 y)) EMPTY]
      [(or
        (and (= x2 (add1 x)) (= y2 y))
        (and (= x2 (sub1 x)) (= y2 y))
        (and (= x2 x) (= y2 (add1 y)))
        (and (= x2 x) (= y2 (sub1 y))))
       (flip (b x2 y2))]
      [else (b x2 y2)])))


(define (flip c)
  (cond
    [(eq? c RED) BLACK]
    [(eq? c BLACK) RED]
    [(eq? c EMPTY) EMPTY]))


(define (solve board)
  (define (outer i b)
    (cond
      [(> i 5) '()]
      [else (inner i 1 b)]))
  (define (inner i j b)
    (cond
      [(> j 5) (outer (add1 i) b)]
      [else (cons (make-move (b i j) i j) (inner i (add1 j) (remove i j b)))]))
  (reverse (outer 1 board)))
 

(for-each show-move (solve init-board))


Runs in PLT Scheme, probably any version in the last 10 years, but certainly in version 200+. Just open it in DrScheme and hit execute.

--

[ Parent ]

The tree depth is 25. The branching factor is always less than 50, and getting smaller with every move. Roughly 3/4 of the search space is redundant. I've not tried it, but I think a dumb depth first search would find a solution fairly quickly.

Of course, this claim rests on my definition of "fairly quickly".

The the point is moot since two signficantly better solutions have already been posted.

--- Thad ---
developer of ... ?
[ Parent ]

This one generates a random valid solution every time it's executed. It works on an odd/even principle: select an unoccupied square at random, and if it has an even number of occupied squares surrounding it put a red token there; otherwise put a black token there. This works because every square with an even number of unoccupied squares will in the course of the rest of the game be flipped an even number of times and therefore will end up the same color it started; the opposite is true for squares with an odd number of unoccupied neighbors.


(require (lib "1.ss" "srfi"))
(define HEIGHT 5)
(define WIDTH 5)


(define-struct move (color h w))
(define (show-move m) (printf "~a ~a,~a\n" (move-color m) (add1 (move-h m)) (add1 (move-w m))))
(define (randomly-select l)
  (let ((i (random (length l))))
    (values (list-ref l i) (append (take l i) (drop l (add1 i))))))
(define (neighbors p)
  (let ((x (car p))
        (y (cadr p)))
    (list (list x (add1 y))
          (list x (sub1 y))
          (list (add1 x) y)
          (list (sub1 x) y))))

(define (num-open-neighbors p b) (apply + (map b (neighbors p))))
(define (color-for-square p b) (if (even? (num-open-neighbors p b)) #\R #\B))
(define (place p b) (lambda (p2) (if (equal? p p2) 0 (b p2))))

(define (solve board)
  (define unplaced
    (let loop ((i 0) (j 0))
      (cond
        [(>= i HEIGHT) '()]
        [(>= j WIDTH) (loop (add1 i) 0)]
        [else (cons (list i j) (loop i (add1 j)))])))
  (define (place-pieces ps b)
    (cond
      [(null? ps) '()]
      [else
       (let-values ([(point rest) (randomly-select ps)])
         (cons (apply make-move (color-for-square point b) point)
               (place-pieces rest (place point b))))]))
  (place-pieces unplaced board))

(define initial-board
  (lambda (p)
    (let ((x (car p)) (y (cadr p)))
      (if (and (>= x 0) (>= y 0) (< x HEIGHT) (< y WIDTH))
          1
          0))))

(for-each show-move (solve initial-board))

Again, to run copy this code into DrScheme and hit execute.

--

[ Parent ]

Haskell is very pretty. This one gives back the same answer every time, but compared to the Scheme version I think it's much much prettier.

type Point = (Int,Int)
type Board = Point -> Bool
data Color = Red | Black

neighbors                :: Point -> [Point]
neighbors (x,y)          = [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]

numOpenNeighbors         :: Point -> Board -> Int
numOpenNeighbors p b     = sum (map (\ p -> if (b p) then 1 else 0) (neighbors p))

colorForPoint            :: Point -> Board -> Color
colorForPoint p b        = if even (numOpenNeighbors p b) then Red else Black

place                    :: Point -> Board -> Board
place p b                = (\ p' -> if p' = p then False else b p')

solve                    :: [Point] -> Board -> [(Color,Point)]
solve  []    b           = []
solve (p:ps) b           = ((colorForPoint p b),p):(solve ps (place p b))

initialBoard             :: Int -> Int -> Board
initialBoard h w (x,y)   = x > 0 && y > 0 && x < h && y <= w

toStr  []                = ""
toStr ((Red,  (x,y)):ms) = "R "++(show x)++","++(show y)++"\n"++(toStr ms)
toStr ((Black,(x,y)):ms) = "B "++(show x)++","++(show y)++"\n"++(toStr ms)

main = putStr (toStr (solve [(x,y) | x <- [1..5], y <- [1..5]] (initialBoard 5 5)))


To run, save the code to a file called flip.hs, then download and install GHC and compile with ghc flip.hs. Then ./a.out will print the answer for you.

--

[ Parent ]

I have a complete hash- and tree- based version built. Then they go and solve it in 30 lines!


"If we do see stacks of ashtrays," she said, "it is tantamount to the potential that people are permitting smoking." - NYC Health Inspector
[ Parent ]

Post an entry!
--
smart, pretty, sane. pick two - georgeha
[ Parent ]

program MostlyRed;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
    Height, Width, Tmp, i: Integer;
    lineswritten: Integer = 0;
    OrientationFormat: String = '%0:D %1:D %2:S';

    procedure output(x,y: Integer; colour: Char);
    begin
    writeln(format(OrientationFormat, [x, y, Colour]));
    inc(linesWritten);
    end;

begin
Width := 5;
Height := 5;

//add width and Height Params to change board size...
if ParamCount >= 2 then
    begin
    width := StrToInt(Paramstr(1));
    Height := StrToInt(Paramstr(2));
    end;

if Height > Width then
    begin
    Tmp := Width;
    Width := Height;
    Height := Tmp;
    OrientationFormat := '%1:D %0:D %2:S';
    end;

while Height > 1 do
    begin
    for i := 1 to Height - 1 do
        begin
        output(Width, i, 'R');
        end;
    for i := 1 to Width do
        begin
        output(i, Height, 'R');
        end;
    Dec(Height);
    Dec(Width);
    end;

//If we are left with an even strip then we need to add one black cell to get an odd one
if width mod 2 = 0 then
    begin
    output(width, 1, 'B');
    Dec(Width);
    end;

i := 2;
while i <= width do
    begin
    output(i, 1, 'R');
    inc(i,2);
    end;

i := 1;
while i <= width do
    begin
    output(i, 1, 'R');
    inc(i,2);
    end;

//was just a check so I could at least x*y moves had been made...
//writeln(linesWritten);
end.


Rock Hard Abs are just a sw-sw-swivel away!
[ Parent ]

(defun xor (a b)
  (if a (not b) b))

(defun character-code(boolean)
  (if boolean #\B #\R))

(defun print-out-solution (&optional (board-width 5)
                     (board-height 5))
  (loop for i from 1 to board-height do
    (loop for j from 1 to board-width do
      (format t "~c ~d,~d~%"
          (character-code
           (xor (= i board-height);bottom row
            (= j board-width)));right-hand column
          i j))))

[ Parent ]

#include <stdio.h>
#define NUM 5
main()
{
    int i,j;
    for (i=1;i<NUM+1;i++)
       for(j=1;j<NUM+1;j++)
          printf("%c %d,%d \n",((i<NUM)+(j<NUM))%2?'B':'R',i,j);
}


[ Parent ]

by inviting either winner to host the next PFC?

--

[ Parent ]

And more thanks for stepping up and kickstarting the PFCs again!

Had lots of fun dreaming up my only red playing entry, even though I knew it was never going to be a contender...

Hopefully we'll see a follow up pfc posted from Komet soon.

Rock Hard Abs are just a sw-sw-swivel away!
[ Parent ]

--
<ni> komet: You are functionally illiterate as regards trashy erotica.
[ Parent ]