<< DiscreteMath`Combinatorica`

Exercises

Exercise 20

(a)

Binomial[10, 3]

(b)

Sum[Binomial[10, k], {k, 0, 4}]

(((2^10) - Binomial[10, 5])/2)

(c)

Sum[Binomial[10, k], {k, 7, 10}]

(d)

Sum[Binomial[10, k], {k, 3, 10}]

(2^10) - Sum[Binomial[10, k], {k, 0, 2}]

Exercise 21

a)

5!

b)

4!

c)

5!

d)

4!

e)

3!

f)

0

Exercise 23

How many ways are there for eight men and five women to stand in a line so that no two women stand next to each other?

13!

You can order men in 8! ways. This leaves 9 positions to place women at. We can choose those 5 positions in 9-choose-5 ways and for each choice we can arrange women in 5! ways:

8! Binomial[9, 5] 5!

Another way to think about this is to first count the bit strings of length 13 with exactly 5 0s and with no consecutive 0s. There are

Binomial[9, 5]

such strings. Now we place men where 1s are and women where 0s are. There are 8! ways to place men and 5! ways to place women. By the product rule the total number is

8! Binomial[9, 5] 5!

Below is an exercise in Mathematica list manipulation to confirm the above calculation for the number of bit strings of length 13

All bit strings of length 13:

