User:Ixsxaxpx/swi-prolog tree displayer

This code is originally from here, but the AbuseFilter declines to show any urls.

(but the current version there is not the same I used).

Some modifications were needed to run it with Swi-Prolog.

The code
/* Program is taken from my Prolog text book Christoph Lehner: Prolog und Linguistik. Oldenbourg, München 1992, 2. Auflage. Out of print, now */ ana(Baum,[k(Baum,Pos)],L_aussen,R_aussen):- atomic(Baum), !,                      atomic_laenge(Baum,N), R_aussen is L_aussen + N + 2, Pos is (R_aussen + L_aussen ) // 2. ana(Baum,[k(F,Pos),[k(Nachfolger,Pos)]],L_aussen,R_aussen):- Baum =.. [F,Nachfolger], atomic(Nachfolger), !,            atomic_laenge(Nachfolger,N1), atomic_laenge(F,N2), max(N1,N2,N), R_aussen is L_aussen + N + 2, Pos is (R_aussen + L_aussen) // 2. ana(Baum,[k(F,Pos),L],L_aussen,R_aussen):- Baum =.. [F|Nachfolger], atomic_laenge(F,N), M is L_aussen + N + 2, ana_nachfolger(Nachfolger,L_aussen,R,L), berechne_pos(L_aussen,Pos,L,R,M,R_aussen). berechne_pos(Links,Pos,L,R,M,R):- M =< R,                            !, erster_knoten(L,Pos1), letzter_knoten(L,Pos2), Pos is (Pos1 + Pos2) // 2. berechne_pos(Links,Pos,L,R,M,M):- M > R,                            Pos is (M + Links) // 2. ana_nachfolger([Baum|Rest],L_aussen,R_aussen,L):- Rest \= [], ana(Baum,L1,L_aussen,Mitte), ana_nachfolger(Rest,Mitte,R_aussen,L2), append(L1,L2,L). ana_nachfolger([Baum],L_aussen,R_aussen,L):- ana(Baum,L,L_aussen,R_aussen). max(X,Y,X):- X >= Y, !. max(X,Y,Y). drucke_baum(S):- sv(S), ana(S,L,0,R), dr_baum(L). dr_baum(L):- L = [_|_], drucke_knoten(L,0), nl, drucke_aeste(L,0), nl, drucke_zweige(L,L1,0), nl, dr_baum(L1). dr_baum([]). drucke_knoten([X,Y|R],Spalte1):- Y \= [_|_], !,                 dr_kn(X,Spalte1,Spalte2), drucke_knoten([Y|R],Spalte2). drucke_knoten([X,[_|_]|R],S1):- dr_kn(X,S1,S2), drucke_knoten(R,S2). drucke_knoten([X],S):- dr_kn(X,S,_). drucke_knoten([],_). dr_kn(k(X,Pos),S1,S2):- atomic_laenge(X,N), tab(Pos - N//2 - S1), S2 is Pos + N//2 + N mod 2, write(X). /* Blaetter */ drucke_aeste([X,Y|Rest],S):- Y \= [_|_], !,                drucke_aeste([Y|Rest],S). drucke_aeste([X],S):- !. /* nicht-verzweigende, z.B. lexikalische Kategorien */ drucke_aeste([k(X,Pos),L|Rest],S1):- knoten_zahl(L,1), !,                tab(Pos-S1), write('|'), S2 is Pos + 1 , drucke_aeste(Rest,S2). /* normale Kategorien */ drucke_aeste([X,[K|R]|Rest],S1):- !,                dr_ae(X,[K|R],S1,S2), drucke_aeste(Rest,S2). drucke_aeste([],_). /* dr_ae(Dominierender_Knoten,[Tochter_links,L1,Tochter_rechts,L2] */ dr_ae(k(X,Pos),L,S1,S2) :-                         erster_knoten(L,Pos1),                         letzter_knoten(L,Pos2),                         Mitte is (Pos1 + Pos2) // 2,                         tab(Pos1-S1+1),                         n_mal(Mitte-Pos1-1,'_'),                         write('|'),                         n_mal(Pos2-Mitte-2,'_'),                         S2 is Pos2 - 1. erster_knoten([k(_,Pos)|L],Pos). /* einen letzten Knoten gibt es nur dann, wenn    es einen ersten Knoten gibt */ letzter_knoten([_|R],Pos):-                          letzter_knoten(R,Pos). /* 1. Fall: Blatt */ letzter_knoten([k(_,Pos)],Pos):- !. /* 2. Fall: dominierender Knoten */ letzter_knoten([k(_,Pos),[_|_]],Pos). /************************************************/ /* Blaetter */ drucke_zweige([X,Y|Rest],Rest1,S1):-                 Y \= [_|_], !,                drucke_zweige([Y|Rest],Rest1,S1). drucke_zweige([X],[],S):- X \= [_|_], !. /* nicht-verzweigende, z.B. lexikalische Kategorien */ drucke_zweige([k(_,Pos),X|Rest],L,S1):- knoten_zahl(X,1), !,                tab(Pos-S1), write('|'), S2 is Pos + 1, drucke_zweige(Rest,L1,S2), append(X,L1,L). /* normale Kategorien */ drucke_zweige([X,[K|R]|Rest],L,S1):- !,                dr_zw(X,[K|R],S1,S2), drucke_zweige(Rest,L1,S2), append([K|R],L1,L). drucke_zweige([],[],_). /* dr_zw(Dominierender_Knoten,[Tochter_links,L1,Tochter_rechts,L2] */ dr_zw(k(X,Pos),L,S1,S4) :-                        erster_knoten(L,Pos1),                        tab(Pos1-S1),                        write(/),                        S2 is Pos1+1,                        knoten_dazwischen(L,S2,S3),                        letzter_knoten(L,Pos2),                        tab(Pos2 - S3 - 1),                        write('\\'),                        S4 is Pos2 . knoten_dazwischen([k(_,_)|R],S1,S2):-                     drucke_zweige_fuer_knoten(R,S1,S2). drucke_zweige_fuer_knoten([k(_,_)],S,S):- !. drucke_zweige_fuer_knoten([k(_,_),[Letzte|Nachfolger]],S,S):- !. drucke_zweige_fuer_knoten([k(_,Pos)|R],S1,S2):-                            !,                            tab(Pos-S1),                            write('|'),                            S3 is Pos + 1,                            drucke_zweige_fuer_knoten(R,S3,S2). drucke_zweige_fuer_knoten([_|R],S1,S2):- drucke_zweige_fuer_knoten(R,S1,S2). knoten_zahl([k(_,_)|L],1):- not( member_x(k(_,_),L)). n_mal(Arith,A):- X is Arith, n_mal_x(X,A). n_mal_x(N,A):- N > 0, !,               write(A), M is N - 1, n_mal(M,A). n_mal_x(N,_):- N =< 0. atomic_laenge(A,N):- atom(A), !,                     name(A,L), listen_laenge(L,N). atomic_laenge(Nr,N):- numeric(Nr), !,                     name(Nr,L), listen_laenge(L,N). atomic_laenge(X,N):- var(X), !. listen_laenge([_|R],N):- listen_laenge(R,M), !,                         N is M + 1. listen_laenge([],0). member_x(X,L):- member(X,L), !. numeric(X):- number(X). /*   instanziieren noch freier     */ /*   variablen                     */ sv(X):- sv(X,1,_). sv(X, N, N1):- var(X), !,    nextvar(X,N), N1 is N+1. sv([X | Y], N, N2):- !,    sv(X, N, N1), sv(Y, N1, N2). sv(S,N,N1):- compound(S), S =..[F|A], !,    sv(A,N,N1). sv(X, N, N). nextvar('X',1). nextvar('Y',2). nextvar('Z',3). nextvar('U',4). nextvar('V',5). nextvar('W',6). nextvar(X,N):- N > 6, number(N,L), append("X",L,Y), name(X,Y). atomic_length(X,5):- var(X), !. atomic_length(X,N):- name(X,L), list_length(L,N). list_length([],0). list_length([K|R],N):- list_length(R,M), N is M + 1. term_laenge(S,N):- atomic(S), !,                   atomic_length(S,N). term_laenge(S,N):- S \= [_|_], !,                   S =..[F|A], list_length(A,L), atomic_length(F,X), alle_args(A,Y), N is X + Y + 2 + L - 1. term_laenge(L,N):- L = [_|_], alle_args(L,X), list_length(L,Y), N is X + 2 + Y - 1. alle_args([],0). alle_args([K|R],N):- term_laenge(K,X), alle_args(R,Y), N is X + Y. /* Test-Trees */ :- drucke_baum(f(a,b)). %:- drucke_baum(f(f(f(g)))). %:- drucke_baum(s(np(ar(the),cn(man)),vp(v(sleeps)))). %:- drucke_baum(s(np(ar(X),cn(1)),vp(v(sleeps)))).