Introduction to Mathematica

Julius, EIMI

Lecture 3 - based on lectures by J.Harris  (Wolfram Research)

Problem 1 - Implement QuickSort

Goal of QuickSort is to choose a “pivot” element and sort all other elements of the list with respect to the pivot element, and then repeat this process recursively.

?Select

?Flatten

{{1,2},{3,4}}
Flatten[%]

{{1,2},{{3,4},5,6}}
Flatten[%,1]

?Sequence

f[{1,2,3,4}]

Head[{1,2,3,4}]

f[Sequence@@{1,2,3,4}]

{1,2,3,{4,5},6,7}

{1,2,3,Sequence@@{4,5},6,7}

Sequence[f[a,b]]

Sequence@@f[a,b]

Sequence@@{a,b}

{a,b}//FullForm
List[a,b]

Sequence@@List[a,b]

Solution

Clear[qsort]
qsort@{a_,r_}:={r,a}/;r<a
qsort@{a_,r_}:={a,r}
qsort@{}:={}
qsort@{a_,r__}:=Flatten[{Sequence@@qsort@Select[{r},#<a&],a,Sequence@@Select[{r},#==a&],Sequence@@qsort@Select[{r},#>a&]}]

qsort@{2,1}

qsort@{4,5,3,1,2}

qsort[{2,3,4,5,2,2,4,5,67,8}]

Problem 2 - Rank function

Create the rank function which will give the ordering of a set of numbers. For instance rank[{4,5,4,7,8,3}] would rank the items as 1 for 3, 2 for 4, 3 for 5, 4 for 7, 5 for 8, so would yield {2,3,2,4,5,1}

Solution

lst = {6,8,3,4,2}

qsort@lst

?Position

lst

qsort@lst

Position[qsort@lst,2][[1,1]]

rank[ls_List]:=Table[Position[qsort@ls,a][[1,1]],{a,ls}]

rank@{6,8,3,4,2}

rank@{4,5,4,7,8,3}

qsort@{4,5,4,7,8,3}

Position[qsort@{4,5,4,7,8,3},5][[1,1]]

?DeleteDuplicates

Clear[rank]
rank[ls_List]:=Table[Position[DeleteDuplicates[qsort@ls],a][[1,1]],{a,ls}]

rank@{4,5,4,7,8,3}

rank[{2,3,4,5,2,2,4,5,67,8}]

Problem 3 - Implement MyExtract

?Extract

Solution

(({{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}))[[1,2]]

Part[(({{1, 2, 3}, {4, 5, 6}, {7, 8, 9}})),1,2]

ClearAll @ MyExtract

MyExtract[expr_,l_List]:=
Part[expr,Sequence@@l]

MyExtract[expr_,l_List,h_]:=
h@Part[expr,Sequence@@l]

?Optional

Clear[f]
f[a_,b_:0]:={a,b}

f[a,b]

f[a]

MyExtract[expr_,l_List,h_:Identity]:=
h@Part[expr,Sequence@@l]

Part[f[a,b[t,y],c,d],2,1]

Extract[f[a,b[t,y],c,d],{2,1},h]

MyExtract[f[a,b[t,y],c,d],{2,1},h]

?Part

Part[f[a,b[t,y],c,d],{{2},{2,1}}]

Extract[f[a,b[t,y],c,d],{{2},{2,1}}]

MyExtract[f[a,b[t,y],c,d],{{2},{2,1}}]

ClearAll @ MyExtract

MyExtract[expr_,l_List,h_:Identity]:=
h@Part[expr,Sequence@@l]

Extract[f[a,b[t,y],c,d],{2,1},h]

MyExtract[f[a,b[t,y],c,d],{2,1},h]

Extract[f[a,b[t,y],c,d],{{2},{2,1}}]

MyExtract[f[a,b[t,y],c,d],{{2},{2,1}}]

Sequence@@{{2},{2,1}}

Clear[MyExtract]

MyExtract[expr_,l_List]:=
(Part[expr,Sequence@@#]&)/@ l

Extract[f[a,b[t,y],c,d],{{2},{2,1}}]

MyExtract[f[a,b[t,y],c,d],{{2},{2,1}}]

Clear[MyExtract]

MyExtract[expr_,l_List,h_:Identity]:=
h/@(Part[expr,Sequence@@#]&)/@ l

MyExtract[f[a,b[t,y],c,d],{{2},{2,1}},h]

Extract[f[a,b[t,y],c,d],{{2},{2,1}},h]

Problem 4

Define a function GiveFit like FindFit but it instead returns the fully fitted function with the coefficients fully substituted into the fitted function.

Example: if theCoeffs=FindFit[times,a (e^(b x)) +c,{a,b,c},x] returns
{a->1.2436696511782142`*^-6,b->0.4827325992390855`,c->0.0005007324877265724`}
then GiveFit[times,a (e^(b x)) +c,{a,b,c},x] should return
0.0005007324877265724` +1.2436696511782142`*^-6 (e^(0.4827325992390855` x))

Solution

?FindFit

dt = Table[Prime[x],{x,20}]

ff = FindFit[dt,a x Log[b+c x],{a,b,c},x]

a x Log[b+c x]/.ff

GiveFit[data_List,model_,coefs_,x_]:=
model/.FindFit[data,model,coefs,x]

GiveFit[dt,a x Log[b+c x],{a,b,c},x]

Problem 5 - Holding

Create a function children which returns the list of the children of the argument without evaluation. For instance children[h[a,b]]->{a,b} and children[2+2]->{2,2}

?SetAttributes

?HoldAll

Solution

List@@g[a,b]

List@@Power[a,b]

List@@(a + b)

List@@Plus[a,b]

List@@Plus[2 + 2]

?Hold

Hold@Plus[2 , 2]

List@@@Hold@Plus[2 , 2]

Identity@@List@@@Hold@Plus[2 , 2]

ClearAll[children]
SetAttributes[children,HoldAll]
children@a_:=Identity@@ List @@@ Hold@a

children[2 + 2]

children[f[a,b]]

Or

ClearAll[children]
SetAttributes[children,HoldAll]
children@a_:=List @@Unevaluated @ a

children[2 + 2]

children[f[a,b]]

Or

ClearAll[children]
SetAttributes[children,HoldAll]
children@f_[a___]:={a}

children[2 + 2]

children[f[a,b]]