|

JavaMatlabPhpHtmlJavaScriptCSSC#Delphi 1


Linux Unix AutoCAD 3D Access Orcad

2

DOMAINS
toch=string
km,ml=real
Int=integer
slist=string*
sslist=slist*
rlist=real*

/* */

DATABASE - sosed
sosed(toch,toch,km,ml)

DATABASE - lists
lists(slist)
DATABASE - sum
sum(real)

PREDICATES
connect(toch,toch,km,ml,slist,slist)
wopros
start
autoload
working(Int)
main_menu
par(toch,toch,Int)
repeat
find(string,slist)
add(slist,string,slist)
result(slist,slist,slist)
adds(slist)
writelist(slist)
min(rlist,real,integer,integer,real,integer)
createSum(real,real)
summa(slist,real,real,real,real)
dcon(toch,toch,real,real)
createListR(rlist,rlist)
addr(rlist,real,rlist)
createListS(sslist,sslist)
addss(sslist,slist,sslist)
first(rlist,real)
writeN(sslist,integer)
writeall(sslist)
GOAL start.
CLAUSES

writelist([]).
writelist([X|L]):-write(" ",X), writelist(L).

dcon(X,Y,M,N) :- sosed(X,Y,M,N);sosed(Y,X,M,N).

summa([_],N,S,_,_) :- S=N.
summa([X,Y|L],N,S,,) :-bound(),dcon(X,Y,M,_), K=M+N, summa([Y|L],K,S,,);
bound(), dcon(X,Y,_,M), K=M+N, summa([Y|L],K,S,,).

add(L1,S,[S|L1]).

adds(X) :- lists(X), !.
adds(X) :- assertz(lists(X)).

createSum(,) :- lists(X), summa(X,0,Suma,,),
assertz(sum(Suma)), fail.
createSum(_,_).
addr(L1,R,[R|L1]).
createListR(R,L) :- not (sum(_)), R=L.
createListR(R,L) :- sum(X),
addr(L,X,M),retract(sum(X)),createListR(R,M).

addss(L1,R,[R|L1]).
createListS(R,L) :- not (lists(_)), R=L.
createListS(R,L) :- lists(X), addss(L,X,M), retract(lists(X)),
createListS(R,M).

first([X|_],N) :- N=X.

min([],Tmp,Cnt,_,Min,N) :- Min=Tmp, N=Cnt.
min([X|L],Tmp,Cnt,K,Min,N) :- Tmp>X, C=K, KK=K+1, MM=X,
min(L,MM,C,KK,Min,N);
KK=K+1, min(L,Tmp,Cnt,KK,Min,N).

writeN([L|_],0) :- writelist(L).
writeN([_|L],N) :- M=N-1, writeN(L,M).
find(R,[R|_]).
find(R,[_|T]) :- find(R,T).

result([_],L,R) :- R=L.
result([X|L],M,R) :- add(M,X,L1), result(L,L1,R).

writeall([]).
writeall([X|L]) :- writelist(X), nl, writeall(L).

/* start */
start:-
autoload,
main_menu.

% connect

connect(X,Y,_,_,M,R) :-
sosed(X,Y,AA,BB), R=M;
sosed(Y,X,AA,BB), R=M.

connect(X,Y,,,L,R) :-
sosed(X,Z,_,_),
not (find(Z,L)), add(L,Z,M), connect(Z,Y,,,M,R);
sosed(Z,X,_,_),
not (find(Z,L)), add(L,Z,M),
connect(Z,Y,,,M,R).

par(X,Y,'1'):-removewindow(15,1),L=[X,Y],connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M), fail.
par(_,_,'1'):- not(lists(_)), write(" ").
par(_,_,'1'):-createSum(0,_), createListR(L1,[]), first(L1,Z),
min(L1,Z,0,0,M,N), write(" = ",M,"."),createListS(R,[]),
nl,write(" - "),writeN(R,N).
par(X,Y,'2'):- removewindow(15,1),L=[X,Y],connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M), fail.
par(_,_,'2'):- not(lists(_)), write(" ").
par(_,_,'2'):-createSum(_,0), createListR(L1,[]), first(L1,Z),
min(L1,Z,0,0,M,N), write(" = ",M," ."),
createListS(R,[]),nl, write(" - "),writeN(R,N).

