How to use Mathematica to solve this problem of planting tree

Question

To plant trees at the center of each small square in a 3 * 4 rectangular area, it is required that there should be no continuous number of three (or more) trees in three directions of Horizontal, vertical or diagonal, how many methods of planting tree are there in total?

1 means trees can be planted, 0 means trees can not be planted.

but I don't know how to solve this problem with the Mathematical and how to do it?

I already know that the following situations are the ones that meet the requirements of the problem:

What have you tried? This is not a mechanical turk site to have zero-effort questions answered. — ciao, Mar 14 '20 at 06:42
Related, if not duplicate: https://mathematica.stackexchange.com/questions/80207/how-can-i-calculate-the-maximum-number-of-grid-layout-possibilities/ — kirma, Mar 14 '20 at 06:47
You can brute force it. There are only $2^{12}=4096$ possibilities in total. By the way, you should improve your formulation because a $3\times4$ field with just one tree fulfills the problem statement, bit is not shown as a solution. Do you want to fix the number of trees to 8? — yarchik, Mar 14 '20 at 08:28
@yarchik - there are no valid solutions for 8 trees or more... ;-} — ciao, Mar 14 '20 at 08:47

ciao · Accepted Answer · 2020-03-14T09:08:20.353

threeinrows = {{1, 2, 3}, {2, 3, 4}, {5, 6, 7}, {6, 7, 8}, {9, 10, 
    11}, {10, 11, 12}, {1, 5, 9}, {2, 6, 10}, {3, 7, 11}, {4, 8, 
    12}, {1, 6, 11}, {2, 7, 12}, {3, 6, 9}, {4, 7, 10}};
vars = p /@ Flatten@threeinrows // DeleteDuplicates;
fn = ! p /@ # & /@ threeinrows /. List -> And;

For seven trees:

treestoplant = 7

SatisfiabilityCount[
 fn && (BooleanCountingFunction[{treestoplant}, vars]), vars]

ArrayPlot[#, Mesh -> All, ImageSize->Tiny] & /@ 
 Sort[Boole@ArrayReshape[#, {3, 4}] & /@ 
   SatisfiabilityInstances[
    fn && (BooleanCountingFunction[{treestoplant}, vars]), vars, 
    2^12]]

20

score 2 · Answer 2 · 2020-03-14T09:44:07.063

I updated my answer, but my code is slow to calculate:

      p[i_] := Module[{m, 
   n}, {m, n} = {Quotient[i, 4, -3], Mod[i, 4, 1]}; {m, n, n - m + 1, 
   m + n - 3}]
sum[i_, a_?MatrixQ] := 
 Module[{d, rd, r, c}, {r, c, d, rd} = 
   p[i]; {Total /@ SequenceSplit[a[[r, ;;]], {0}], 
    Total /@ SequenceSplit[a[[;; , c]], {0}], 
    Total /@ SequenceSplit[Diagonal[a, d - 1], {0}], 
    Total /@ 
     SequenceSplit[Diagonal[Reverse@a, rd - 1], {0}]} /. {} -> {0}]

data = Tuples[{0, 1}, 12];

(sdata = Select[
    data, ! AnyTrue[
       AnyTrue[#, # > 2 &] & /@ 
        Table[Flatten[sum[i, Partition[#, 4]]], {i, 1, 12}], 
       TrueQ] &]) // Length

Partition[
  MatrixForm /@ (Partition[#, 4] & /@ Select[sdata, Total[#] == 7 &]),
   UpTo[5]] // DeleteDuplicates(*plans of plantting seven trees*)

I think this misses solutions... – ciao Mar 14 '20 at 08:56 — ciao, Mar 14 '20 at 08:56

score 2 · Answer 3 · answered Mar 14 '20 at 09:49

I post a code written by Wawuqingyi to solve this problem with bit operation:

lis = Complement[Range[0, 15], {7, 14, 15}]
ans = Tuples[lis, 3] // 
   Select[#, 
     BitAnd[#1, #2, #3] == 0 && BitAnd[4 #1, 2 #2, #3] == 0 && 
         BitAnd[#1, 2 #2, 4 #3] == 0 & @@ # &] &;
nums = Length@ans
GroupBy[ans, 
    Total@Flatten@IntegerDigits[#, 2] &] // #[Max[Keys[#]]] & // 
  IntegerDigits[#, 2, 4] & // TableForm /@ # &

Thank you very much for your help.

How to use Mathematica to solve this problem of planting tree

3 Answers3

Linked