MONADS

This Mathematica notebook is licensed under a MouseOver 
It creates the demonstrations used in my post Monads for High School II.

I hope anyone interested will feel free to improve this work and to use it in their own publications and coursework.

Presentation

basesty[list_]:=Framed[Style[list,Medium, 12, FontFamily->"Arial",Background->White]]

basesty[Grid[{{1,22,134}}]]

test1=basesty[Grid[{{1,22,134}}]]

cartouche[list_]:=basesty[Grid[{list}]]

cartouche[{3,5,7}]

listcar[list_,place_]:=Text[cartouche[list],place]

listcar[{4,66,232,5},{2,2}]

f[x_]:=Graphics[Text[({{x, 66, 232, 5}}),{2,2}]];f[5]

Thick style

thicksty[list_]:=Style[Grid[{list},Frame->True,FrameStyle->Directive[Thick]],Bold, 12, FontFamily->"Arial",Background->White]

thicksty[{1,22,134}]

testthick2=thicksty[{1,22,134}]

testthick3=thicksty[{5,7,2,2,2,2,2,2,2}]

listthicky[list_,place_]:=Text[thicksty[list],place]

Joining lists

Illustrations of joining lists

DONT KILL THIS

Manipulate[
Graphics[
If[d<.675,
{
listcar[{2,12,7},{d,0}],
listcar[{5,7},{2-d,0}]
},
{
listcar[{2,12,7,5,7},{.93,0}]
}
],
PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200,
AspectRatio->Automatic
],
{{d,.6,""},.6,.77},
ControlPlacement->Bottom,
Paneled->False,SaveDefinitions->True
]

THIS WORKS

Manipulate[
If[b,
DynamicModule[{d=.63},
Dynamic[
(If[d<.68,(d=d+.005;d)];
Graphics[
If[d<.675,
{listcar[{2,12,7},{d,0}],
listcar[{5,7},{2-d,0}]},
{listcar[{2,12,7,5,7},{.93,0}]}
],
PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200
]
)
]
],
Graphics[
{listcar[{2,12,7},{.63,0}],
listcar[{5,7},{2-.63,0}]},PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200, AspectRatio->Automatic
]
],{{b,False,"Join"},{True,False},ControlType->RadioButtonBar},
Paneled->False,SaveDefinitions->True
]

Graphics[
{listcar[{2,12,7},{.63,0}],
listcar[{5,7},{2-.63,0}]},PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200, AspectRatio->Automatic
]

Working version of “Join”

Manipulate[
If[b=="Join",
DynamicModule[{d=.63},
Dynamic[
(If[d<.68,(d=d+.005;d)];
Graphics[
If[d<.675,
{listcar[{2,12,7},{d,0}],
listcar[{5,7},{2-d,0}]},
{listcar[{2,12,7,5,7},{.93,0}]}
],
PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200
]
)
]
],
Graphics[
{listcar[{2,12,7},{.63,0}],
listcar[{5,7},{2-.63,0}]},PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200, AspectRatio->Automatic
]
],{{b,"Reset",""},{"Join","Reset"}},
Paneled->False,ControlPlacement->Left,SaveDefinitions->True
]

This is join1.cdf

Manipulate[
If[b=="Join",
DynamicModule[{d=.63},
Dynamic[
(If[d<.68,(d=d+.005;d)];
Graphics[
If[d<.675,
{listcar[{2,12,7},{d,0}],
listcar[{5,7},{2-d,0}]},
{listcar[{2,12,7,5,7},{.93,0}]}
],
PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200
]
)
]
],
Graphics[
{listcar[{2,12,7},{.63,0}],
listcar[{5,7},{2-.63,0}]},PlotRange->{{-.5,2.5},{-.2,.2}},
ImageSize->200, AspectRatio->Automatic
]
],{{b,"Reset",""},{"Join","Reset"}},
Paneled->False,ControlPlacement->Left,SaveDefinitions->True
]

Join2

op[x_,loc_]:=Text[Style[x,13,Bold,Background->White,FontFamily->"Arial"],loc]

