123 Eng

### Engineering the engineers™

Home
Source Codes
Engineering Colleges

Training  Reports
Seminar Reports
Placement Papers

Forums

Computer Science / IT
Electronics
Electrical
Mechanical
Chemical
Civil

CAT / MBA

GMAT / Foreign MBA
Latest Jobs

Displaying  Source Code(s)

 Recursive Monkey Puzzle Solution - Project -------------------------------------------------------------------------------- Description : A recursive solution for a particular form of monkey puzzle called "To The Extreme" by Lagoon Games. There are 523,069,747,249 incorrect combinations - and just one correct combination! Program typically takes 2-3 seconds to solve the puzzle from scratch. //////////////////////////////////////////////////////////////////////////////// // 'To The Extreme' Puzzle - Solved! Copyright © 2005 Maxim C.L. Warne // // // // A recursive solution for 'Professor McBrainy's Zany to the Extreme Puzzle' // // This puzzle is a traditional 'monkey puzzle' - with surfers, skaters etc. // // substituted for the poor monkeys. Its grid is 4x4, giving 529,069,747,249 // // incorrect combinations, and one correct combination. // // // // Usage: Just call TTESolve (2 or 3 seconds on a modern computer), then // // iterate over TTEBoard calling TTEPieceAsText on each element to produce // // human-friendly output. Note that TTEInitialize randomizes the order and // // rotation of the pieces, so TTESolve starts from scratch each time -hence // // the running time of TTESolve varies. // // // // Unit originally authored using Delphi 6, but uses no VCL or OO so should // // port without trouble to just about any flavour of Pascal. // //////////////////////////////////////////////////////////////////////////////// interface type TTTESide = (NULL, SURF_BLACK, SURF_BLONDE, SKATE_GREEN, SKATE_RED , SNOW_GREEN, SNOW_MAUVE , WIND_BLACK , WIND_BLONDE); TTTEPiece = array[0..3] of TTTESide; TTTEPieceList = array[0..15] of TTTEPiece; TTTEPieces = packed record LastPiece: ShortInt; PieceList: TTTEPieceList; end; procedure TTEInitialize; function TTESolve: string; procedure TTERecurrence(MyPieces: TTTEPieces); function TTEPieceFits: Boolean; procedure TTERotatePiece; procedure TTEInsertIntoBoard(var ThePieces: TTTEPieces; const PieceIdx: Integer); procedure TTERemoveFromBoard(var ThePieces: TTTEPieces; const PieceIdx: Integer); function TTEPieceAsText(const ThePiece: TTTEPiece): string; //////////////////////////////////////////////////////////////////////////////// implementation const TTE_3SIDE_SIZE: Integer = SizeOf(TTTESide) * 3; TTE_PIECE_SIZE: Integer = SizeOf(TTTEPiece); TTE_PIECES : TTTEPieces = (LastPiece: 15; PieceList: ((SURF_BLACK , WIND_BLACK , WIND_BLONDE, SKATE_GREEN), (SNOW_GREEN , WIND_BLACK , WIND_BLONDE, SKATE_GREEN), (SURF_BLACK , WIND_BLONDE, WIND_BLACK , SKATE_RED ), (SURF_BLACK , WIND_BLONDE, WIND_BLACK , SURF_BLACK ), (SURF_BLONDE, SURF_BLACK , WIND_BLACK , SKATE_RED ), (WIND_BLONDE, SKATE_GREEN, WIND_BLACK , WIND_BLONDE), (SKATE_GREEN, SNOW_GREEN , WIND_BLACK , WIND_BLONDE), (WIND_BLACK , WIND_BLONDE, WIND_BLACK , SURF_BLONDE), (SURF_BLONDE, SKATE_RED , SURF_BLACK , SURF_BLACK ), (SKATE_GREEN, SURF_BLONDE, SNOW_MAUVE , SKATE_GREEN), (SNOW_MAUVE , SKATE_RED , SNOW_GREEN , SNOW_GREEN ), (SURF_BLACK , WIND_BLONDE, WIND_BLONDE, WIND_BLACK ), (WIND_BLACK , SKATE_RED , WIND_BLONDE, SKATE_GREEN), (SURF_BLACK , WIND_BLACK , WIND_BLONDE, WIND_BLACK ), (SURF_BLACK , WIND_BLACK , WIND_BLONDE, WIND_BLACK ), (SURF_BLACK , SURF_BLACK , WIND_BLONDE, WIND_BLACK ))); var TTEPieces: TTTEPieces; TTEBoard : TTTEPieces; TTESolved: Boolean; //////////////////////////////////////////////////////////////////////////////// procedure TTEInitialize; var LoopA, LoopB, Temp: Integer; begin Randomize; TTESolved := False; TTEPieces := TTE_PIECES; TTEBoard.LastPiece := 0; for LoopA := 0 to 15 do begin repeat Temp := Random(16) until Temp <> LoopA; TTEBoard.PieceList[0] := TTEPieces.PieceList[LoopA]; for LoopB := 1 to Random(4) do TTERotatePiece; TTEPieces.PieceList[LoopA] := TTEPieces.PieceList[Temp]; TTEPieces.PieceList[Temp] := TTEBoard.PieceList[0]; end; TTEBoard.LastPiece := -1; end; function TTESolve: string; var Loop: Integer; begin TTEInitialize; TTERecurrence(TTEPieces); Result := 'Solution ...'#13#10#13#10; for Loop := 0 to 15 do Result := Result + TTEPieceAsText(TTEBoard.PieceList[Loop]) + #13#10; end; procedure TTERecurrence(MyPieces: TTTEPieces); var Index, Loop: Integer; begin if MyPieces.LastPiece < 0 then TTESolved := True else begin Index := 0; while Index <= MyPieces.LastPiece do begin TTEInsertIntoBoard(MyPieces, Index); if TTEPieceFits then begin TTERecurrence(MyPieces); if TTESolved then Exit; end; for Loop := 1 to 3 do begin TTERotatePiece; if TTEPieceFits then begin TTERecurrence(MyPieces); if TTESolved then Exit; end; end; TTERemoveFromBoard(MyPieces, Index); Inc(Index); end; end; end; procedure TTERotatePiece; var TempSide: TTTESide; begin TempSide := TTEBoard.PieceList[TTEBoard.LastPiece][3]; Move(TTEBoard.PieceList[TTEBoard.LastPiece][0], TTEBoard.PieceList[TTEBoard.LastPiece][1], TTE_3SIDE_SIZE); TTEBoard.PieceList[TTEBoard.LastPiece][0] := TempSide; end; procedure TTEInsertIntoBoard(var ThePieces: TTTEPieces; const PieceIdx:Integer); var ThePiece: TTTEPiece; begin ThePiece := ThePieces.PieceList[PieceIdx]; Move(ThePieces.PieceList[PieceIdx + 1], ThePieces.PieceList[PieceIdx], (ThePieces.LastPiece - PieceIdx) * TTE_PIECE_SIZE); Dec(ThePieces.LastPiece); Inc(TTEBoard.LastPiece); TTEBoard.PieceList[TTEBoard.LastPiece] := ThePiece; end; procedure TTERemoveFromBoard(var ThePieces: TTTEPieces; const PieceIdx:Integer); begin Move(ThePieces.PieceList[PieceIdx], ThePieces.PieceList[PieceIdx + 1], (ThePieces.LastPiece - PieceIdx + 1) * TTE_PIECE_SIZE); ThePieces.PieceList[PieceIdx] := TTEBoard.PieceList[TTEBoard.LastPiece]; Inc(ThePieces.LastPiece); Dec(TTEBoard.LastPiece); end; function TTEPieceFits: Boolean; begin case TTEBoard.LastPiece of 0: Result := True; 1: Result := TTEBoard.PieceList[0][1] = TTEBoard.PieceList[1][3]; 2: Result := TTEBoard.PieceList[1][1] = TTEBoard.PieceList[2][3]; 3: Result := TTEBoard.PieceList[2][1] = TTEBoard.PieceList[3][3]; 4: Result := TTEBoard.PieceList[0][2] = TTEBoard.PieceList[4][0]; 5: Result := (TTEBoard.PieceList[1][2] = TTEBoard.PieceList[5][0]) and (TTEBoard.PieceList[4][1] = TTEBoard.PieceList[5][3]); 6: Result := (TTEBoard.PieceList[2][2] = TTEBoard.PieceList[6][0]) and (TTEBoard.PieceList[5][1] = TTEBoard.PieceList[6][3]); 7: Result := (TTEBoard.PieceList[3][2] = TTEBoard.PieceList[7][0]) and (TTEBoard.PieceList[6][1] = TTEBoard.PieceList[7][3]); 8: Result := TTEBoard.PieceList[4][2] = TTEBoard.PieceList[8][0]; 9: Result := (TTEBoard.PieceList[5][2] = TTEBoard.PieceList[9][0]) and (TTEBoard.PieceList[8][1] = TTEBoard.PieceList[9][3]); 10: Result := (TTEBoard.PieceList[6][2] = TTEBoard.PieceList[10][0]) and (TTEBoard.PieceList[9][1] = TTEBoard.PieceList[10][3]); 11: Result := (TTEBoard.PieceList[7][2] = TTEBoard.PieceList[11][0]) and (TTEBoard.PieceList[10][1] = TTEBoard.PieceList[11][3]); 12: Result := TTEBoard.PieceList[8][2] = TTEBoard.PieceList[12][0]; 13: Result := (TTEBoard.PieceList[9][2] = TTEBoard.PieceList[13][0]) and (TTEBoard.PieceList[12][1] = TTEBoard.PieceList[13][3]); 14: Result := (TTEBoard.PieceList[10][2] = TTEBoard.PieceList[14][0]) and (TTEBoard.PieceList[13][1] = TTEBoard.PieceList[14][3]); 15: Result := (TTEBoard.PieceList[11][2] = TTEBoard.PieceList[15][0]) and (TTEBoard.PieceList[14][1] = TTEBoard.PieceList[15][3]); else Result := False; end; end; function TTEPieceAsText(const ThePiece: TTTEPiece): string; var Loop: Integer; begin Result := '[ '; for Loop := 0 to 2 do case ThePiece[Loop] of SURF_BLACK : Result := Result + 'Surfer-Black-Hair, ' ; SURF_BLONDE: Result := Result + 'Surfer-Blonde-Hair, ' ; SKATE_GREEN: Result := Result + 'Skater-Green-Top, ' ; SKATE_RED : Result := Result + 'Skater-Red-Top, ' ; SNOW_GREEN : Result := Result + 'Snowboarder-Green-Top, ' ; SNOW_MAUVE : Result := Result + 'Snowboarder-Mauve-Top, ' ; WIND_BLACK : Result := Result + 'Windsurfer-Black-Hair, ' ; WIND_BLONDE: Result := Result + 'Windsurfer-Blonde-Hair, '; else Result := Result + 'null, '; end; case ThePiece[3] of SURF_BLACK : Result := Result + 'Surfer-Black-Hair ]' ; SURF_BLONDE: Result := Result + 'Surfer-Blonde-Hair ]' ; SKATE_GREEN: Result := Result + 'Skater-Green-Top ]' ; SKATE_RED : Result := Result + 'Skater-Red-Top ]' ; SNOW_GREEN : Result := Result + 'Snowboarder-Green-Top ]' ; SNOW_MAUVE : Result := Result + 'Snowboarder-Mauve-Top ]' ; WIND_BLACK : Result := Result + 'Windsurfer-Black-Hair ]' ; WIND_BLONDE: Result := Result + 'Windsurfer-Blonde-Hair ]'; else Result := Result + 'null ]'; end; end; //////////////////////////////////////////////////////////////////////////////// // 'To The Extreme' Puzzle - Solved! Copyright © 2005 Maxim C.L. Warne // //////////////////////////////////////////////////////////////////////////////// end. --------------------------------------------------------------------------------

Contribute content or training reports / feedback / Comments
job placement papers