Question No.
1
(a)(i) Do loop
In[ ]:= sum = 0;
Do[sum = sum + 1 / i, {i, 1, 99, 2}];
sum
3 200 355 699 626 285 671 281 379 375 916 142 064 964
Out[ ]=
1 089 380 862 964 257 455 695 840 764 614 254 743 075
(a)(ii) For loop
In[ ]:= For[sum1 = 0; j = 1, j ≤ 99, j = j + 2, sum1 = sum1 + 1 / j]
sum1
3 200 355 699 626 285 671 281 379 375 916 142 064 964
Out[ ]=
1 089 380 862 964 257 455 695 840 764 614 254 743 075
(a)(iii) While loop
In[ ]:= sum2 = 0;
n = 1;
While[ n < 100, sum2 = sum2 + 1 / n; n = n + 2];
sum2
3 200 355 699 626 285 671 281 379 375 916 142 064 964
Out[ ]=
1 089 380 862 964 257 455 695 840 764 614 254 743 075
(b)
n=7
In[ ]:= NSum1 2n , {n, 0, 7}
Out[ ]= 1.99219
When n tends to infinity,
In[ ]:= NSum1 2n , {n, 0, Infinity}
Out[ ]= 2.
(c) Sum(Let n= 10; n>1)
In[ ]:= Sum[1 / j, {n, 1, 10}, {j, 1, n}]
55 991
Out[ ]=
2520
Product(Let n= 10; n>1)
In[ ]:= NProduct[Sum[1 / j, {j, 1, n}], {n, 2, 10}]
Out[ ]= 1871.44
(d)(i)
2 Mathematica Assignment No. 1 B200302063.nb
In[ ]:= Sum[x ^ 2, {x, 1, n}]
1
Out[ ]= n (1 + n) (1 + 2 n)
6
(d)(ii)
In[ ]:= Sum[x ^ 3, {x, 1, n}]
1
Out[ ]= n2 (1 + n)2
4
Question No. 2
(a)(i) Do loop
In[ ]:= factorial = 1;
Do[factorial = factorial * n, {n, 1, 12}]
factorial
Out[ ]= 479 001 600
(a)(ii) For loop
In[ ]:= For[factorial = 1; n = 1, n ≤ 12, n ++, factorial = factorial * n]
factorial
Out[ ]= 479 001 600
(a)(iii) While loop
In[ ]:= factorial = 1;
n = 12;
While[n > 0, factorial = n * factorial; n --]
factorial
Out[ ]= 479 001 600
(b)
Mathematica Assignment No. 1 B200302063.nb 3
In[ ]:= Table[Fibonacci[n], {n, 1, 15}] // TableForm
Out[ ]//TableForm=
1
1
2
3
5
8
13
21
34
55
89
144
233
377
610
The 20th Fibonacci number is:
In[ ]:= Fibonacci[20]
Out[ ]= 6765
(c)
In[ ]:= Do[If[Fibonacci[k] < 1000 && PrimeQ[k] True, Print[k]], {k, 1, 999}]
2
11
13
Question No. 3
(a)Let n= 10
In[ ]:= n = 10;
PrimeQ[n]
Out[ ]= False
Thus, 10 is not a prime number
Again,
Let M=25 (Printing first M primes)
In[ ]:= For[M = 1, M ≤ 25, M ++, Print[Prime[M]]]
4 Mathematica Assignment No. 1 B200302063.nb
11
13
17
19
23
29
31
37
41
43
47
53
59
61
67
71
73
79
83
89
97
(b)M=25
Sum of first M Primes
In[ ]:= Sum[Prime[M], {M, 1, 25}]
Out[ ]= 1060
Product of first M Primes
In[ ]:= Product[Prime[M], {M, 1, 25}]
Out[ ]= 2 305 567 963 945 518 424 753 102 147 331 756 070
now, n=10, M=25; Prime numbers between n & M are:
In[ ]:= Prime[Range[PrimePi[NextPrime[10 - 1]], PrimePi[25]]]
{11, 13, 17, 19, 23}
Mathematica Assignment No. 1 B200302063.nb 5
(c)Let N= 30
In[ ]:= Do[If[PrimeQ[k], Print[k], Print[" ", k]], {k, 1, 30}]
1
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(d)Let n= 42473
Check if n is prime or not:
6 Mathematica Assignment No. 1 B200302063.nb
In[ ]:= PrimeQ[42 473]
Out[ ]= True
So the closest Prime below it is,
In[ ]:= Prime[PrimePi[42 473] - 1]
Out[ ]= 42 467
Thus, the closest prime number below n=42473 is 42467.
Question No. 4
(a)
In[ ]:= list1 = Divisors[12];
SumOfDivisors12 = Total[list1] - Max[list1];
list1
SumOfDivisors12
Out[ ]= {1, 2, 3, 4, 6, 12}
Out[ ]= 16
Thus, 12 is not a perfect number
In[ ]:= list2 = Divisors[24];
SumOfDivisors24 = Total[list2] - Max[list2];
list2
SumOfDivisors24
Out[ ]= {1, 2, 3, 4, 6, 8, 12, 24}
Out[ ]= 36
Thus, 24 is not a perfect number
In[ ]:= list3 = Divisors[28];
SumOfDivisors28 = Total[list3] - Max[list3];
list3
SumOfDivisors28
Out[ ]= {1, 2, 4, 7, 14, 28}
Out[ ]= 28
Thus, 28 is a perfect number.
(b)
In[ ]:= Do[If[(Total[Divisors[k]] - Max[Divisors[k]]) k, Print[k]], {k, 1, 500}]
Mathematica Assignment No. 1 B200302063.nb 7
28
496
(c)
In[ ]:= Do[If[Mod[k, 2] ≠ 0 && Mod[k, 3] ≠ 0 && Mod[k, 5] ≠ 0, Print[k]], {k, 1, 200}]
1
11
13
17
19
23
29
31
37
41
43
47
49
53
59
61
67
71
73
77
79
83
89
91
97
101
103
107
109
113
8 Mathematica Assignment No. 1 B200302063.nb
119
121
127
131
133
137
139
143
149
151
157
161
163
167
169
173
179
181
187
191
193
197
199
(d)
In[ ]:= list4 = {};
Do[If[Mod[k, 13] 0, AppendTo[list4, k]], {k, 1, 100}];
list4
Length[list4]
Out[ ]= {13, 26, 39, 52, 65, 78, 91}
Out[ ]= 7
Thus, there are 7 numbers form 1 to 100 which are divisible by 13.
Mathematica Assignment No. 1 B200302063.nb 9
Question No. 5
In[ ]:= mark[x_] := Which[x < 60, 0, x < 65, 3, x < 70, 4,
x < 75, 5, x < 80, 6, x < 85, 7, x < 90, 8, x < 95, 9, x ≤ 100, 10];
Class = 30;
percentage = Ceiling[(x / Class) * 100];
TableForm[Table[{x, percentage, mark[percentage]}, {x, Class}],
TableHeadings {None, {"Class Number", "Percentage", "Marks"}}, TableAlignments Center]
Out[ ]//TableForm=
Class Number Percentage Marks
1 4 0
2 7 0
3 10 0
4 14 0
5 17 0
6 20 0
7 24 0
8 27 0
9 30 0
10 34 0
11 37 0
12 40 0
13 44 0
14 47 0
15 50 0
16 54 0
17 57 0
18 60 3
19 64 3
20 67 4
21 70 5
22 74 5
23 77 6
24 80 7
25 84 7
26 87 8
27 90 9
28 94 9
29 97 10
30 100 10
Question No. 6
(a)
10 Mathematica Assignment No. 1 B200302063.nb
In[ ]:= list = Table[{x, x ^ 2, x ^ 3}, {x, 1, 20, 2}];
TableForm[list, TableAlignments Center,
TableHeadings {None, {"Odd Integers", "Squares", "Cubes"}}]
Out[ ]//TableForm=
Odd Integers Squares Cubes
1 1 1
3 9 27
5 25 125
7 49 343
9 81 729
11 121 1331
13 169 2197
15 225 3375
17 289 4913
19 361 6859
(b)
In[ ]:= f[c_] := 9 c / 5 + 32;
list1 = Table[{c, N[f[c]]}, {c, 1, 10, 1}];
TableForm[list1, TableDirections Row, TableAlignments Center,
TableHeadings {None, {"Celcius", "Fahrenheit Equivalents"}}]
Out[ ]//TableForm=
Celcius 1 2 3 4 5 6 7 8 9 10
Fahrenheit Equivalents 33.8 35.6 37.4 39.2 41. 42.8 44.6 46.4 48.2 50.
(c)
In[27]:= p = 1000;
r = .06;
a = p (1 + r / 4) ^ (4 k);
b = p (1 + r / 12) ^ (12 k);
c = p (1 + r / 365) ^ (365 k);
d = p * Exp[r * k];
kk = PaddedForm[k, 2];
aa = PaddedForm[a, {7, 2}];
bb = PaddedForm[b, {7, 2}];
cc = PaddedForm[c, {7, 2}];
dd = PaddedForm[d, {7, 2}];
list = Table[{kk, aa, bb, cc, dd}, {k, 1, 5}];
TableForm[list,
TableHeadings {None, {"year", " quarterly", "monthly", "daily", "continuously"}}]
Out[39]//TableForm=
year quarterly monthly daily continuously
1 1061.36 1061.68 1061.83 1061.84
2 1126.49 1127.16 1127.49 1127.50
3 1195.62 1196.68 1197.20 1197.22
4 1268.99 1270.49 1271.22 1271.25
5 1346.86 1348.85 1349.83 1349.86