op[x_,loc_,weight_]:=Text[Style[x,13,weight,Background->White,FontFamily->"Arial"],loc]

op[x_,loc_,weight_,color_]:=Text[Style[x,13,weight,color,Background->White,FontFamily->"Arial"],loc]

edge[loc1_,loc2_,sf_]:=Arrow[{loc1,loc2},Scaled[sf]]

spd=.0009

cartouche[{2,12,7}]

Remove[uu]

uu=cartouche[{2,12,7}]

The operation Join

This is Joinex1.cdf

ss=0;If [ss>0,uu,"join"]

"join"

joinex:=Manipulate[Graphics[{
Arrowheads[0],
op[If [s>0,cartouche[{2,12,7,5,7}],Text[Framed[Style["join",FontFamily->"Arial"]]]],{-1/2,2}],
op[cartouche[{2,12,7}],{-1,1}],
op[cartouche[{5,7}],{0,1}],
edge[{-1/2,2},{-1,1},.0005],
edge[{-1/2,2},{0,1},.0005]},
Background->White,ImageSize->120, AspectRatio->1],{{s,0,""},{0->"Reset",1->"Evaluate"}},Paneled->False,ControlPlacement->Left,SaveDefinitions->True]

joinex

Join is associative

li1=cartouche[{2,12,7}]

li2=cartouche[{5,7}]

li3=cartouche[{7,9,8}]

li12=cartouche[{2,12,7,5,7}]

li23=cartouche[{5,7,7,9,8}]

liall=cartouche[{2,12,7,5,7,7,9,8}]

This is  Joinassoc.cdf

liall

basestyblue[list_]:=Framed[Style[list,Medium, 12, FontFamily->"Arial",Background->White],FrameStyle->{Blue}]

basestyblue[Grid[{{liall}}]]

Rasterize[basestyblue[Grid[{{liall}}]]]

Manipulate[
Row[{
Graphics[
{
Arrowheads[0],
op[If [s>1,liall,"Join"],{-1/2,2}],
op[If[s>0,li12,"Join"],{-1,1}],
op[li3,{0,1}],
op[li1,{-1.5,0}],
op[li2,{-.5,0}],
edge[{-.5,2},{-1,1},.0007],
edge[{-.5,2},{0,1},.0007],
edge[{-1,1},{-1.5,0},.0007],
edge[{-1,1},{-.5,0},.0007]},
Background->White,ImageSize->170, AspectRatio->1],"     ",
Graphics[{
Arrowheads[0],
op[If [s>1,liall,"Join"],{-1/2,2}],
op[If[s>0,li23,"Join"],{0,1}],
op[li1,{-1,1}],
op[li2,{-.5,0}],
op[li3,{.5,0}],
edge[{-1/2,2},{-1,1},.0007],
edge[{-1/2,2},{0,1},.0007],edge[{0,1},{-.5,0},.0007],edge[{0,1},{.5,0},.0007]},
Background->White,ImageSize->170, AspectRatio->1]}],{{s,0,"Steps"},{0->"Reset",1,2}},
Paneled->False,
ControlPlacement->Left,
SaveDefinitions->True]

plus3b[s_,a_,b_,c_]:=Graphics[{
Arrowheads[0],
op[If [s>1,a+b+c,"Plus"],{-1/2,2}],
op[If[s>0,b+c,"Plus"],{0,1}],
op[a,{-1,1}],
op[b,{-.5,0}],
op[c,{.5,0}],
edge[{-1/2,2},{-1,1},spd],
edge[{-1/2,2},{0,1},spd],edge[{0,1},{-.5,0},spd],edge[{0,1},{.5,0},spd]},
Background->White,ImageSize->80, AspectRatio->1]

This is joinexample1.cdf

