# The Battleship game: Identify objects within a matrix

Toy data

board =
{{1, 1, 0, 4, 0, 0, 9, 9, 9, 9},
{0, 0, 0, 4, 0, 0, 0, 0, 0, 0},
{5, 0, 0, 4, 0, 7, 7, 7, 0, 8},
{5, 0, 0, 0, 0, 0, 0, 0, 0, 8},
{5, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{5, 0, 0, 0, 4, 0, 0, 0, 0, 6},
{0, 0, 0, 0, 4, 0, 0, 0, 0, 6},
{3, 3, 0, 0, 0, 0, 0, 0, 0, 6},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 3, 3, 3, 3, 3}};


Visualization

ArrayPlot[board,
ColorFunction -> "AtlanticColors",
Frame -> True,
FrameTicks -> {{All, None}, {None, Transpose[{Range @ 10, CharacterRange["A", "J"]}]}},
Mesh -> True]


Battleship

is a guessing game for two players. It is played on paper grids on which each player's fleet of warships are marked. Players shoot at the other player's ships, and the objective of the game is to destroy the opposing player's fleet.

Here we don't want to guess and destroy, but find the ship locations in an elegant mathematical way. In my own coding experiments I got caught up in something that was far too complicated.

Expected result

The sorted result should look like:

result =
{"A1:B1", "A3:A6", "A8:B8", "D1:D3", "E6:E7", "F10:J10", "F3:H3", "G1:J1", "J3:J4", "J6:J8"};


There is always some water between the ships, their lengths can range from 2 to 5 square units, and diagonal placements are not allowed.

• two different ships are labeled 3; is that a typo?
– kglr
Commented Nov 20, 2023 at 16:25
• No, I did that on purpose. Ship identifiers can repeat. Let's say they don't identify the individual ship, but the flag under which it sails.
– eldo
Commented Nov 20, 2023 at 16:30

### NearestNeigborGraph + ConnectedComponents

nng = NearestNeighborGraph[Position[board, _Integer?Positive],
DistanceFunction -> ManhattanDistance];

ConnectedComponents[nng] // Column


