dividesRelation@n_IntegerD :=
Select@Tuples@Range@nD, 2D, Divisible@ð@@2DD, ð@@1DDD &D;
div6 = dividesRelation@6D;
div30 = dividesRelation@30D;
div12 = dividesRelation@12D;
dividesRelation@A_: 8_Integer<D := Select@Tuples@A, 2D, Divisible@ð@@2DD, ð@@1DDD &D;
Optional::opdef : The default value for the optional argument A_ : 8_Integer< contains a pattern.
Optional::opdef : The default value for the optional argument A_ : 8_Integer< contains a pattern.
divisorLattice@n_IntegerD := dividesRelation@Divisors@nDD;
divisorLattice@10D
881, 1<, 81, 2<, 81, 5<, 81, 10<, 82, 2<, 82, 10<, 85, 5<, 85, 10<, 810, 10<<
fig8A = 88"a", "a"<, 8"a", "b"<, 8"a", "c"<, 8"a", "d"<, 8"a", "e"<, 8"a", "f"<,
8"b", "b"<, 8"b", "c"<, 8"b", "d"<, 8"b", "e"<, 8"b", "f"<, 8"c", "c"<, 8"c", "e"<,
8"c", "f"<, 8"d", "d"<, 8"d", "e"<, 8"d", "f"<, 8"e", "e"<, 8"e", "f"<, 8"f", "f"<<;
fig10 = 88"A", "A"<, 8"A", "B"<, 8"A", "D"<, 8"A", "F"<,
8"A", "G"<, 8"B", "B"<, 8"B", "D"<, 8"B", "F"<, 8"B", "G"<, 8"C", "C"<,
8"C", "B"<, 8"C", "D"<, 8"C", "F"<, 8"C", "G"<, 8"D", "D"<, 8"D", "G"<,
8"E", "E"<, 8"E", "F"<, 8"E", "G"<, 8"F", "F"<, 8"F", "G"<, 8"G", "G"<<;
findDomain@R_D := Union@Flatten@R, 1DD;
coversQ@R_, 8x_, y_<D := Module@8z, checkSet<,
Catch@
If@x y, Throw@FalseDD;
If@! MemberQ@R, 8x, y<D, Throw@FalseDD;
checkSet = Complement@findDomain@RD, 8x, y<D;
Do@If@MemberQ@R, 8x, z<D && MemberQ@R, 8z, y<D, Throw@FalseDD
, 8z, checkSet<D;
Throw@TrueD
D
D
coveringRelation@R_D := Select@R, coversQ@R, ðD &D
S1 = coveringRelation@
881, 1<, 81, 2<, 81, 3<, 81, 4<, 82, 2<, 82, 3<, 82, 4<, 83, 3<, 83, 4<, 84, 4<<D;
coveringRelation@divisorLattice@30DD;
coveringRelation@divisorLattice@30DD;
hasseDiagram@R_D := Module@8edges<,
edges = coveringRelation@RD . 8a_, b_< ® Rule@b, aD;
LayeredGraphPlot@edges, VertexLabeling ® TrueD
D;
2 practical3.nb
hasseDiagram@divisorLattice@21DD
Complement::heads : Heads List and findDomain at positions 2 and 1 are expected to be the same.
Complement::heads : Heads List and findDomain at positions 2 and 1 are expected to be the same.
Do::iterb : Iterator 9z$6558, checkSet$6558= does not have appropriate bounds.
Complement::heads : Heads List and findDomain at positions 2 and 1 are expected to be the same.
General::stop : Further output of Complement::heads will be suppressed during this calculation.
Do::iterb : Iterator 9z$7498, checkSet$7498= does not have appropriate bounds.
Do::iterb : Iterator 9z$8285, checkSet$8285= does not have appropriate bounds.
General::stop : Further output of Do::iterb will be suppressed during this calculation.
21
3 7
1
practical3.nb 3
hasseDiagram@divisorLattice@30DD
30
6 10 15
2 3 5
1
4 practical3.nb
hasseDiagram@divisorLattice@6DD
2 3
hasseDiagram@divisorLattice@7DD
1
practical3.nb 5
hasseDiagram@fig8AD
c d
a
6 practical3.nb
h1 = hasseDiagram@fig10D
F D
E B
A C
fig11 = 88"A", "A"<, 8"A", "B"<, 8"A", "D"<, 8"B", "B"<,
8"B", "D"<, 8"C", "C"<, 8"C", "B"<, 8"C", "D"<, 8"D", "D"<<;
practical3.nb 7
hasseDiagram@fig11D
A C
fig12 = 88"a", "a"<, 8"a", "b"<, 8"a", "c"<, 8"a", "e"<,
8"a", "f"<, 8"b", "b"<, 8"b", "c"<, 8"b", "e"<, 8"b", "f"<, 8"c", "c"<,
8"c", "e"<, 8"c", "f"<, 8"e", "e"<, 8"e", "f"<, 8"f", "f"<<;
8 practical3.nb
hasseDiagram@fig12D
fig13 = 88"1", "1"<, 8"1", "2"<, 8"1", "3"<, 8"1", "4"<,
8"1", "5"<, 8"2", "2"<, 8"2", "3"<, 8"2", "4"<, 8"2", "5"<, 8"3", "3"<,
8"3", "4"<, 8"3", "5"<, 8"4", "4"<, 8"4", "5"<, 8"5", "5"<<;
practical3.nb 9
hasseDiagram@fig13D
minimalElements@R_, S_ListD := Module@8M, s, t<,
M = S;
Do@
Do@
If@MemberQ@R, 8t, s<D, M = Complement@M, 8s<DD
, 8t, Complement@S, 8s<D<D
, 8s, S<D;
M
D
10 practical3.nb
hasseDiagram@div6D
4 6
5 2 3
minimalElements@div6, Range@6DD
minimalElements@881, 1<, 81, 2<, 81, 3<, 81, 4<, 81, 5<, 81, 6<, 82, 2<,
82, 4<, 82, 6<, 83, 3<, 83, 6<, 84, 4<, 85, 5<, 86, 6<<, 81, 2, 3, 4, 5, 6<D
minimalElements@div6, Range@2, 6DD
82, 3, 5<
hasseDiagram@div30D
16 24
28 8 20 12 30 18
22 14 21 26 4 10 25 6 15
11 17 19 23 29 7 13 2 5 3
minimalElements@div30, Range@30DD
81<
practical3.nb 11
minimalElements@div30, Range@10, 30DD
810, 11, 12, 13, 14, 15, 16, 17, 18, 19, 21, 23, 25, 27, 29<
maximalElements@R_, S_ListD := minimalElements@inverseRelation@RD, SD
maximalElements@div6, Range@6DD
81, 2, 3, 4, 5, 6<
maximalElements@div30, Range@30DD
81, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30<
hasseDiagram@div12D
8 12
10 4 6 9
5 7 11 2 3
minimalElements@div30, Range@12DD
81<
minimalElements@div30, Range@4, 12DD
84, 5, 6, 7, 9, 11<
maximalElements@div12, Range@12DD
87, 8, 9, 10, 11, 12<
maximalElements@div12, Range@4, 12DD
87, 8, 9, 10, 11, 12<
upperBoundQ@R_, S_List, u_D := Module@8s<,
Catch@
Do@If@! MemberQ@R, 8s, u<D, Throw@FalseDD
, 8s, S<D;
Throw@TrueD
D
D
12 practical3.nb
upperBounds@R_, S_ListD := Module@8domR, d, U = 8<<,
domR = findDomain@RD;
Do@If@upperBoundQ@R, S, dD, AppendTo@U, dDD
, 8d, domR<D;
U
D
upperBounds@div6, 81, 2<D
82, 4, 6<
upperBounds@div12, 81, 2, 3<D
86, 12<
upperBounds@div30, 81, 2<D
82, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30<
leastUpperBound@R_ ? partialOrderQ, S_ListD := Module@8U, M<,
U = upperBounds@R, SD;
M = minimalElements@R, UD;
If@Length@MD ¹ 1, Null, M@@1DDD
D
leastUpperBound@div6, 81, 2<D
2
leastUpperBound@div6, 81, 2, 3<D
6
leastUpperBound@div12, 81, 2, 3, 4<D
12
leastUpperBound@div30, 81, 2, 3, 5<D
30
leastUpperBound@div30, 81, 2, 3, 4<D
12