1
$\begingroup$

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?

enter image description here

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:

enter image description here

$\endgroup$
4
  • 4
    $\begingroup$ What have you tried? This is not a mechanical turk site to have zero-effort questions answered. $\endgroup$
    – ciao
    Commented Mar 14, 2020 at 6:42
  • $\begingroup$ Related, if not duplicate: mathematica.stackexchange.com/questions/80207/… $\endgroup$
    – kirma
    Commented Mar 14, 2020 at 6:47
  • 1
    $\begingroup$ 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? $\endgroup$
    – yarchik
    Commented Mar 14, 2020 at 8:28
  • 2
    $\begingroup$ @yarchik - there are no valid solutions for 8 trees or more... ;-} $\endgroup$
    – ciao
    Commented Mar 14, 2020 at 8:47

3 Answers 3

8
$\begingroup$
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 enter image description here

$\endgroup$
2
$\begingroup$

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*)
$\endgroup$
1
  • 1
    $\begingroup$ I think this misses solutions... $\endgroup$
    – ciao
    Commented Mar 14, 2020 at 8:56
2
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.