Manipulate[
Graphics[
If[d<.8,
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.6+d,-.45},{5.5-.85d,.45}],
Thick,Black,Opacity[1],
listcar[{1,2,2},{-.6+.98d,0}],
listcar[{4,3},{.95+.5d,0}],
listcar[{3,2,3},{2.5,0}],
listcar[{4},{3.8-.5d,0}],
listcar[{7,7},{4.8-.88d,0}]
},
{
Black,Opacity[1],
listcar[{1,2,2,4,3,3,2,3,4,7,7},{2,0}]
}
],
PlotRange->{{-3,6},{-.5,.5}},
ImageSize->300,AspectRatio->Automatic
],{{d,0,"join"},0,.8},
ControlPlacement->Bottom,
Paneled->False,SaveDefinitions->True]

Joining lists of lists

Version with slider

< script type = "text/javascript" src = "http://www.wolfram.com/cdf-player/plugin/v2.1/cdfplugin.js" > < /script > < script type = "text/javascript" > var cdf = new cdfplugin ();
cdf.setDefaultContent (' < a href = "http://www.wolfram.com/cdf-player/" > < img src = "joinlistoflists.png"/ > < /a > ');
cdf.embed (' http : // www.abstractmath.org/Mathematica/joinlistoflists.cdf', 343, 126);
< /script >

Manipulate[
Graphics[
If[b=="inside first",
If[d<.2,
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.8,-.45},{1.5,.45}],
Rectangle[
{1.9,-.45},{5.8,.45}],
Black,Opacity[1],
listcar[{1,2,2},{-.8+d,0}],
listcar[{4,3},{.75-d,0}],
listcar[{3,2,3},{2.8+1.4d,0}],
listcar[{4},{4,0}],
listcar[{7,7},{5-1.5d,0}]
},
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.8,-.45},{1.5,.45}],
Rectangle[
{1.9,-.45},{5.6,.45}],
Black,Opacity[1],
listcar[{1,2,2,4,3},{-.1,0}],
listcar[{3,2,3,4,7,7},{3.8,0}]
}
],
If[d<.2,
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.8+d,-.45},{1.5+d,.45}],
Rectangle[
{1.9-d,-.45},{5.8-d,.45}],
Black,Opacity[1],
listcar[{1,2,2},{-.8+d,0}],
listcar[{4,3},{.75+d,0}],
listcar[{3,2,3},{2.8-d,0}],
listcar[{4},{4-d,0}],
listcar[{7,7},{5-d,0}]
},
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.7+.198,-.45},{5.8-.198,.45}],
Black,Opacity[1],
listcar[{1,2,2},{-.8+.198,0}],
listcar[{4,3},{.75+.198,0}],
listcar[{3,2,3},{2.7-.198,0}],
listcar[{4},{4-.198,0}],
listcar[{7,7},{5-.198,0}]
}
]
],
PlotRange->{{-3,6},{-.5,.5}},
ImageSize->300
],
{{b,"inside first","order"},{"inside first","outside first"},ControlType->RadioButtonBar},
{{d,0,"join"},0,.21},
ControlPlacement->Bottom,
Paneled->False,SaveDefinitions->True
]

Version with button

Manipulate[
Graphics[
If[b=="inside first",
If[d==0,
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[{-1.8,-.45},{1.5,.45}],
Rectangle[{1.9,-.45},{5.8,.45}],Black,Opacity[1],
listcar[{1,2,2},{-.8+d,0}],listcar[{4,3},{.75-d,0}],listcar[{3,2,3},{2.8+1.4d,0}],listcar[{4},{4,0}],listcar[{7,7},{5-1.5d,0}]
},
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.8,-.45},{1.5,.45}],
Rectangle[
{1.9,-.45},{5.6,.45}],
Black,Opacity[1],
listcar[{1,2,2,4,3},{-.1,0}],
listcar[{3,2,3,4,7,7},{3.8,0}]
}
],
If[d==0,
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[{-1.8+d,-.45},{1.5+d,.45}],
Rectangle[{1.9-d,-.45},{5.8-d,.45}],Black,Opacity[1],
listcar[{1,2,2},{-.8+d,0}],listcar[{4,3},{.75+d,0}],
listcar[{3,2,3},{2.8-d,0}],listcar[{4},{4-d,0}],
listcar[{7,7},{5-d,0}]
},
{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[
{-1.7+.198,-.45},{5.8-.198,.45}],
Black,Opacity[1],
listcar[{1,2,2},{-.8+.198,0}],listcar[{4,3},{.75+.198,0}],
listcar[{3,2,3},{2.7-.198,0}],listcar[{4},{4-.198,0}],
listcar[{7,7},{5-.198,0}]
}
]
],
PlotRange->{{-3,6},{-.5,.5}},
ImageSize->300
],
{{b,"inside first","order"},{"inside first","outside first"},ControlType->RadioButtonBar},
{{d,0,""},{0->"Reset",.2->"Evaluate"},ControlType->RadioButtonBar},
ControlPlacement->Bottom,
Paneled->False,SaveDefinitions->True
]