toExcelIndices =  StringRiffle[
MapAt[ToUpperCase[Alphabet[]][[#]] &, Reverse /@ #, {All, 1}], ":", ""] &

Sort @ Map[toExcelIndices] @ ConnectedComponents[nng][[All, {1, -1}]]

  {"A1:B1", "A3:A6", "A8:B8", "D1:D3", "E6:E7",
"F10:J10", "F3:H3",   "G1:J1", "J3:J4", "J6:J8"}


Visualization:

ap = ArrayPlot[board,
ColorFunction -> "AtlanticColors",
Frame -> True,
FrameTicks -> {{All, None},
{None, Transpose[{Range@10, CharacterRange["A", "J"]}]}},
Mesh -> True
Epilog ->  MapIndexed[Text[Style[#, 16, White], #2 - 1/2] &,
Transpose @ Reverse @ board, {2}]];

nng = Graph[nng,
PerformanceGoal -> "Quality",
EdgeStyle ->
Directive[CapForm["Round"], AbsoluteThickness[25], Red],
VertexCoordinates ->
MapApply[-1/2 + {#2, 1 + 10 - #} &] @ GraphEmbedding[nng]];

Show[ap,
HighlightGraph[nng, PathGraph /@ ConnectedComponents[nng]]]


### SparseArray + FindClusters

shipCoords = FindClusters[
SparseArray[Transpose @ board]["NonzeroPositions"],
DistanceFunction -> ManhattanDistance];

shipCoords // Column


toExcelIndexing = StringRiffle[
MapAt[ToUpperCase[Alphabet[]][[#]] &, #, {All, 1}], ":", ""] &;

Map[toExcelIndexing] @ shipCoords[[All, {1, -1}]]


{"A1:B1", "A3:A6", "A8:B8", "D1:D3", "E6:E7", "F3:H3",
"F10:J10", "G1:J1", "J3:J4", "J6:J8"}

• Nice! [comment padding] Commented Nov 20, 2023 at 19:20

One attempt:

board = {
{1, 1, 0, 4, 0, 0, 9, 9, 9, 9}, {0, 0, 0, 4, 0, 0, 0, 0, 0, 0}
, {5, 0, 0, 4, 0, 7, 7, 7, 0, 8}, {5, 0, 0, 0, 0, 0, 0, 0, 0, 8}
, {5, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {5, 0, 0, 0, 4, 0, 0, 0, 0, 6}
, {0, 0, 0, 0, 4, 0, 0, 0, 0, 6}, {3, 3, 0, 0, 0, 0, 0, 0, 0, 6}
, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 3, 3, 3, 3, 3}};

{xMax, yMax} = Dimensions@board;
cm = Association@Map[Round
, ComponentMeasurements[
MorphologicalComponents[Binarize@Image@board], "BoundingBox"], {-1}];
coordinates[from : {x0_, y0_}, to : {x1_, y1_}] :=
StringJoin[Riffle[Sort[
Map[ToString
, {{char[x0 + 1], yMax - y0 }, {char[x1], yMax + 1 - y1}}, {2}]], ":"]];
coordinates @@@ cm // Values // Sort
(* Output *)
(*
{"A1:B1", "A3:A6", "A8:B8", "D1:D3", "E6:E7", "F10:J10", "F3:H3", "G1:J1", "J3:J4", "J6:J8"}
*)

• +1 - much to learn for me from your solution
– eldo
Commented Nov 20, 2023 at 17:29

Here is a step-by-step procedure:

uniquifiedBoard = MorphologicalComponents[board];
shipIdentifiers = Rest@Union[Flatten[uniquifiedBoard]];
positions = Position[uniquifiedBoard, #] & /@ shipIdentifiers;

(* helpers *)
CreateDescription[pos : {{x_, _} ...}] := {{x, pos[[1, -1]]}, {x, pos[[-1, -1]]}};
CreateDescription[pos : {{_, y_} ...}] := {{pos[[1, 1]], y}, {pos[[-1, 1]], y}};
ExcelifyCoords[{x_, y_}] := Alphabet[][[y]] <> ToString[x];
ExcelifyRange[{a_List, ___List, b_List}] := ExcelifyCoords[a] <> ":" <> ExcelifyCoords[b];

(* result *)
ExcelifyRange /@ positions

(*
{"a1:b1", "a3:a6", "a8:b8", "d1:d3", "e6:e7", "f10:j10", "f3:h3", "g1:j1", "j3:j4", "j6:j8"}
*)


This should, at least and at last, convince me to start learning about graphs.

Clear["Global*"];
board = {{1, 1, 0, 4, 0, 0, 9, 9, 9, 9}, {0, 0, 0, 4, 0, 0, 0, 0, 0,
0}, {5, 0, 0, 4, 0, 7, 7, 7, 0, 8}, {5, 0, 0, 0, 0, 0, 0, 0, 0,
8}, {5, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {5, 0, 0, 0, 4, 0, 0, 0, 0,
6}, {0, 0, 0, 0, 4, 0, 0, 0, 0, 6}, {3, 3, 0, 0, 0, 0, 0, 0, 0,
6}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 3, 3, 3, 3,
3}};

across = (Transpose[{ToUpperCase@Alphabet[][[1 ;; Length@#]], #}] & /@
board /. {a_, 0} :> Nothing //
Map[GatherBy[#, Last] &]) /. {{a_, b_}} :> Nothing //
MapIndexed[
ToString@First@First@#1 <> ToString@First@#2 <> ":" <>
ToString@First@Last@#1 <> ToString@First@#2 &, #, {2}] & //
Flatten[#, 1] &


{"A1:B1", "G1:J1", "F3:H3", "A8:B8", "F10:J10"}

down = (Transpose[{ToUpperCase@
Alphabet[][[1 ;; Length@#]], #}] & /@ (Transpose@
board) /. {a_, 0} :> Nothing // Map[GatherBy[#, Last] &]) //
Map[Replace[#, {{a_, b_}} :> Nothing, {1}] &] //
MapIndexed[
ToUpperCase@FromLetterNumber@First@#2 <>
ToString@LetterNumber@First@First@#1 <> ":" <>
ToUpperCase@FromLetterNumber@First@#2 <>
ToString@LetterNumber@First@Last@#1 &, #, {2}] & //
Flatten[#, 1] &


{"A3:A6", "D1:D3", "E6:E7", "J3:J4", "J6:J8"}

– bmf
Commented Nov 21, 2023 at 5:04

### MapIndexed + SplitBy

ClearAll[indexBoard, bowStern, findShips]

ucA = ToUpperCase@Alphabet[];

indexBoard[direction_ : "Across"] := Module[
{d$$= direction /. {"Across" -> Reverse, _ -> Identity}}, MapIndexed[If[# == 0, Nothing, {#, StringRiffle[{ucA[[#]], #2} & @@ d$$[#2], ""]}] &, #, {2}]] &

bowStern = Map[
Splice @
Cases[{{_, f_}, ___, {_, l_}} :> StringRiffle[{f, l}, ":"]] @
SplitBy[#, First] &];

findShips = Sort @ Map[Splice @* bowStern] @
{indexBoard[] @ #, indexBoard["Down"] @ Transpose @ #} &;

findShips @ board

  {"A1:B1", "A3:A6", "A8:B8", "D1:D3", "E6:E7", "F10:J10",
"F3:H3", "G1:J1", "J3:J4", "J6:J8"}
`