5
$\begingroup$

I am sure that I have accidentaly seen before a way to construct a square shape corresponding to a matrix. For example if we have a 5*5 matrix:

matrix = {
  {1,-1,1,1,-1}, {-1,-1,-1,1,1}, {1,1,1,-1,1}, {-1,1,-1,1,-1}, {1,1,1,-1,-1}};

display as a square representation:

colored squares

But I cannot remember where I have seen this issue.

$\endgroup$
1
  • 7
    $\begingroup$ Use MatrixPlot. $\endgroup$ – Anton Antonov Nov 17 '20 at 9:25
13
$\begingroup$

Update 2020-01-07

At this point there is a Wolfram Function Repository (WFR) RandomScribble.

Here is matrix representation with "midriff" random scribbles based WFR's RandomScribble:

matrix = 
   {{1, -1, 1, 1, -1}, 
    {-1, -1, -1, 1, 1}, 
    {1, 1, 1, -1, 1}, 
    {-1, 1, -1, 1, -1}, 
    {1, 1, 1, -1, -1}};

SeedRandom[23];
Magnify[Grid[
  matrix /. {-1 :> OrangeScribble[], 1 :> DarkGreenScribble[]}, 
  Dividers -> All], 0.4]

enter image description here

(Note that this answer by @kglr has a different approach to making "midriff" scribbles. )

Definitions

Clear[OrangeScribble];
OrangeScribble[opts___] := 
  ResourceFunction["RandomScribble"][opts, 
   "EnvelopeFunctions" -> Automatic, "NumberOfStrokes" -> 200, 
   "RotationAngle" -> Pi/4, ColorFunction -> "SiennaTones", 
   PlotStyle -> {Orange, AbsoluteThickness[3]}];

Clear[DarkGreenScribble];
DarkGreenScribble[opts___] := 
  ResourceFunction["RandomScribble"][opts, 
   "EnvelopeFunctions" -> Automatic, "NumberOfStrokes" -> 200, 
   "RotationAngle" -> Pi/4, ColorFunction -> "AvocadoColors", 
   PlotStyle -> {Orange, AbsoluteThickness[3]}];

Original answer

matrix = 
{{1, -1, 1, 1, -1}, 
{-1, -1, -1, 1, 1}, 
{1, 1, 1, -1, 1}, 
{-1, 1, -1, 1, -1}, 
{1, 1, 1, -1, -1}};

SeedRandom[23];
Grid[matrix /. {-1 :> OrangeScribble[], 1 :> DarkGreenScribble[]}, Dividers -> All]

enter image description here

Update

A problem: If I change the number of raws and columns, then the size of the shape goes very big. I wish to change my matrix to for example :10*10.

matrix2 = ArrayFlatten[Table[matrix, 2, 2]];

Magnify[Grid[
  matrix2 /. {-1 :> OrangeScribble[], 1 :> DarkGreenScribble[]}, 
  Dividers -> All], 0.4]

enter image description here

Definitions

Clear[RandomScribble];
Options[RandomScribble] = 
  Join[{AbsoluteThickness -> 2, ColorFunction -> ColorData[87]}, Options[Graphics]];
RandomScribble[nPoints_Integer, opts : OptionsPattern[]] := RandomScribble[nPoints, \[Pi]/4, opts];
RandomScribble[nPoints_Integer, dir_?NumericQ, opts : OptionsPattern[]] :=
  Block[{r, absTh, colorFunc},
   
   absTh = OptionValue[RandomScribble, AbsoluteThickness];
   colorFunc = OptionValue[RandomScribble, ColorFunction];
   
   If[! (NumericQ[absTh] && absTh > 0), Return[$Failed]];
   
   r = RandomReal[{-1, 1}, {nPoints, 2}];
   
   Graphics[{
     AbsoluteThickness[absTh], colorFunc[0], 
     BezierCurve[Sort[r].RotationMatrix[dir]]
     },
    FilterRules[{opts}, Options[Graphics]]]
   ];
OrangeScribble[] := RandomScribble[RandomInteger[{160, 190}], \[Pi]/4, ColorFunction -> (Orange &), ImageSize -> Tiny];
DarkGreenScribble[] := RandomScribble[RandomInteger[{120, 180}], \[Pi]/4, ColorFunction -> (Darker[Green] &), ImageSize -> Tiny];
$\endgroup$
6
  • $\begingroup$ You are unbelievably intelligent. However I draw my picture just in paint, you redraw the exact shape $\endgroup$ – Inzo Babaria Nov 17 '20 at 13:00
  • $\begingroup$ A problem: If I change the number of raws and columns, then the size of the shape goes very big. I wish to change my matrix to for example :10*10. The desire case is the same size. Where do I must change to have the same size for the shape? $\endgroup$ – Inzo Babaria Nov 17 '20 at 13:07
  • $\begingroup$ @InzoBabaria Thanks! As for plotting the 10x10 matrix: you can use Magnify or change the values given to ImageSize. (See my update.) $\endgroup$ – Anton Antonov Nov 17 '20 at 13:45
  • 5
    $\begingroup$ More a moment, I panicked that they added OrangeScribble and DarkGreenScribble to Mathematica. $\endgroup$ – QuantumDot Nov 18 '20 at 2:34
  • $\begingroup$ @QuantumDot Yeah, WL obviously has to have those functions! I made a resource function submission RandomScribble that should fill that gap. $\endgroup$ – Anton Antonov Nov 18 '20 at 19:36