Show answers separately

sosstart:=
Graphics[
{White,Opacity[0],EdgeForm[{Thick,Darker[Green]}],
Rectangle[{-2,-.6},{6,.62}],
EdgeForm[{Blue}],EdgeForm[{Thick,Blue}],
Rectangle[{-1.8,-.45},{1.5,.45}],
Rectangle[{1.9,-.45},{5.8,.45}],Black,Opacity[1],
listcar[{1,2,2},{-.8,0}],listcar[{4,3},{.75,0}],listcar[{3,2,3},{2.8,0}],listcar[{4},{4,0}],listcar[{7,7},{5,0}]},PlotRange->{{-2.2,6.4},{-.65,.65}},
ImageSize->300]

sosstart

sosinsidefirst:=Graphics[{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[{-1.3,-.5},{4.2,.5}],Black,Opacity[1],
listcar[{1,2,2,4,3},{0,0}],
listcar[{3,2,3,4,7,7},{2.6,0}]},PlotRange->{{-1.8,6},{-.65,.65}},
ImageSize->300]

sosinsidefirst

sosoutsidefirst:=Graphics[{White,Opacity[0],EdgeForm[{Thick,Blue}],
Rectangle[{-1.7+.198,-.5},{5.8-.198,.5}],Black,Opacity[1],
listcar[{1,2,2},{-.8+.198,0}],listcar[{4,3},{.75+.198,0}],
listcar[{3,2,3},{2.7-.198,0}],listcar[{4},{4-.198,0}],
listcar[{7,7},{5-.198,0}]},PlotRange->{{-3,6},{-.65,.65}},
ImageSize->300]

sosoutsidefirst

sosend:=Graphics[{Opacity[1],listcar[{1,2,2,4,3,3,2,3,4,7,7},{0,0}]},PlotRange->{{-3,6},{-.5,.5}},
ImageSize->300]

sosend

Make diagram

alabel[name_,pos_]:=Text[Style[Framed[name],FontSize->12,FontFamily->"Arial"],Scaled[pos],Background->White]

myarr[pos1_,pos2_,setback_]:=Arrow[{Scaled[pos1],Scaled[pos2]},Scaled[setback]]

Remove[m1,c1]

m1="join inside first"

"join inside first"

m2="join outside first"

"join outside first"

m3="join"

The diagram

Graphics[
{Arrowheads[.03],,myarr[{0,0},{.5,1},.0012],myarr[{0,0},{.5,-1},.0012],myarr[{.5,1},{1,.15},.0012],myarr[{.5,-1},{1,-.15},.001],alabel[m1,.5({0,0}+{.5,1})],alabel[m2,.5({0,0}+{.5,-1})],alabel[m3 ,.5({.5,1}+{1,.15})],
alabel[m3,.5({.5,-1}+{1,-.15})],
Inset[sosstart,Scaled[{0,0}]],Inset[sosinsidefirst,Scaled[{.5,1}]],Inset[sosoutsidefirst,Scaled[{.42,-1}]],Inset[sosend,Scaled[{1,.15}]],Inset[sosend,Scaled[{1,-.15}]]
},
AspectRatio->.3,ImageSize->700
]