Two tiny puzzles of pattern or reformat

Q1:

(This question was adapted from the last example of Naming Pieces of Patterns in Wolfram Documentation.)

Modify the pattern (but requiring retain h[_]) —

{f[h[4],h[4]],  f[h[4],h[5]],  f[h[4],h[5],h[6]]} /. f[x:h[_], x_] -> r[x]


— to output

{f[h[4],h[4]],  r[h[5]],  r[h[6]]}


Q2:

Use as little code as possible to generate:

{{{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}}, {{{9, 10}, {11, 12}}, {{13, 14}, {15, 16}}}}


$$\left( \begin{array}{cc} \left( \begin{array}{cc} 1 & 2 \\ 3 & 4 \\ \end{array} \right) & \left( \begin{array}{cc} 5 & 6 \\ 7 & 8 \\ \end{array} \right) \\ \left( \begin{array}{cc} 9 & 10 \\ 11 & 12 \\ \end{array} \right) & \left( \begin{array}{cc} 13 & 14 \\ 15 & 16 \\ \end{array} \right) \\ \end{array} \right)$$

My trial:

m = {{1, 2}, {3, 4}};
{{m, m + 4}, {m + 8, m + 12}}

• As part of the Mathematica community that you are now, you should probably re-read some of the topics in the help-center. It is good practice to not only accept answers but to upvote all helpful answers. Coolwaters replacement approach for instance is worth an upvote. Just saying.. Commented Feb 3, 2018 at 11:23

It's not clear what you try to achieve in your first example. Nevertheless, here is a more verbose version of what coolwater used:

{f[h[4], h[4]], f[h[4], h[5]], f[h[4], h[5], h[6]]} /.
{f[x_, x_] :> f[x, x], f[start__, last_] :> r[last]}


Your second question has several answers. You can construct the matrix or you can restructure an existing list:

Nest[Partition[#, 2] &, Range[16], 3]
(i = 1; Nest[{#, # + (i *= 2)} &, {1, 2}, 3])
First@Nest[{{First[#], First[#] + Last[#]}, Last[#]*2} &, {{1, 2}, 2}, 3]
(i = 1; Table[i++, 2, 2, 2, 2])
SparseArray[{i_, j_, k_, l_} :> 8 (i - 1) + 4 (j - 1) + 2 (k - 1) + l, {2, 2, 2, 2}] // Normal
InternalDeflatten[Range[16], {2, 2, 2, 2}]

• I have to apologize that Q1 has been modified to my original meaning, can you relook it?
– ooo
Commented Feb 3, 2018 at 13:00
• What do you mean by "retain h"? Do you mean that you need to ensure that the functions inside f are h[..]? Commented Feb 3, 2018 at 13:23
• Yes. Supposing that I require h[..] to be included in f.
– ooo
Commented Feb 3, 2018 at 15:30
• @ooo You can use {f[x_h, x_h] :> f[x, x], f[start__h, last_h] :> r[last]}. Works the same but enforces the that the subexpressions have a head h. Commented Feb 3, 2018 at 15:51

E.g.

Replace[{f[h[4], h[4]], f[h[4], h[5]], f[h[4], h[5], h[6]]},
{a_[b__] :> If[DuplicateFreeQ[List[b]], r[Last[{b}]], a[b]]}, {1}]
(*or*)
{f[h[4], h[4]], f[h[4], h[5]], f[h[4], h[5], h[6]]} /.
f[x : h[_], y__] /; x =!= First[{y}] :> r[Last[{y}]]

{f[h[4], h[4]], r[h[5]], r[h[6]]}

ArrayReshape[Range[16], ConstantArray[2, 4]] // MatrixForm


$\left( \begin{array}{cc} \left( \begin{array}{cc} 1 & 2 \\ 3 & 4 \\ \end{array} \right) & \left( \begin{array}{cc} 5 & 6 \\ 7 & 8 \\ \end{array} \right) \\ \left( \begin{array}{cc} 9 & 10 \\ 11 & 12 \\ \end{array} \right) & \left( \begin{array}{cc} 13 & 14 \\ 15 & 16 \\ \end{array} \right) \\ \end{array} \right)$

• I have to apologize that Q1 has been modified to my original meaning, can you relook it?
– ooo
Commented Feb 3, 2018 at 13:00
• @ooo Edited the answer Commented Feb 3, 2018 at 13:24
• Wouldn't {2,2,2,2} be shorter than ConstantArray[2, 4]? It depends on what "as little code as possible" means but I understand it as golfing. Commented Feb 3, 2018 at 14:47
• @anderstood ConstantArray[2, 4] is better than I desired~
– ooo
Commented Feb 3, 2018 at 15:32

Q1

{f[h[4], h[4]], f[h[4], h[5]], f[h[4], h[5], h[6]]} /.
f[x_, y___, z_] /; FreeQ[{y, z}, x] :> r[z]


{f[h[4], h[4]], r[h[5]], r[h[6]]}

Q2

i=1;Table[i++,2,2,2,2]


{{{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}}, {{{9, 10}, {11, 12}}, {{13, 14}, {15, 16}}}}

%  // MatrixForm // TeXForm


$\left( \begin{array}{cc} \left( \begin{array}{cc} 1 & 2 \\ 3 & 4 \\ \end{array} \right) & \left( \begin{array}{cc} 5 & 6 \\ 7 & 8 \\ \end{array} \right) \\ \left( \begin{array}{cc} 9 & 10 \\ 11 & 12 \\ \end{array} \right) & \left( \begin{array}{cc} 13 & 14 \\ 15 & 16 \\ \end{array} \right) \\ \end{array} \right)$

Alternatively, with three extra characters:

i=1;Array[i++&,{2,2,2,2}]
`