tt1 = PadLeft[#, 13] & /@ 
          Table[IntegerDigits[k, 2], {k, 0, 2^13 - 1}];

Length[tt1]

tt1[[8192]]

tt1[[234]]

Separate 0s and 1s by sorting:

Split[Sort[tt1[[123]]]]

Split[
      Sort[tt1[[8192]]]]

Split[Sort[tt1[[1]]]]

The last two bit strings are problematic so exclude them

And[(Length[Split[Sort[#]]] == 2), 
          Length[Split[
                  Sort[#]][[1]]] == 5] &[tt1[[123]]]

Select the bit strings with 5 0s:

tt2 = 
        Select[tt1, 
          And[(Length[Split[Sort[#]]] == 2), 
              Length[Split[
                      Sort[#]][[1]]] == 5] &];

Length[tt2]

Binomial[13, 5]

tt3 = Map[Split, tt2];

Length[tt3]

tt3[[123]]

Now somewhat complicated function to select only those strings that have no consecutive 0s:

MyF22[lll_] := 
      Apply[And, 
        Map[Or[And[(#[[1]] == 
                    0), Length[#] == 
                  1], (#[[1]] == 
                  1)] &, lll]]

MyF22[tt3[[123]]]

MyF22[tt3[[445]]]

tt4 = Select[tt3, MyF22[#] &];

Length[tt4]

Binomial[9, 5]

Exercise 25

100 99 98 97

99 98 97

4 99 98 97

99 98 97 96

2! Binomial[4, 2] 98 97

3!  Binomial[4, 3] 97

4!

96 95 94 93

4 99 98 97

2 Binomial[4, 2] 96 95

Exercise 29

(a)

98*97*4

98*97*4 - 97

(b)

98*72*2  -  97

Exercise 30

(a)

Binomial[9, 5]

Binomial[16, 
      5]

Binomial[16, 5]  -  Binomial[9, 5]

Table[
      Binomial[7, k]*Binomial[9, 5 - k], {k, 1, 6}]

Sum[Binomial[7, k]*Binomial[9, 5 - k], {k, 1, 5}]

(b)

Sum[Binomial[7, k]*Binomial[9, 5 - k], {k, 1, 4}]

4242  -  Binomial[7, 5]

Exercise 31

26^6

6 5 21^5

Binomial[6, 2] 5^2 21^4

26^6  -  21^6

26^6 - (21^6  +  
          6 5 21^5)

Exercise 32

26^6

(a)

26^6  -  25^6

Sum[Binomial[6, k] 25^(6 - k), {k, 1, 6}]

(b)

24^6

26^6  -   24^6

2*(26^6  -  
            25^6)  - (26^6  -   24^6)

(c)

25 24 23 22 21

(d)

26 25 24 23 22 21

26 25 24 23 22 21 /2

Exercise 33

Binomial[10, 3]*Binomial[15, 3]

Exercise 34

Binomial[10 + 15, 6]

Binomial[10, 6]*Binomial[15, 0]

Binomial[10, 5]*Binomial[15, 1]

Binomial[10, 4]*Binomial[15, 2]

Binomial[10, 3]*Binomial[15, 3]

Binomial[10, 2]*Binomial[15, 4]

Binomial[10, 1]*Binomial[15, 5]

Binomial[10, 0]*Binomial[15, 6]

Sum[Binomial[10, k]*Binomial[15, 6 - k], {k, 0, 6}]

Binomial[10 + 15, 6]

Sum[Binomial[10, k]*Binomial[15, 6 - k], {k, 0, 2}]

Exercise 35

In fact we have only 10 objects, eight glued 01 and two free 1s. The objective is to place these two 1s among these 10 objects. That can be done in

Binomial[10, 2]

s18 = Strings[{0, 1}, 18];

Length[s18]

Length[
        Select[Partition[s18[[23434]], 
            2, 1], Function[y, (y == {0, 1})]]] == 
      8

s1808 = Select[s18, (Total[#] == 10) &]

Length[
      Select[s1808, (Length[
                Select[Partition[#, 2, 1], 
                  Function[y, (y == {0, 1})]]] == 
              8) &]]

Exercise 36

Binomial[14, 5]

Exercise 37

2^10 - 2 (1 + 10 + Binomial[10, 2])

Exercise 38

Binomial[45, 3] + Binomial[57, 4] + Binomial[69, 5]

How many possibilities are lost with the restrictions?

Binomial[45 + 57 + 69, 
        3 + 4 + 5] - (Binomial[45, 3] + Binomial[57, 4] + 
          Binomial[69, 5])

Exercise 39

26*25*24*10*9*8

Exercise 40

4!

{{a, b, c, d}, {b, c, d, a}, {c, d, a, b}, {d, a, b, c}}

{{a, b, d, c}, {b, d, c, a}, {d, c, a, b}, {c, a, b, d}}

6!/6

Exercise 41

Ways to end three

Binomial[3, 3]  +
(Binomial[3, 2]   + Binomial[3, 1]  )+
(Binomial[3, 1]*
          Binomial[2, 1]*Binomial[1, 1])

1  + 
   
      Binomial[3, 2]  +  
   
      Binomial[3, 1] ( Binomial[2, 2] ) + 
   3!

Exercise 42

Ways to end two

{{2, 0}, {1, 1}}

2 + 3 - 1

Ways to end three

Length[{{3, 0, 0}, {2, 1, 0}, {1, 2, 0}, {1, 1, 1}}]

2 + 2*3 + 1*4 - 4

Ways to end four

{{4, 0, 0, 0}, {3, 1, 0, 0}, {2, 2, 0, 0}, {2, 1, 1, 0}, {1, 3, 0, 
        0}, {1, 2, 1, 0}, {1, 1, 2, 0}, {1, 1, 1, 1}}

Length[%]

Ways to end five

Length[{{5, 0, 0, 0, 0}, {4, 1, 0, 0, 0}, {3, 2, 0, 0, 0}, {3, 1, 1, 0, 
          0}, {2, 3, 0, 0, 0}, {2, 2, 1, 0, 0}, {2, 1, 2, 0, 0}, {2, 1, 1, 1, 
          0}, {1, 4, 0, 0, 0}, {1, 3, 1, 0, 0}, {1, 2, 3, 0, 0}, {1, 2, 1, 1, 
          0}, {1, 1, 3, 0, 0}, {1, 1, 2, 1, 0}, {1, 1, 1, 1, 0}, {1, 1, 1, 1, 
          1}}]

Length[First[Split[{2, 1, 2, 0, 0}, And[#1 > 0, #2 > 0] &]]]

PadRight[{0, 1}, 5]

Clear[My2Lists, lis];

    
My2Lists[lis_] := 
      Module[{tl, tla1, tla2, nn, }, tl = Append[lis, 0]; 
        nn0 = Length[First[Split[lis, And[#1 > 0, #2 > 0] &]]]; 
        nn = Length[tl]; tla1 = PadRight[PadLeft[{1}, nn0], nn]; 
        tla2 = PadRight[PadLeft[{0, 1}, nn0 + 1], 
            nn]; 
{tl + tla1, 
          tl + tla2}
]

My2Lists[{5, 0, 0, 0, 0}]

Flatten[Map[My2Lists[#] &, #], 1] &[{{1}}]

Flatten[Map[My2Lists[#] &, #], 1] &[{{2, 0}, {1, 1}}]

?Nest*

Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 5]

{1, 3, 2, 0, 0, 0}

Clear[LisFun, lis]; 
    LisFun[lis_] := 
      Module[{nn, nn0}, nn = Apply[Plus, lis]; 
        nn0 = Length[
            First[Split[lis, 
                And[#1 > 0, #2 > 0] &]]]; 
Product[
          Binomial[
            nn - Sum[
                lis[[i]], {i, 1, 
                  j - 1}], 
            lis[[j]]], {j, 1, 
            nn0}]
]

LisFun[{1, 3, 2, 0, 0, 0}]

6*Binomial[5, 3]*Binomial[2, 2]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 1]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 2]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 3]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 4]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 5]]]

{3, 13, 75, 541, 4683}

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 6]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 7]]]

Apply[Plus, 
      Map[LisFun[#] &, 
        Nest[Flatten[Map[My2Lists[#] &, #], 1] &, {{1}}, 8]]]

1  + 
   
      Binomial[4, 3]  +  
   
      Binomial[4, 2] (1  +  2)  + 
   
      Binomial[4, 1] ( 
          Binomial[3, 3]  +  Binomial[3, 2] + 
            Binomial[3, 1]) + 
   4!

Exercise 43

Ways to end

Flatten[{Table[{k, 0, 0}, {k, 6, 3, -1}], 
        Table[{2, 0, k}, {k, 4, 1, -1}], 
        Table[{1, k, 0}, {k, 5, 2, -1}], 
        Table[{1, 1, k}, {k, 4, 1, -1}]}, 1]

Sum[Binomial[6, k], {k, 6, 3, -1}] + 
      Binomial[6, 2]*Sum[Binomial[4, k], {k, 4, 1, -1}] + 
      Binomial[6, 1]*Sum[Binomial[5, k], {k, 5, 2, -1}] + 
      2*Binomial[6, 2]*Sum[Binomial[4, k], {k, 4, 1, -1}]

Binomial[6, 6]  +  
      Binomial[6, 5] + Binomial[6, 4] + 
      Binomial[6, 3] + 
   
      Binomial[6, 
          2]*(1  +  Binomial[4, 3] + Binomial[4, 2] + 
            Binomial[4, 1]) + 
   
      Binomial[6, 1]*( 
          Binomial[5, 5]  +  Binomial[5, 4] + Binomial[5, 3] + 
            Binomial[5, 2]) + 
   
      Binomial[6, 1]*
        Binomial[5, 1]*( 
          Binomial[4, 4]  +  Binomial[4, 3] + Binomial[4, 2] + 
            Binomial[4, 1])