1 #include "def.h"
2 #include "macro.h"
3
4 /* pre version of graph */
5
6 /* grabasic.c */
7 /* AK 090889 */
8
9 #ifdef GRAPHTRUE
s_gr_k(a)10 OBJECTKIND s_gr_k(a) OP a;
11 /* AK 210889 */ /* AK 210891 V1.3 */
12 {
13 OBJECTSELF b;
14 b = s_o_s(a);
15 return(b.ob_graph->gr_kind);
16 }
17 #endif /* GRAPHTRUE */
18
19 #ifdef GRAPHTRUE
s_gr_s(a)20 OP s_gr_s(a) OP a;
21 /* AK 210889 */ /* AK 210891 V1.3 */
22 {
23 OBJECTSELF b;
24 b = s_o_s(a);
25 return(b.ob_graph->gr_self);
26 }
27 #endif /* GRAPHTRUE */
28
29 #ifdef GRAPHTRUE
c_gr_s(a,c)30 INT c_gr_s(a,c) OP a,c;
31 /* AK 210889 */ /* AK 210891 V1.3 */
32 {
33 OBJECTSELF b;
34 b = s_o_s(a);
35 b.ob_graph->gr_self = c;
36 return(OK);
37 }
38 #endif
39
40 #ifdef GRAPHTRUE
c_gr_k(a,c)41 INT c_gr_k(a,c) OP a; OBJECTKIND c;
42 /* change_graph_kind */
43 /* AK 210889 */ /* AK 210891 V1.3 */
44 {
45 OBJECTSELF b;
46 b = s_o_s(a);
47 (b.ob_graph)->gr_kind = c;
48 return(OK);
49 }
50 #endif
51
m_sk_gr(self,kind,erg)52 INT m_sk_gr(self,kind,erg) OP self,erg; OBJECTKIND kind;
53 /* make_self_kind_graph */
54 /* AK 210889 */ /* AK 210891 V1.3 */
55 {
56 #ifdef GRAPHTRUE
57 struct graph *mallocerg;
58
59 mallocerg = (struct graph *) malloc(sizeof(struct graph));
60
61 if (mallocerg == NULL) {
62 error("m_sk_gr:no memory");
63 return(ERROR);
64 }
65
66 c_o_s(erg,mallocerg);
67 c_o_k(erg,GRAPH);
68 c_gr_k(erg,kind);
69 c_gr_s(erg,self);
70 return(OK);
71 #else
72 error("m_sk_gr:GRAPH not available");
73 return(ERROR);
74 #endif
75 }
76
77 #ifdef GRAPHTRUE
s_gr_kn(a)78 OP s_gr_kn(a) OP a;
79 /* select_graph_knotenliste */
80 /* AK 210889 */ /* AK 210891 V1.3 */
81 {
82
83 /* die knoten elemente sind das erste vector element im self vector */
84 OP h = s_gr_s(a);
85 if (s_o_k(h) != VECTOR) {
86 error("s_gr_kn:not VECTOR");
87 return(NULL);
88 }
89
90 return(s_v_i(h,0L));
91 }
92 #endif
93
s_gr_kni(a,i)94 OP s_gr_kni(a,i) OP a; INT i;
95 /* select_graph_knotenliste das ite element*/
96 /* AK 210889 */ /* AK 210891 V1.3 */
97 {
98 #ifdef GRAPHTRUE
99 return(s_v_i(s_gr_kn(a),i));
100 #else
101 error("s_gr_kni:GRAPH not available");
102 return(NULL);
103 #endif
104 }
105
106
107 #ifdef GRAPHTRUE
s_gr_na(a)108 OP s_gr_na(a) OP a;
109 /* select_graph_nachbarschaftsliste */
110 /* AK 210889 */ /* AK 210891 V1.3 */
111 {
112 /* die nachbarschaftsliste ist das
113 zweite vector element im self vector */
114 return(s_v_i(s_gr_s(a),1L));
115 }
116 #endif
117
s_gr_nai(a,i)118 OP s_gr_nai(a,i) OP a; INT i;
119 /* select_graph_nachbarschaftsliste das ite Element, was selber
120 ein VECTOR ist */
121 /* AK 210889 */ /* AK 210891 V1.3 */
122 {
123 #ifdef GRAPHTRUE
124 return(s_v_i(s_gr_na(a),i));
125 #else
126 error("s_gr_nai:GRAPH not available");
127 return(NULL);
128 #endif
129 }
130
131 #ifdef GRAPHTRUE
s_gr_koor(a)132 OP s_gr_koor(a) OP a;
133 /* select_graph_koordinaten */
134 /* AK 250889 */ /* AK 210891 V1.3 */
135 {
136 /* die koordinatenliste ist das
137 dritte vector element im self vector */
138 return(s_v_i(s_gr_s(a),2L));
139 }
140 #endif
141
s_gr_koori(a,i)142 OP s_gr_koori(a,i) OP a; INT i;
143 /* select_graph_koordinatenliste das ite Element, was selber
144 ein VECTOR ist */
145 /* AK 250889 */ /* AK 210891 V1.3 */
146 {
147 #ifdef GRAPHTRUE
148 return(s_v_i(s_gr_koor(a),i));
149 #else
150 error("s_gr_koori:GRAPH not available");
151 return(NULL);
152 #endif
153 }
154
s_gr_xkoori(a,i)155 OP s_gr_xkoori(a,i) OP a; INT i;
156 /* select_graph_koordinatenliste das ite Element, was selber
157 ein VECTOR ist und davon die xkoordinate */
158 /* AK 250889 */ /* AK 210891 V1.3 */
159 {
160 #ifdef GRAPHTRUE
161 return(s_v_i(s_gr_koori(a,i),0L));
162 #else
163 error("s_gr_xkoori:GRAPH not available");
164 return(NULL);
165 #endif
166 }
167
168
s_gr_ykoori(a,i)169 OP s_gr_ykoori(a,i) OP a; INT i;
170 /* select_graph_koordinatenliste das ite Element, was selber
171 ein VECTOR ist und davon die ykoordinate */
172 /* AK 250889 */ /* AK 210891 V1.3 */
173 {
174 #ifdef GRAPHTRUE
175 return(s_v_i(s_gr_koori(a,i),1L));
176 #else
177 error("s_gr_ykoori:GRAPH not available");
178 return(NULL);
179 #endif
180 }
181
182
183
184 #ifdef GRAPHTRUE
m_vector_graph(vector,kf,erg)185 INT m_vector_graph(vector,kf,erg) OP vector,erg; INT (* kf)();
186 /* macht aus einem vector von objecten und einer funktion kf
187 die testet ob zwischen zwei objecten eine kante ist einen
188 graphen */
189 /* kf gibt true oder false zurueck */
190 /* AK 210889 */ /* AK 210891 V1.3 */
191 {
192
193 INT i,j;
194 INT dt=0;
195
196 m_sk_gr(callocobject(),NACHBARLISTE,erg);
197 if (dt) {
198 fprintf(stderr,"m_vector_graph:erg(1)=");
199 fprintln(stderr,erg);
200 }
201 m_il_v(2L,s_gr_s(erg));
202 if (dt) {
203 fprintf(stderr,"m_vector_graph:erg(2)=");
204 fprintln(stderr,erg);
205 }
206 copy(vector,s_gr_kn(erg));
207 if (dt) {
208 fprintf(stderr,"m_vector_graph:knotenvector=");
209 fprintln(stderr,s_gr_kn(erg));
210 }
211 /* die knoten sind die elemente im vector */
212 m_il_v(s_v_li(vector),s_gr_na(erg));
213 if (dt) {
214 fprintf(stderr,"m_vector_graph:nachbarschaftsliste=");
215 fprintln(stderr,s_gr_na(erg));
216 }
217 /* die nachbarschaftsliste hat die laenge des vectors */
218 for (i=0;i<s_v_li(vector);i++)
219 for (j=0;j<s_v_li(vector);j++)
220 {
221 INT kferg;
222 OP hv;
223 hv = s_gr_nai(erg,i);
224 /* hv ist der vector in der nachbarschaftsliste */
225 kferg = (*kf)(s_gr_kni(erg,i),s_gr_kni(erg,j));
226 if (kferg == TRUE) /* kante i,j */
227 {
228 if (emptyp(hv))
229 /* die nachbarschaftsliste ist leer */
230 m_il_v(1L,hv);
231 else inc(hv);
232 /* nun eintrag von j in die liste von i an der
233 letzten position */
234 m_i_i(j,s_v_i(hv,s_v_li(hv)-1));
235 }
236 }
237 return(OK);
238 }
239 #endif
240
241 #ifdef GRAPHTRUE
fprint_graph(f,a)242 INT fprint_graph(f,a) FILE *f; OP a;
243 /* AK 210889 */ /* AK 210891 V1.3 */
244 {
245 if (not emptyp(s_gr_s(a))) fprint(f,s_gr_na(a));
246 return(OK);
247 }
248 #endif
249
250 #ifdef GRAPHTRUE
copy_graph(a,b)251 INT copy_graph(a,b) OP b,a;
252 /* AK 210889 */ /* AK 210891 V1.3 */
253 {
254 m_sk_gr(callocobject(),(OBJECTKIND)0,b);
255 c_gr_k(b,s_gr_k(a));
256 copy(s_gr_s(a),s_gr_s(b));
257 return(OK);
258 }
259 #endif
260
freeself_graph(a)261 INT freeself_graph(a) OP a;
262 /* AK 230889 */ /* AK 210891 V1.3 */
263 {
264 #ifdef GRAPHTRUE
265 OBJECTSELF d;
266
267 freeall(s_gr_s(a));
268 d = S_O_S(a);
269 free(d.ob_graph);
270 return(OK);
271 #else
272 error("freeself_graph:GRAPH not available");
273 return(ERROR);
274 #endif
275 }
276
277 /* verband.c */
278 /* AK 250889 */
279 /* verband ist ein graph in dem ich eine funktion habe, die mir die schicht
280 ausgibt, er ist leichter zu plazieren */
281 /* plaziert wird stets in einem feld XDIM x YDIM */
282 #define XDIM 100000L
283 #define YDIM 100000L
284
285 #ifdef GRAPHTRUE
plaziere_verband(a,lf)286 INT plaziere_verband(a,lf) OP a; INT (*lf)();
287 /* a ist graph ,lf ist levelfunction */
288 /* AK 250889 */ /* AK 210891 V1.3 */
289 {
290 OP b,c,d;
291 INT dt=1,i;
292 if (s_v_li(s_gr_s(a)) < 3L) inc(s_gr_s(a));
293 /* koordinaten anhaengen */
294 if (not emptyp(s_gr_koor(a))) {
295 return(OK);
296 /* bereits plaziert */
297 }
298 m_il_v(s_v_li(s_gr_kn(a)),s_gr_koor(a));
299 /* koordinatenliste erstellen */
300 b = callocobject();
301 c = callocobject();
302 get_level_vector_of_verband(a,lf,b,c);
303 if (dt) {
304 fprintf(stderr,"plaziere_verband:levelvector = ");
305 fprintln(stderr,b);
306 fprintf(stderr,"plaziere_verband:platzvector = ");
307 fprintln(stderr,c);
308 }
309 /* plazieren nun zweidimensional */
310 d = callocobject();
311 copy(b,d);
312 for (i=s_v_li(d)-1;i>=0;i--)
313 m_i_i(XDIM / (s_v_ii(d,i)+1) , s_v_i(d,i));
314 /* in d steht der abstand zwischen den elementen in der iten
315 schicht */
316
317 for (i=s_v_li(s_gr_koor(a))-1; i>=0; i--)
318 {
319 m_il_v(2L,s_gr_koori(a,i));
320 m_i_i(s_v_ii(c,i) * (YDIM / s_v_li(b)),
321 s_gr_ykoori(a,i));
322 m_i_i(s_v_ii(d,s_v_ii(c,i)) * s_v_ii(b,s_v_ii(c,i)),
323 s_gr_xkoori(a,i));
324 dec(s_v_i(b,s_v_ii(c,i)));
325 }
326 if (dt) {
327 fprintf(stderr,"plaziere_verband:koordinaten = ");
328 fprintln(stderr,s_gr_koor(a));
329 }
330 freeall(b);
331 freeall(c);
332 freeall(d);
333 return(OK);
334 }
335 #endif /* GRAPHTRUE */
336 #ifdef GRAPHTRUE
get_level_vector_of_verband(a,lf,b,c)337 INT get_level_vector_of_verband(a,lf,b,c) OP a,b,c; INT (*lf)();
338 /* AK 250889 */
339 /* ergebnis ist ein vector b mit eintrag an der stelle i, wieviel
340 knoten in dieser schicht und ein vector c, der angibt
341 in welcher schicht der ite knoten
342 lf ist levelfunction */ /* AK 210891 V1.3 */
343 {
344 OP d=NULL;
345 INT i,mmm;
346 m_il_v(s_v_li(s_gr_kn(a)),c);
347 for (i=s_v_li(s_gr_kn(a))-1;i>=0; i--)
348 {
349 (*lf)(s_gr_kni(a,i),s_v_i(c,i));
350 if (d== NULL) {
351 d = callocobject();
352 copy(s_v_i(c,i),d);
353 }
354 else if (lt(s_v_i(c,i),d)) copy(s_v_i(c,i),d);
355 }
356 /* d ist nun das minimum der level */
357 /* mmm wird index auf maximum */
358 mmm = 0L;
359 for (i=s_v_li(s_gr_kn(a))-1;i>=0; i--)
360 {
361 sub(s_v_i(c,i),d,s_v_i(c,i));
362 if (gr(s_v_i(c,i),s_v_i(c,mmm))) mmm = i;
363 }
364
365 /* der level wert 0 ist nun die unterste schicht */
366 /* mmm ist zeiger auf oberste schicht */
367 /* mmm wird anzahl der schichten */
368 mmm = s_v_ii(c,mmm)+1 ;
369 m_il_v(mmm,b);
370 for (i=0;i<mmm;i++) m_i_i(0L,s_v_i(b,i));
371 for (i=s_v_li(s_gr_kn(a))-1;i>=0; i--)
372 inc(s_v_i(b,s_v_ii(c,i)));
373
374 freeall(d);
375 return(OK);
376 }
377
378 #endif /* GRAPHTRUE */
379
380 #ifdef GRAPHTRUE
latex_verband(a)381 INT latex_verband(a) OP a;
382 /* AK 250889 */
383 /* der verband muss bereits plaziert sein */
384 /* AK 070291 V1.2 prints to texout */ /* AK 210891 V1.3 */
385 {
386 INT i,j;
387
388 fprintf(texout,"\n\\begin{picture}(%d,%d)\n",XDIM,YDIM);
389 for (i=s_v_li(s_gr_koor(a))-1; i>=0 ;i--)
390 {
391 fprintf(texout,"\\put(%d,%d){ \n",s_i_i(s_gr_xkoori(a,i)),
392 s_i_i(s_gr_ykoori(a,i)));
393
394 tex(s_gr_kni(a,i));
395 fprintf(texout,"}\n");
396 }
397 /* nun kommen die verbindungen */
398 for (i=s_v_li(s_gr_koor(a))-1; i>=0 ;i--)
399 for (j=0; j<s_v_li(s_gr_nai(a,i)); j++)
400 {
401 INT xanfang = s_i_i(s_gr_xkoori(a,i));
402 INT yanfang = s_i_i(s_gr_ykoori(a,i));
403 INT xende=s_i_i(s_gr_xkoori(a,s_v_ii(s_gr_nai(a,i),j)));
404 INT yende=s_i_i(s_gr_ykoori(a,s_v_ii(s_gr_nai(a,i),j)));
405 if (i>s_v_ii(s_gr_nai(a,i),j))
406 latex_line( xanfang,yanfang, xende,yende);
407 }
408 fprintf(stderr,"\n\\end{picture}\n");
409 return OK;
410 }
411 #endif /* GRAPHTRUE */
412
413 #ifdef GRAPHTRUE
latex_line(vonx,vony,nachx,nachy)414 INT latex_line(vonx,vony,nachx,nachy) INT vonx,vony,nachx,nachy;
415 /* latex befehl um line zu zeichen */
416 /* AK 070291 V1.2 prints to texout instead of stdout */ /* AK 210891 V1.3 */
417 {
418 fprintf(texout,"\\bezier{%d}",(nachx-vonx)/1000+(nachy-vony)/1000);
419 fprintf(texout,"(%d,%d)",vonx,vony);
420 fprintf(texout,"(%d,%d)", (vonx+nachx)/2, (vony+nachy)/2);
421 fprintf(texout,"(%d,%d)\n",nachx,nachy);
422 return OK;
423 }
424 #endif /* GRAPHTRUE */
425
426
427 /* AK 240603 */
428 /* routines for the managment of adjacency matrices */
add_adjacency_matrix(a,b,c)429 INT add_adjacency_matrix(a,b,c) OP a,b,c;
430 /* AK builds the adjacancy matrix corresponding to the
431 disjoint union of two graphs */
432 /* AK 240603 */
433 {
434 INT erg = OK;
435 INT i,j;
436 CTTO(MATRIX,INTEGERMATRIX,"add_adjacency_matrix(1)",a);
437 CTTO(MATRIX,INTEGERMATRIX,"add_adjacency_matrix(2)",b);
438 SYMCHECK(S_M_HI(a) != S_M_LI(a),"add_adjacency_matrix(1):not quadratic");
439 SYMCHECK(S_M_HI(b) != S_M_LI(b),"add_adjacency_matrix(1):not quadratic");
440 CE3(a,b,c,add_adjacency_matrix);
441 m_ilih_nm(S_M_HI(a)+S_M_HI(b),S_M_HI(a)+S_M_HI(b),c);
442 for (i=0;i<S_M_HI(a);i++)
443 for (j=0;j<S_M_LI(a);j++)
444 if (i!=j) M_I_I(S_M_IJI(a,i,j),S_M_IJ(c,i,j));
445 for (i=0;i<S_M_HI(b);i++)
446 for (j=0;j<S_M_LI(b);j++)
447 if (i!=j) M_I_I(S_M_IJI(a,i,j),S_M_IJ(c,S_M_HI(a)+i,S_M_LI(a)+j));
448
449 ENDR("add_adjacency_matrix");
450 }
451
random_adjacency_matrix(n,a)452 INT random_adjacency_matrix(n,a) OP n,a;
453 /* computes the adjacency matrix of random graph */
454 /* AK 240603 */
455 {
456 INT erg = OK;
457 INT i,j,k;
458
459 CTO(INTEGER,"random_adjacency_matrix(1)",n);
460 SYMCHECK(S_I_I(n) < 0,"random_adjacency_matrix:negative input");
461 m_ilih_nm(S_I_I(n),S_I_I(n),a);
462 C_O_K(a,INTEGERMATRIX);
463 k=S_I_I(n)/3+1;
464 for (i=0;i<S_M_HI(a);i++)
465 for (j=i+1;j<S_M_LI(a);j++)
466 {
467 if ((rand() % k) == 0) {
468 M_I_I(1,S_M_IJ(a,i,j));
469 M_I_I(1,S_M_IJ(a,j,i));
470 }
471
472 }
473 ENDR("random_adjacency_matrix");
474 }
475
Kn_adjacency_matrix(n,a)476 INT Kn_adjacency_matrix(n,a) OP n,a;
477 /* computes the adjacency matrix of the complete graph */
478 /* AK 240603 */
479 {
480 INT erg = OK;
481 INT i,j;
482
483 CTO(INTEGER,"Kn_adjacency_matrix(1)",n);
484 SYMCHECK(S_I_I(n) < 0,"Kn_adjacency_matrix:negative input");
485 m_ilih_nm(S_I_I(n),S_I_I(n),a);
486 C_O_K(a,INTEGERMATRIX);
487 for (i=0;i<S_M_HI(a);i++)
488 for (j=0;j<S_M_LI(a);j++)
489 if (i!=j) M_I_I(1,S_M_IJ(a,i,j));
490 ENDR("Kn_adjacency_matrix");
491 }
492
493
494
johnson_graph_adjacency_matrix(a,b,c,m)495 INT johnson_graph_adjacency_matrix(a,b,c,m) OP a,b,c,m;
496 /* computes the adjacency matrix */
497 /* of the johnson graph:
498 edge if the intersection of two b-subsets of a a-set
499 has exactly c elements */
500 {
501 INT erg =OK;
502 CTO(INTEGER,"johnson_graph_adjacency_matrix(1)",a);
503 CTO(INTEGER,"johnson_graph_adjacency_matrix(2)",b);
504 CTO(INTEGER,"johnson_graph_adjacency_matrix(3)",c);
505 SYMCHECK(S_I_I(a)<S_I_I(b),"johnson_graph_adjacency_matrix:a<b");
506 SYMCHECK(S_I_I(b)<S_I_I(c),"johnson_graph_adjacency_matrix:b<c");
507 SYMCHECK(S_I_I(c)<0,"johnson_graph_adjacency_matrix:c<0");
508 {
509 OP d,e,f;
510 INT i,j;
511 CALLOCOBJECT3(d,e,f);
512 binom(b,c,d); sub(a,b,e); sub(b,c,f);
513 binom(e,f,f); mult_apply(d,f); makevectorofsubsets(a,b,d);
514 m_lh_nm(S_V_L(d),S_V_L(d),m);
515
516 for (i=0;i<S_V_LI(d);i++)
517 for (j=i+1;j<S_V_LI(d);j++)
518 { // schnitt der beiden subsets
519 INT k,kk=0;
520 for (k=0;k<S_V_LI(S_V_I(d,i)); k++)
521 if ((S_V_II(S_V_I(d,i),k) == 1) &&
522 (S_V_II(S_V_I(d,j),k) == 1)) kk++;
523 if (kk == S_I_I(c)) // kante
524 {M_I_I(1,S_M_IJ(m,i,j));M_I_I(1,S_M_IJ(m,j,i));}
525 }
526
527 FREEALL3(d,e,f);
528
529 }
530 ENDR("johnson_graph_adjacency_matrix");
531 }
532
533
534
535