par(X,Y,'3'):- removewindow(15,1),L=[X,Y], connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M),fail.
par(_,_,'3'):- not(lists(_)),write(" ").
par(_,_,'3'):- write(" :"),nl,createListS(R,[]),writeall(R).
% wopros
wopros :-
retractall(_,lists),
retractall(_,sum),
write(" "),nl,
write(""),nl,readln(X),write(""),nl,readln(Y),
makewindow(15,$1E,$2F," ",6,18,9,40),
write(" 1 - "),nl,
write(" 2 - "),nl,
write(" 3 - "),nl,
write(" ->"),
readchar(N),
clearwindow,
par(X,Y,N),
removewindow(15,0).
wopros :- removewindow(15,0).

/* */
autoload:-
retractall(_,sosed),
consult("pal.ddd",sosed).
autoload:-
makewindow(2,74,79,"",6,18,8,40),
cursor(2,10),
write(" "),
sound(70,294),
removewindow,
!.

/* */

main_menu:-
repeat,
makewindow(1,$1E,$2F," ",0,0,25,80),cursor(7,0),

write(" 1 - "),nl,
write(" 2 - "),nl,
write(" 3 - "),nl,
write(" 4 - "),nl,
write(" 5 - "),nl,
write(" 6 - "),nl,
write(" ->"),
readint(C),
clearwindow,
working(C),
clearwindow,
C = 6,
retractall(_),
removewindow(1,0).

/* */
working(1):-
makewindow(5,$5F,$5F," ",8,20,9,40),
sound(5,220),
repeat,
save("pal.ddd",sosed),nl,nl,
write(" "),nl,nl,nl,
write(" ..."),nl,
readchar(_),
clearwindow,
!,
removewindow.

/* */

working(2):-
makewindow(6,$1E,$2F," ",0,0,25,80),
sound(5,220),
cursor(9,0),
write(" 1 ࠠ ->"),readln(P1),
write(" 2 ࠠ ->"),readln(P2),
write(" ( .) ->"),readreal(),
write(" ( .) ->"),readint(),
assertz(sosed(P1,P2,,)),
clearwindow,!,
removewindow(6,0).

/* */
working(3):-
makewindow(7,26,$4F," ",0,0,25,80),
sound(5,220),
cursor(9,0),
write(" B 1 ->"),nl,
readln(P1),
write(" B 2 ->"),nl,readln(P2),
retract(sosed(P1,P2,_,_)),
clearwindow,
!,removewindow.

/* */

working(4):-
makewindow(9,$1E,$2F," ",0,0,25,80),nl,
write(" =============================================================="),nl,
write(" "),nl,
write(" ==============T=============T============T===================="),nl,
write(" #1 #2 ࠠ "),nl,
write(" "),nl,
write(" ==============+=============+============+===================="),nl,
sosed(P1,P2,,),cursor(Z,_),
cursor(Z,0),write(" ",P1),
cursor(Z,15),write(" ",P2),
cursor(Z,29),write(" ",),
cursor(Z,42),write(" ",),
cursor(Z,63),write(" "),nl,fail.
working(4):-
write(" L===========================================================-"),
nl,cursor(22,26),
write(" "),
readchar(_),
removewindow,!.

% 蠠
working(5) if
makewindow(10,26,48," ",0,0,25,80),
nl,nl,
sound (5,220),wopros,sound(5,220),
cursor(22,26),
write(" "),
readchar(_),
removewindow(10,1),!.

/* */

working(6):- removewindow(1,1).
working(_):-
makewindow(11,$4E,$4F," ",6,18,8,40),
nl,
write(" 0 6,"),nl,
write(" "),nl,nl,nl,
write(" "),
sound(20,494),
sound(30,392),
readchar(_),
removewindow(11,1).

/* repeat */
repeat.
repeat:- repeat.

:

:




php mysql



C


 


? :

, ? Google !

 
 

© life-prog.ru .