6
$\begingroup$

As @AntonAntonov says, use MatrixPlot:

matrix = {{ 1, -1,  1,  1, -1},
          {-1, -1, -1,  1,  1},
          { 1,  1,  1, -1,  1},
          {-1,  1, -1,  1, -1},
          { 1,  1,  1, -1, -1}};

MatrixPlot[matrix, 
           ColorRules -> {-1 -> Orange, 1 -> Darker@Green},
           Frame -> False]

enter image description here

$\endgroup$
5
$\begingroup$

I misunderstood the meaning of square color before, here is my new answer:

matrix = Array[RandomChoice[{-1, 1}] &, {10, 10}];
positionA = Position[matrix, 1];
positionB = Position[matrix, -1];
Grid[matrix, Frame -> All, 
 Background -> {None, None, 
   Join[Rule[#, Green] & /@ positionA, 
    Rule[#, Orange] & /@ positionB]}, 
 ItemStyle -> {Automatic, Automatic, 
   Join[Rule[#, White] & /@ positionA, 
    Rule[#, Black] & /@ positionB]}]

enter image description here

$\endgroup$
4
$\begingroup$

A variation on Anton's cool idea:

ClearAll[bsf, scribleShading]

bsf[n_: 200][t_] := BSplineFunction[Transpose[Rescale /@ Transpose[
    Table[{x, RandomReal[{-.2, .2}] + (Pi - Abs[x - Pi]) RandomReal[{.75, 1}] Sin[30 x]},
       {x, Sort@RandomReal[{0, 2 Pi}, n]}]. RotationMatrix[
          RandomReal[Pi/4 + {-Pi/32, Pi/32}]]]], SplineDegree -> 7][t];

scribleShading[n_: 200][color_: Red, absolutethickness_: 3] := 
 ParametricPlot[Evaluate @ bsf[n][t], {t, 0, 1}, 
   PlotStyle -> Directive[color, AbsoluteThickness[absolutethickness]],
   PlotRange -> {0, 1}, PlotRangePadding -> Scaled[.05], 
   ImagePadding -> 0, Axes -> False]

Examples:

Grid[Table[Show[scribleShading[][RandomColor[]], ImageSize -> 100], 3, 5], 
    Dividers -> All]

enter image description here

To get a graphics object:

Graphics[Translate[Scale[scribleShading[][RandomColor[]][[1]], .9], #] & /@ 
  Tuples[{Range @ 5, Range @ 3}], 
 ImageSize -> 600, Frame -> True, FrameTicks -> False,
 GridLines -> Range /@ {5, 3}, PlotRange -> Thread[{1, 1 + {5, 3}}]]

enter image description here

Using OP's matrix:

Grid[matrix /. {-1 :> Show[scribleShading[][Orange], ImageSize -> 90],
     1 :> Show[scribleShading[][Darker@Green], ImageSize -> 90]}, 
 Dividers -> All]

enter image description here

pos = Association[# -> Position[Reverse /@ Transpose[matrix], #] & /@ {1, -1}];

Graphics[MapThread[Module[{col = #2, val = #}, 
     Map[{Translate[Scale[scribleShading[][col][[1]], .9], #], 
         Text[Style[val, 40, FontFamily -> "Comic Sans MS"], .5 + #]} &][pos@val]] &] @ 
  {{-1, 1}, {Orange, Darker @ Green}}, 
 ImageSize -> 600, Frame -> True, FrameTicks -> False,
 GridLines -> Range /@ Dimensions[matrix], 
 PlotRange -> Thread[{1, 1 + Dimensions[matrix]}]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Your intelligence and skills are indescribable!!! $\endgroup$ – Inzo Babaria Nov 19 '20 at 17:04
3
$\begingroup$

Yet another way:

Graphics[{
  Raster[Reverse@matrix, 
   ColorFunction -> (Blend[{Orange, Darker@Green}, #] &)]
  },
 GridLines -> Automatic, GridLinesStyle -> Directive[Thick, Black], 
 Method -> {"GridLinesInFront" -> True}, PlotRangePadding -> None]
$\endgroup$
2
$\begingroup$

You can also use ArrayMesh:

ArrayMesh[matrix, MeshCellStyle -> 
  {{2, All} -> Darker@Green, {2, PositionIndex[Flatten @ matrix] @-1} -> Orange}] 

enter image description here

ArrayMesh[matrix, 
 MeshCellStyle -> {{2, All} ->  Darker @ Green,
      {2, PositionIndex[Flatten@matrix]@-1} -> Orange}, 
 MeshCellLabel -> MapIndexed[{2, #2[[1]]} -> Style[#, 20] &, Flatten[matrix]]]

enter image description here

$\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.