1BindGlobal( "ClearGreen",
2  function( latt )
3  local lev, class, vert, sel;
4    sel := Selected( latt );
5    for lev in Levels( latt ) do
6      for class in Classes( latt, lev ) do
7        for vert in Vertices( latt, lev, class ) do
8	  if not( vert in sel ) then
9		Recolor( latt, vert, COLORS.black );
10	  fi;
11	od;
12      od;
13    od;
14end );
15
16InstallMethod(
17	ChooseShape,
18	"NRIs",
19	true,
20	[IsGraphicPosetRep and IsGraphicIdealLattice,IsRecord],
21	0,
22  function( latt, data )
23  local ideal;
24    ideal := data.ideal;
25    if HasIsNearRingIdeal( ideal ) and
26	IsNearRingIdeal( ideal ) then
27		return "circle"; 		# two-sided ideal
28    elif HasIsNearRingLeftIdeal( ideal ) and
29	IsNearRingLeftIdeal( ideal ) then
30		return "diamond";		# left ideal
31    else
32		return "rectangle";
33    fi;
34end );
35
36InstallMethod(
37	ChooseLevel,
38	"NRIs",
39	true,
40	[IsGraphicPosetRep and IsGraphicIdealLattice, IsRecord],
41	0,
42  function( latt, data )
43    return Size( data.ideal );
44end );
45
46InstallMethod(
47	GraphicIdealLattice,
48	true,
49	[IsNearRing,IsString],
50	0,
51  function ( nr, which )
52  local latt, v, levels, vertices, i, j, union,
53	ups, newups, n, newvertex, ideals, I, funcclose;
54
55    latt := GraphicPoset( "", 800, 600 );
56
57    SetFilterObj( latt, IsGraphicIdealLattice );
58    # which ideals should be shown ?
59    ideals := [];
60    if 'r' in which then
61	SetTitle( latt, "Computing right ideals ..." );
62	ideals := NearRingRightIdeals( nr );
63    fi;
64    if 'l' in which then
65	SetTitle( latt, "Computing left ideals ..." );
66	ideals := Union( ideals, NearRingLeftIdeals( nr ) );
67    fi;
68    if 'i' in which and not( 'l' in which or 'r' in which ) then
69	SetTitle( latt, "Computing two-sided ideals ..." );
70	ideals := NearRingIdeals( nr );
71    fi;
72
73    if ideals=[] then
74	Error( "no ideal type selected, select 'l', 'r' or 'i'" );
75    fi;
76
77    SetTitle( latt, "Computing covers ..." );
78
79    n := Length(ideals);
80
81    ups := List( [1..n], i -> Filtered( [1..n], j ->
82	RemInt( Size(ideals[j]), Size(ideals[i]) ) = 0 and
83	j<>i and
84	IsSubset( ideals[j], ideals[i] ) ) );
85    for i in [1..n] do
86      union := [];
87      for j in ups[i] do
88	union := Union( union, ups[j] );
89        ups[i] := Difference( ups[i], union );
90      od;
91    od;
92
93    if HasName( nr ) then
94	    SetTitle( latt,
95		Concatenation( "Ideal lattice of ", Name(nr) ) );
96    else
97	    SetTitle( latt,
98		"Ideal lattice of nearring" );
99    fi;
100
101    i := 0; vertices := [];
102    for I in ideals do
103	i := i+1;
104	CreateLevel( latt, Size(I) );
105	Add( vertices, Vertex( latt, rec( ideal := I ),
106			rec( label := String( i )
107			) ) );
108    od;
109    for i in [1..n] do
110      for j in ups[i] do
111	Edge( latt, vertices[i], vertices[j] );
112      od;
113    od;
114
115    Menu( latt, "Ideals",
116	[
117	"Intersection",
118	"Closure",
119	"Commutator",
120	"Covers",
121	"Subcovers",
122	"Ideal type",
123	],
124	[
125	"forsubset",
126	"forsubset",
127	"forsubset",
128	"forone",
129	"forone",
130	"forsubset"
131	],
132	[
133	# Intersection
134	function(arg)
135	  local sel, C, latt;
136	    latt := arg[1];
137	    sel := Selected( latt );
138	    C := Intersection( List( sel, I -> I!.data.ideal ) );
139	    C := WhichVertex( latt, C,
140		function( N, R ) return R.ideal = N; end );
141	    ClearGreen( latt );
142	    Recolor( latt, C, COLORS.green );
143	end,
144
145	# Closure
146	function(arg)
147	  local sel, I, C, latt;
148	    latt := arg[1];
149	    sel := Selected( latt );
150	    sel := List( sel, I -> I!.data.ideal );
151	    C := sel[1];
152	    for I in sel{[2..Length(sel)]} do
153	      C := ClosureNearRingIdeal( C, I );
154	    od;
155	    C := WhichVertex( latt, C,
156		function( N, R ) return R.ideal = N; end );
157	    ClearGreen( latt );
158	    Recolor( latt, C, COLORS.green );
159	end,
160
161	# Commutator
162	function(arg)
163	  local sel, I, J, C, latt;
164	    latt := arg[1];
165	    sel := Selected( latt );
166	    if Length( sel )=1 then
167		I := sel[1]; J := sel[1];
168	    elif Length( sel )=2 then
169	        I := sel[1]; J := sel[2];
170	    else
171		return;
172	    fi;
173	    C := NearRingCommutator(I!.data.ideal,J!.data.ideal);
174	    C := WhichVertex( latt, C,
175		function( N, R ) return R.ideal = N; end );
176	    ClearGreen( latt );
177	    Recolor( latt, C, COLORS.green );
178	end,
179
180	# Covers
181	function(arg)
182	  local V, I, Cs, latt;
183	    latt := arg[1];
184	    I := Selected(latt)[1];
185	    Cs := MaximalIn( latt, I );
186	    ClearGreen( latt );
187	    for V in Cs do
188	      Recolor( latt, V, COLORS.green );
189	    od;
190	end,
191
192	# Subcovers
193	function(arg)
194	  local V, I, Cs, latt;
195	    latt := arg[1];
196	    I := Selected(latt)[1];
197	    Cs := Maximals( latt, I );
198	    ClearGreen( latt );
199	    for V in Cs do
200	      Recolor( latt, V, COLORS.green );
201	    od;
202	end,
203
204	# Ideal type
205	function(arg)
206	local latt, sel, vert;
207	  latt := arg[1];
208	  sel := Selected( latt );
209	  for vert in sel do
210	    if IsNearRingIdeal( vert!.data.ideal ) then
211		Reshape( latt, vert, "circle" );
212            fi;
213	  od;
214	end
215	] );
216
217  # close text selector
218  funcclose := function( sel, bt )
219    Close(sel);
220    return true;
221  end;
222
223    InstallPopup( latt,
224	function( sheet, vert, x, y )
225	local id, text;
226#          text := Concatenation( "LibraryNearRing( ",Name(id[1]),", ",String(id[2])," )");
227	  sheet!.infobox := TextSelector(
228	Concatenation( "Information on near ring ideal ",vert!.label ),
229	[
230	  "Size : ",
231	function(x,y)
232	  Relabel( x, 1, Concatenation( "Size : ", String(Size(vert!.data.ideal)) ) );
233	  return Size(vert!.data.ideal);
234	end,
235
236	  "twosided ideal : ",
237	function(x,y)
238	  Relabel( x, 2, Concatenation( "twosided ideal : ",
239		String( IsNearRingIdeal( vert!.data.ideal ) ) ) );
240	  if IsNearRingIdeal( vert!.data.ideal ) then
241		Reshape( latt, vert, "circle" );
242          fi;
243	  return IsNearRingIdeal( vert!.data.ideal );
244	end,
245
246	  "Factor isomorphic to",
247	function(x,y)
248	local factor, id;
249	  factor := FactorNearRing( Parent(vert!.data.ideal),
250					vert!.data.ideal );
251	  if Size(factor) > 15 then
252		return factor;
253	  else
254		id := IdLibraryNearRing( factor );
255		Relabel( x, 3, Concatenation( "Factor isomorphic to ",
256		"LibraryNearRing( ",Name(id[1]),", ",String(id[2])," )") );
257		return factor;
258	  fi;
259	end,
260
261	  "Export ideal to GAP",
262	function(x,y) return vert!.data.ideal; end
263	],
264
265	[ "close", funcclose ] );
266	end
267	);
268    return latt;
269end);
270
271InstallMethod(
272	CompareLevels,
273	true,
274	[ IsGraphicPosetRep and IsGraphicIdealLattice, IsInt, IsInt ],
275	0,
276  function( poset, a, b )
277    if a < b then
278	return 1;
279    elif a > b then
280	return -1;
281    else
282	return 0;
283    fi;
284  end);
285
286