Problems from Section 4.1

To verify problems involving strings we need

<< DiscreteMath`Combinatorica`

Strings[{0, 1}, 4]

Exercise 11

2^8

Exercise 12

Sum[2^k, {k, 0, 6}]

Exercise 15

26^4 + 26^3 + 26^2 + 26^1 + 1

Exercise 16

26^4 - 25^4

Exercise 17

Inclusion-exclusion

128^5 - 127^5

Exercise 18

(a)

Floor[(1000/7)]

(b)

Floor[(1000/11)]

Floor[(1000/(7 11))]

142 - 12

\(Length[
      Select[Range[999], 
        And[IntegerQ[#\/7], Not[IntegerQ[#\/11]]] &]]\)

(c)

Floor[(1000/(11*7))]

(d)

Floor[(1000/11)] + Floor[(1000/7)] - Floor[(1000/(11*7))]

(e)

Floor[(1000/11)] + Floor[(1000/7)] - 2 Floor[(1000/(11*7))]

(f)

999 - (Floor[(1000/11)] + Floor[(1000/7)] - 
          Floor[(1000/(11*7))])

(g)

90 - 
      9  (* two digit numbers *)   +  9*9*8  (* three digit numbers *)

Length[
        Select[Table[k, {k, 100, 999}], 
          And[Length[Union[IntegerDigits[#]]] > 2] &]] + 
      Length[Select[Table[k, {k, 10, 99}], 
          And[Length[Union[IntegerDigits[#]]] > 1] &]]

(h)

Length[
        Select[Table[k, {k, 100, 999}], 
          And[Length[Union[IntegerDigits[#]]] > 2, EvenQ[#]] &]] + 
      Length[Select[Table[k, {k, 10, 99}], 
          And[Length[Union[IntegerDigits[#]]] > 1, EvenQ[#]] &]]

8*8*4  (* three digits ending with 2, 4, 6, 
        8 *)  +9*8  (* 
        three digits ending with 0 *)  + 8*4  (* two digits ending with 2, 4, 6, 8 *) +9  (* 
        two digits ending with 0 *)

Length[
        Select[Table[k, {k, 100, 999}], 
          And[Length[Union[IntegerDigits[#]]] > 2, OddQ[#]] &]] + 
      Length[Select[Table[k, {k, 10, 99}], 
          And[Length[Union[IntegerDigits[#]]] > 1, OddQ[#]] &]]

8*8*5      +  8*5

Exercise 19

(a)

105/7

994/7

142 - 15 + 1

(b)

450

(c)

9

(d)

100/4

996/4

249 - 25 + 1

900 - 225

(e)

(999 - 102)/3 + 1

996/12 - 108/12 + 1

300 + 225 - 75

(f)

450

(g)

300 - 75

(h)

75

Exercise 20

(a)  How many integers in {1000,...,9999} are divisable by 9

We have 999 = 111*9. Thus the smallest integer in this set divisable by 9 is 112*9. The largest integer divisable by 9 in this set is 9999=1111*9. Thus there are

1111 - 111

integers in the given set whichare divisable by 9

We can verify this in Mathematica by the following commands

\(\(IntegerQ[#\/9] &\)[7866]\)

\(Length[Select[Range[1000, 9999], IntegerQ[#\/9] &]]\)

(b) How many integers in {1000,...,9999} are even

1000 = 500*2 is even and 4999*2 = 9998 is even. Thus, there are

4999 - 500 + 1

even integers in this set.

Verification in Mathematica

Length[Select[Range[1000, 9999], EvenQ[#] &]]

(c) How many integers in {1000,...,9999} have distinct digits

We calculate this by using the product rule. There are 9 options, that is {1, 2, 3, 4, 5, 6, 7, 8, 9}, to choose the first digit; say this is (Subscript[d, 1]); there are 9 options, that is \(TraditionalForm\`{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}\{d\_1}\), to choose the second digit; say this is (Subscript[d, 2]); there are 8 options, that is  \(TraditionalForm\`\(\({0, 1, 2, 3, 4, 5, 6, 7, 8, 9}\{d\_1, 
          d\_2}\)\(,\)\)\) to choose the third digit; say this is (Subscript[d, 3]); and finally, there are 7 options, that is \(TraditionalForm\`{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}\{d\_1, d\_2, 
          d\_3}\), to choose the fourth digit.

9 9 8 7

Verification in Mathematica

The command

Length[Union[IntegerDigits[#]]] &[3456]

tells us how many DISTINCT digits there are in an integer.  The command

Length[Union[IntegerDigits[#]]] == 4 &[3456]

tells if the number of DISTINCT digits is equal to 4

Finally this is Mathematica's answer to (c)

Length[
      Select[Range[1000, 9999], 
        Length[Union[IntegerDigits[#]]] == 4 &]]

(d)  How many integers in {1000,...,9999} are not divisable by 3

999=333*3 and 9999=3333*3, so there are 3000 integers divisable by 3. Since the total is 9000 integers, there are 6000 integers not divisable by 3

\(Length[Select[Range[1000, 9999], Not[IntegerQ[#\/3]] &]]\)

(e), (f), (g), (h)

The relevant counts are:

the number of integers divisable by 5

div5 = Floor[(9999/5)] - Floor[(999/5)]

the number of integers divisable by 7

div7 = Floor[(9999/7)] - Floor[(999/7)]

the number of integers divisable by both 5 and 7

div35 = Floor[(9999/35)] - Floor[(999/35)]

So, the answer to (e), the number of integers divisable by 5 or 7 is

div5 + div7 - div35

Mathematica verification

\(Length[
      Select[Range[1000, 9999], 
        Or[IntegerQ[#\/7], IntegerQ[#\/5]] &]]\)

The answer to (f),the number of integers not divisable by either 5 or 7 is

9000 - (div5 + div7 - div35)

Mathematica verification

\(Length[
      Select[Range[1000, 9999], 
        Not[Or[IntegerQ[#\/7], IntegerQ[#\/5]]] &]]\)

The answer to (g), the number of integers divisable by 5 but not divisable by 7 is

div5 - div35

Mathematica verification

\(Length[
      Select[Range[1000, 9999], 
        And[Not[IntegerQ[#\/7]], IntegerQ[#\/5]] &]]\)

The answer to (h), the number of integers divisable by 5 and divisable by 7 is

div35

Mathematica verification

\(Length[
      Select[Range[1000, 9999], 
        And[IntegerQ[#\/7], IntegerQ[#\/5]] &]]\)

Exercise 21

(a)

10^3 - 10

(b)

5*10*10

(c)

9 + 9 + 9

Exercise 23

3^50

Exercise 25

26*26*10000 + 100*26^4

Exercise 27

(26 26  + 26^3) (100  + 1000)

Exercise 29

(a)

Length[CharacterRange["a", "z"]]

\(Length[
      Complement[
        CharacterRange["a", "z"], {"a", "e", "i", "o", "u"}]]\)

21^8

(b)

21 20 19 18 17 16 15 14

(c)

5 26^7

(d)

5 25 24 23 22 21 20 19

(e)

26^8 - 21^8

(f)

Where is vowel? 1, 2, 3, 4, 5, 6, 7, 8

8*5*21^7

(g)

Start with x

26^7

Start with x no vowels

21^7

26^7 - 21^7

(h)

26^6 - 21^6

Exercise 31

(a)

0

(b)

5!

(c)

6 5 4 3 2

(d)

7 6 5 4 3

Exercise 33

(a)

If  n = 1, then 2.

If  n = 2, then 2.

If n > 2, none

(b)

If  n = 1, then 1.

If  n = 2, then 1.

If n > 2, (2^(n - 2))

(c)

If  n = 1, then 0.

If  n = 2, then 2.

If n > 2, then 2(n-1).

Exercise 37

If  n  is even, then 2^(n/2). If  n  is odd, then 2^((n+1)/2). The common answer is 2^Ceiling[n/2].

Exercise 38

(a)

9*8*7*6*5*6

9*8*7*6*5*6

(b)

10*9*8*7*6*5

8*7*6*5*4*3

10*9*8*7*6*5 - 8*7*6*5*4*3   (* 
          at least one of b or g *)

2 * 90720-131040

50400    + (90720 - 
          50400 )     + (90720 - 50400 )     + 20160

(c)

(90720 - 50400 )     + (90720 - 50400 )

Exercise 39

(a)

2*5!

(b)

6! - 2*5!

(c)

((6!)/2)

Exercise 40

How many bit strings of length 7 start with 00 or end with 111?

There are 32 strings which start with 00 and there are 16 strings which end with 111.  There are 4 strings that start with 00 and end with 111. Thus the answer is by inclusion-exclusion rule

32 + 16 - 4

Mathematica verification

The following command will tell me which is the first bit in a bitstring

#[[1]] &[{1, 0, 0, 1, 0, 1, 
        1}]

The following command will tell me what problem is asking for

Or[
          And[#[[1]] == 
              0, #[[2]] == 0], 
          And[#[[7]] == 
              1, #[[6]] == 
              1, #[[5]] == 
              1]] &[{1, 0, 1, 0, 0, 1, 1}]

Or[
          And[#[[1]] == 
              0, #[[2]] == 0], 
          And[#[[7]] == 
              1, #[[6]] == 
              1, #[[5]] == 
              1]] &[{0, 0, 1, 0, 0, 1, 1}]

Length[
      Select[Strings[{0, 1}, 7], 
        Or[And[#[[1]] == 
                0, #[[2]] == 0], 
            And[#[[7]] == 
                1, #[[6]] == 
                1, #[[5]] == 
                1]] &]]

Exercise 41

2^7 + 2^8 - 2^5

Exercise 42

How many bit strings of length 10 contain at least 5 consecutive 0s or at least 5 consecutive 1s?

We will first count the bitstrings with at least 5 consecutive 0s.

The "at least 5 consecutive 0s" can start at the following positions 1, 2, 3, 4, 5, 6

There are (2^5) = 32 bit srings which start with 00000***** (type 1)

There are (2^4) = 16 bit srings which start with 100000****  (type 2)

There are (2^4) = 16 bit srings which start with *100000***  (type 3)

There are (2^4) = 16 bit srings which start with **100000**  (type 4)

There are (2^4) = 16 bit srings which start with ***100000*  (type 5)

There are (2^4) = 16 bit srings which start with ****100000  (type 6)

There are no bitstrings that belong to two different types. (You conclude this by looking at types j and k, j < k. Type k has 1 at position k-1 while type j has 0 at the position k-1.

Thus there are

32 + 5*16

bit strings with at least 5 consecutive 0s

Also, there are 112 bit strings with at least 5 consecutive 1s.

There are 2 bit strings which are in both sets: 0000011111 and 1111100000.

By the inclusion-exclusion principle the answer is

2*112  -  2

To verify this in Mathematica is a little bit more complicated.

The following command will collect the identical consecutive bits in separate lists

Split[{1, 0, 1, 0, 0, 1, 0, 0, 0, 0}]

The following command will count how many consecutive bits there are

Length[#] & /@ Split[{1, 0, 1, 0, 0, 1, 0, 0, 0, 0}]

The following command will find the maximum number of consecutive bits

Max[Length[#] & /@ 
        Split[{1, 0, 1, 0, 0, 1, 0, 0, 0, 0}]]

And finally we will ask if that max number is ≥5.

Max[Length[#] & /@ 
          Split[{1, 0, 1, 0, 0, 1, 0, 0, 0, 0}]] ≥ 5

Make this into a function of a bit string

Max[Length[#] & /@ Split[#]] ≥ 5 &[{1, 0, 1, 0, 
        0, 1, 0, 0, 0, 0}]

Length[
      Select[Strings[{0, 1}, 10], 
        Max[Length[#] & /@ Split[#]] ≥ 5 &]]

An alternative count:

The number of strings with exactly 5 consecutive 0s

e5 = ((2^4)) + ((2^3)) + ((2^3)) + ((2^3)) + ((2^3)) + 
        (2^4)

The number of strings with exactly 6 consecutive 0s

e6 = ((2^3)) + ((2^2)) + ((2^2)) + ((2^2)) + 
        (2^3)

The number of strings with exactly 7 consecutive 0s

e7 = ((2^2)) + ((2^1)) + ((2^1)) + (2^2)

The number of strings with exactly 8 consecutive 0s

e8 = ((2^1)) + ((2^0)) + ((2^1))

The number of strings with exactly 9 consecutive 0s

e9 = ((2^0)) + ((2^0))

The number of strings with exactly 10 consecutive 0s

e10 = 1

The number of strings with at least 5 consecutive 0s

e5 + e6 + e7 + e8 + e9 + e10

The number of strings with at least 5 consecutive 1s is the same

The number of strings with at least 5 consecutive 0s or at least 5 consecutive 1s

2 (e5 + e6 + e7 + e8 + e9 + e10) - 2

Total

(2^10)

Length[
      Select[Strings[{0, 1}, 10], 
        Max[Map[Length, Split[#]]] > 4 &]]

Exercise 43

How many bit strings of length eight contain either at least three consecutive 0s or at least four consecutive ls?

Total

2^8

Consider the following sets of strings having exactly three consecutive 0s

(Subscript[S, a]) the set of strings with exactly three consecutive 0s which start with 0001, that is of the form 0001****.  There are (2^4) - 1 such strings, since we have to exclude 00010000.

(Subscript[S, b]) the set of strings with exactly three consecutive 0s which start with 10001, that is of the form 10001***.  There are (2^3) such strings.

(Subscript[S, c]) the set of strings with exactly three consecutive 0s which are of the form *10001**.  There are (2^3) such strings.

(Subscript[S, d]) the set of strings with exactly three consecutive 0s which are of the form **10001*.  There are (2^3) such strings.

(Subscript[S, e]) the set of strings with exactly three consecutive 0s which end with 10001, that is are of the form ***10001.  There are (2^3) such strings.

(Subscript[S, f]) the set of strings with exactly three consecutive 0s which end with 1000, that is are of the form ****1000.  There are (2^4) - 1 such strings since we have to exclide 00001000.

There is one string in (Subscript[S, a])  ⋂  (Subscript[S, e]). There is one string in (Subscript[S, a])  ⋂  (Subscript[S, f]). There is one string in (Subscript[S, b])  ⋂  (Subscript[S, f]),

ne3 = (((2^4) - 
              1)) +(((2^3)) + (2^3) + (2^3) + ((2^3)))+(((2^4) - 1))-3

Length[
      Select[Strings[{0, 1}, 
          8], (Max[
                Map[Length, 
                  Select[Split[#], First[#] == 0 &]]] == 
              3) &]]

Exactly four consecutive 0s

ne4 = (2^3) + (2^2) + (2^2) + (2^2) + (2^3)

Length[
      Select[Strings[{0, 1}, 
          8], (Max[
                Map[Length, 
                  Select[Split[#], First[#] == 0 &]]] == 
              4) &]]

Exactly five consecutive 0s

ne5 = (2^2) + (2^1) + (2^1) + (2^2)

Exactly six consecutive 0s

ne6 = 2 + 1 + 2

Exactly seven consecutive 0s

ne7 = 1 + 1

Exactly eight consecutive 0s

ne8 = 1

ne3 + ne4 + ne5 + ne6 + ne7 + ne8

(ne4 + ne5 + ne6 + ne7 + ne8)

(ne3 + ne4 + ne5 + ne6 + ne7 + ne8) + (ne4 + ne5 + ne6 + ne7 + 
          ne8)

Eight strings are in both:

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

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

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

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

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

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

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

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

Thus, the count of the bit strings of length eight which contain either at least three consecutive 0s or at least four consecutive ls is as follows:

(ne3 + ne4 + ne5 + ne6 + ne7 + ne8) + (ne4 + ne5 + ne6 + ne7 + 
          ne8) - 8

Next I will construct Mathematica commands that will confirm that.

Map[{Length[#], First[#]} &, Split[{0, 0, 0, 1, 0}]]

(Max[Map[Length, Select[Split[#], First[#] == 0 &]]] > 
            2) &[{0, 0, 0, 1, 0}]

Length[
      Select[Strings[{0, 1}, 
          8], (Max[Map[Length, Select[Split[#], First[#] == 0 &]]] > 
              2) &]]

Length[
      Select[Strings[{0, 1}, 
          8], (Max[Map[Length, Select[Split[#], First[#] == 1 &]]] > 
              3) &]]

Length[
      Select[Strings[{0, 1}, 8], 
        Or[(Max[Map[Length, Select[Split[#], First[#] == 0 &]]] > 
                2), (Max[
                  Map[Length, Select[Split[#], First[#] == 1 &]]] > 
                3)] &]]

Length[
      Select[Strings[{0, 1}, 8], 
        And[(Max[Map[Length, Select[Split[#], First[#] == 0 &]]] > 
                2), (Max[
                  Map[Length, Select[Split[#], First[#] == 1 &]]] > 
                3)] &]]

Select[Strings[{0, 1}, 8], 
      And[(Max[Map[Length, Select[Split[#], First[#] == 0 &]]] > 
              2), (Max[
                Map[Length, Select[Split[#], First[#] == 1 &]]] > 
              3)] &]

No consecutive 0s

Length[
      Select[Strings[{0, 1}, 
          8], (Max[Map[Length, Select[Split[#], First[#] == 0 &]]] < 
              2) &]]

Table[
      Length[Select[
          Strings[{0, 1}, 
            k], (Max[
                  Map[Length, Select[Split[#], First[#] == 0 &]]] < 
                2) &]], {k, 1, 15}]

At most consecutive 00s

Length[
      Select[Strings[{0, 1}, 
          8], (Max[Map[Length, Select[Split[#], First[#] == 0 &]]] < 
              3) &]]

Table[
      Length[Select[
          Strings[{0, 1}, 
            k], (Max[
                  Map[Length, Select[Split[#], First[#] == 0 &]]] < 
                3) &]], {k, 2, 15}]

Clear[sol, n];

    
sol[2] = 4; sol[3] = 7; sol[4] = 13;
sol[n_] := sol[n] = 
        sol[n - 1] + sol[n - 2] + sol[n - 3]

Table[sol[k], {k, 2, 15}]

Solve[(x^2) - x - 1 == 0, x]

{r1, r2, r3} = 
      Simplify[x /. Solve[(x^3) - (x^2) - x - 1 == 0, x]]

r1

Simplify[Im[x /. Solve[(x^3) - (x^2) - x - 1 == 0, x]]]

nn = 2; 
    Chop[NSolve[{x (r1) + y (r2) + z (r3) == 7, 
          x (((r1))^2) + y (((r2))^2) + z (((r3))^2) == 13, 
          x (((r1))^0) + y (((r2))^0) + z (((r3))^0) == 4}, {x, y, 
          z}]]

Chop[
      Table[(x (((r1))^k) + y (((r2))^k) + 
              z (((r3))^k)) /. {x -> 3.8479711061989845`, 
            y -> 0.07601444690050753` + 
                0.011318308963751147` I, 
            z -> 0.07601444690050753` - 
                0.011318308963751146` I}, {k, 0, 
          12}]]

Bride and groom

There are 6 people together with the bride and the groom that are about to take a picture.  Answer the following questions:

Questions

How many different ways that this party can be arranged if they are all to stand next to each other?

The answer is 6! = 720, by the product rule. There are 6 ways to choose the most left person, 5 choices for the next person and so on.

allper6 = Permutations[{a, b, c, d, e, f}];

Length[allper6]

How many ways to arrange the party if the bride and the groom are to stand next to each other.

Consider the bride and the groom as one person. There are 5! = 120 ways to arrange. However, in each such arrangement there are two ways to arrange the bride and the groom.

The code below confirms that. In this code a is the bride and b is the groom.

MemberQ[Partition[{a, b, c, d, e, f}, 2, 1], {a, b}]

MemberQ[Partition[#, 2, 1], {a, b}] &[{a, b, c, d, e, 
        f}]

Length[
      Select[allper6, 
        Or[MemberQ[Partition[#, 2, 1], {a, b}], 
            MemberQ[Partition[#, 2, 1], {b, a}]] &]]

How many ways to arrange the party if thee is exactly one person between the bride and the groom?

4  Length[
        Select[allper6, 
          Or[MemberQ[Partition[#, 3, 1], {a, c, b}], 
              MemberQ[Partition[#, 3, 1], {b, c, a}]] &]]

Length[
      Select[allper6, 
        Or[MemberQ[Partition[#, 3, 1], {a, c, b}], 
            MemberQ[Partition[#, 3, 1], {b, c, a}], 
            MemberQ[Partition[#, 3, 1], {a, d, b}], 
            MemberQ[Partition[#, 3, 1], {b, d, a}], 
            MemberQ[Partition[#, 3, 1], {a, e, b}], 
            MemberQ[Partition[#, 3, 1], {b, e, a}], 
            MemberQ[Partition[#, 3, 1], {a, f, b}], 
            MemberQ[Partition[#, 3, 1], {b, f, a}]] &]]

How many ways to arrange the party in such a way that the bride is to the left of the groom?

Select[{b, a, c, d, e, f}, Or[# == a, # == b] &]

Function[y, Or[y == a, y == b]][a]

Function[y, Or[y == a, y == b]][b]

Select[#, Function[y, Or[y == a, y == b]]] &[{b, a, c, 
        d, e, f}]

Length[
      Select[allper6, (Select[#, 
                Function[y, Or[y == a, y == b]]] == {a, 
                b}) &]]