Объединяет списки

Yes

?-

 

divd(L,[],L,1):-!.

divd(L,Lb,La):-divd(L,Lb,La,0).

divd([],[],[],0).

divd([H|L],[H|Lb],La,0):-

H\='.',H\=',',divd(L,Lb,La,0),!.

divd([H|L],[],La,0):-(H='.';H=','),divd(L,_,La,1),!.

 

trimlft([],[]).

trimlft([0|L],L1):-trimlft(L,L1).

trimlft([H|L1],[H|L1]):-H\=0.

 

lst([L],L,[]).

lst([H|L],K,[H|L1]):-lst(L,K,L1),!.

trimrght([],[]).

trimrght(L,L1):-lst(L,E,R),E=0,trimrght(R,L1),!.

trimrght(L,L1):-lst(L,E,R),E\=0,L1=L,!.

 

trns(L,K,N):-int_text(N,N1),trns(L,K,N1),!.

trns([0,0,0,0],_,'0').

trns([0,0,0,1],_,'1').

trns([0,0,1,0],_,'2').

trns([0,0,1,1],_,'3').

trns([0,1,0,0],_,'4').

trns([0,1,0,1],_,'5').

trns([0,1,1,0],_,'6').

trns([0,1,1,1],_,'7').

trns([1,0,0,0],_,'8').

trns([1,0,0,1],_,'9').

trns([1,0,1,0],l,'a').

trns([1,0,1,1],l,'b').

trns([1,1,0,0],l,'c').

trns([1,1,0,1],l,'d').

trns([1,1,1,0],l,'e').

trns([1,1,1,1],l,'f').

trns([1,0,1,0],u,'A').

trns([1,0,1,1],u,'B').

trns([1,1,0,0],u,'C').

trns([1,1,0,1],u,'D').

trns([1,1,1,0],u,'E').

trns([1,1,1,1],u,'F').

 

apnd([],L,L):-!.

apnd([H|L1],L2,[H|L3]):-apnd(L1,L2,L3),!.

 

trns([],_,[]):-!.

trns(L,K,[H|Lst]):-trns(F1,K,H),trns(F2,K,Lst),apnd(F1,F2,L).

 

 

main(I,R):-

divd(I,Bf,Af),trns(Bb,K,Bf),trns(Ab,K,Af),trimlft(Bb,Bt),trimrght(Ab,At),

(Bt=[],Br=[0];Bt\=[],Br=Bt),(At=[],R=Br;At\=[],apnd(Br,['.'],Q),apnd(Q,At,R)),!.

 

 

Задача 4: (17) Удалить из списка элемент с заданным порядковым номером, либо все элементы, порядковые номера которых указаны в списке и могут быть удалены.

?- pred([a,b,c,d,e],4,X).

X = [a,b,c,e]

Yes

?-

 

Удаляет из списка элемент с заданным порядковым номером.

delete([],_,[]).

delete([_|T],1,T).

delete([H|T],K,[H|T1]):-K>1,!,

K1 is K-1,

delete(T,K1,T1).

 

Уменьшает значение элементов списка на еденицу.

des([],[]).

des([A|B],[A1|B1]):-

A1 is A-1,

des(B,B1).

 

pred(List1,[],List1).

pred(List1,[D|L],List2):-

delete(List1,D,List3),

des(L,L1),

pred(List3,L1,List2),!.

 

Задача 5: (33) Строка текста на русском языке содержит «лишние» (подчёркнуты в примере) пробелы. Удалить избыточные пробелы. Также удалить все дублирующиеся буквы, за исключением букв в концах слов.

 

?- pred(’Мы будем рады узнать ваше мнение!’,X).

X = ’Мы будем рады узнать ваше мнение!’

Yes

?-

Name – переводит символы в числа.

pred(Text,X):-name(Text,T),fStr(T,T1,_),name(X,T1).

 

Удаляет дубликаты и пробелы:

fStr([H|[]],[H],[]):-!.

fStr([H|T],[A|B],L):-isSpase(H),fStr(T,[A|B],L),isSpase(A),!.

fStr([H|T],[A|B],L):-fStr(T,[A|B],L),notSpase(L),H =A,!.

fStr([H|T],[H|[A|B]],A):-fStr(T,[A|B],L).

 

Проверяет символ пробел или нет

isSpase(X):-name(' ',[X]).

notSpase(X):-name(' ',[Z]),Z \= X.

 

Задача 6: (48)Необходимо собрать в список имена всех узлов, лежащих на глубинах, содержащихся в заданном списке, и записать после имени каждого узла количество узлов, содержащихся в поддереве, корнем которого он является.

?-pred(a(b(d,e),c(f,g(h,k))),[0,2],X).

X=[ [a,3], [d,0],[e,0],[f,0],[g,0] ]

pred(Tree,N,X):-find(Tree,N,X).

 

find(Tree,[H|[]],X):-findOnLevel(Tree,H,X).

find(Tree,[H|T],X):-find(Tree,T,X1),findOnLevel(Tree,H,X2),f(X2,X1,X).

 

Ищет имена всех узлов лежащих на заданной одной глубине.

findOnLevel(Tree,X,[]):-atomic(Tree),X>0.

findOnLevel(Tree,0,[[Tree,0]]):-atomic(Tree).

findOnLevel(Tree,0,[[H,Z]]):-Tree=..[H,O],count(Tree,Z1),Z is Z1-1.

findOnLevel(Tree,0,[[H,Z]]):-Tree=..[H,L,R],count(Tree,Z1),Z is Z1-1.

findOnLevel(Tree,N,X):-N1 is N-1,Tree=..[H,O],findOnLevel(O,N1,X).

findOnLevel(Tree,N,X):-N1 is N-1,Tree=..[H,L,R],findOnLevel(L,N1,XL),findOnLevel(R,N1,XR),f(XL,XR,X).

 

Считает кол-во узлов в дереве.

count(Tree,0):-atomic(Tree).

count(Tree,X):-Tree=..[H,O],count(O,OX),X is OX+1.

count(Tree,X):-Tree=..[H,L,R],count(L,LX),count(R,RX),X is RX+LX+1.

 

Объединяет списки.

f([],[],[]).

f([H|[]],A,[H|A]):-!.

f([H|T],A,[H|X]):-f(T,A,X).

 

Задача 7: (55)Определить путь между двумя заданными узлами. Если есть несколько узлов с заданными именами, последовательно вывести все пути (перебором).(дерево бинарное).

?- pred(s(f(w(b(u(i,o),v),k),a),t(r,g)),w,r,X).

X = [w,f,s,t,r] ->;

Yes

?- pred(s(f(w(b(u(i,o),v),k),a),t(r,g)),i,o,X).

X = [i,u,o]

Yes

?-

 

pred(Tree,A,B,X):-f(Tree,A,AX),f(Tree,B,BX),split(AX,BX,X).

 

f(Tree,H,[Tree]):-atomic(Tree),H = Tree.

f(Tree,H,[H]):-Tree=..[H,L,R].

f(Tree,A,[H|Y]):-Tree=..[H,L,R],(f(L,A,Y);f(R,A,Y)).

f(Tree,A,[H|Y]):-Tree=..[H,O],f(L,O,Y).

 

% обьединяет два масива в один

append([],A,A).

append([H|[]],A,[H|A]):-!.

append([H|T],A,[H|X]):-append(T,A,X).

 

split([H|[A|T1]],[H|[A|T2]],X):-split([A|T1],[A|T2],X).

split([H|[A|T1]],[H|[B|T2]],X):-B\=A,invert([A|T1],T),append(T,[H|[B|T2]],X).

 

% переписывает список задом на перед

invert([],[]).

invert([H|T],X):-invert(T,Y),addLast(Y,H,X).

 

% добавляет елемент в конец масива

addLast([],B,[B]).

addLast([H|T],B,[H|X]):-addLast(T,B,X).

 

Задача 8: (75) Необходимо «обрезать» дерево (произвольное) на заданной глубине.

?- pred(s(f(b(m,k),a),t(a,g),j(u)),2,X).

X = s(f,t,j)

Yes

?- pred(s(f(b(m,k),a),t(a,g),j(u)),3,X).

X = s(f(b,a),t(a,g),j(u))

Yes

?-

 

pred(Tree,B,X):-f(Tree,B,X).

 

f(Tree,N,Tree):-atomic(Tree),!.

f(Tree,1,H):-Tree=..[H|N],!.

f(Tree,N,X):-Tree=..[H|T],M is N -1,q(T,M,Y),X=..[H|Y].

 

q([H|[]],N,[X]):-f(H,N,X).

q([H|T],N,[X|Y]):-q(T,N,Y),f(H,N,X).

 

Задача 9: (84) Перебор путей от корня до всех листьев(произвольное дерево).

 

?- pred(a(f(a(m,k),r),n(i,o,v(x))),X).

X = [a,f,a,m] ->;

X = [a,f,a,k] ->;

X = [a,f,r] ->;

X = [a,n,i] ->;

X = [a,n,o] ->;

X = [a,n,v,x] ->;

No

?-

 

 

pred(Tree,X):-scan(Tree,X,L).

scan(Tree,[Tree]):-atomic(Tree).

scan(Tree,[H|P]):-Tree=..[H|T],sc(T,P).

 

sc([H|T],A):-scan(H,A).

sc([H|T],A):-sc(T,A).

 

Задача 10: Подсчитать кол-во листьев в дереве.(произвольное дерево).

?- leaf_N(a(f(a(m,k),r),n(i,o,v(x))),X).

X = 6

Yes

?-

 

leaf_N(Tree,1):- atomic(Tree),!.

leaf_N(Tree,R):-

Tree=..[Name,SubTree],

leaf_N(SubTree,R),!.

leaf_N(Tree,R):-

Tree=..[Name,Left|Tail],

New=..[Name|Tail],

leaf_N(Left,R1),

leaf_N(New,R2),

R is R1+R2,!.

 

Задача 11: Дан список, содержащий списки одинаковой длины (матрица). Вернуть матрицу, являющуюся произведением данной матрицы на транспонированную..

?- pred([[1,2,3],[4,5,6],[7,8,9]],X).

X = [[1,4,7],[2,5,8],[3,6,9]]

Yes

?-

 

pred([H|T],X):-transporate([],[H|T],X).

 

transporate(A,[H|[]],X):-strToCol(A,H,X).

transporate(A,[H|T],X):-strToCol(A,H,Z),transporate(Z,T,X).

 

strToCol([],[A|[]],[H1]):-addLast([],A,H1).

strToCol([H|[]],[A|[]],[H1]):-addLast(H,A,H1).

strToCol([],[A|B],[H1|T1]):-addLast([],A,H1),strToCol([],B,T1).

strToCol([H|T],[A|B],[H1|T1]):-addLast(H,A,H1),strToCol(T,B,T1).

 

addLast([],B,[B]).

addLast([H|T],B,[H|X]):-addLast(T,B,X).

 

 

Задача 12: Дан список, содержащий списки одинаковой длины (квадратная матрица). Посчитать детерминант.

?- pred([[1,2],[4,5]],X).

X = -3

Yes

?-

 

pred([[X11,X12],[X21,X22]],X):-X is X11*X22-X12*X21,!.

если матрица 2х2 то ищем её детерминант как разность произведений

и отбрасываем все остальные попытки посчитать эту матрицу.

 

pred([A|B],X):-pr(A,B,1,1,X).

если матрица не 2х2 то выполняем вспомогательную рекурсивную

функцию "pr"

этой функции передаем первую строчку и остальную матрицу как параметры

и дополнительные парметры

эта функция вернет детерминант матрицы

 

pr([A|[]],C,Y,K,X):-g(C,Y,F),pred(F,Z),X is Z*A*K,!.

если "А" последний элемент то "Х" будет равен произведению

детерминанта дополнительной матрицы на "А"

и остальные попытки обработать этот вариант отбрасываем

 

pr([A|B],C,Y,K,D):-g(C,Y,F),pred(F,Z),pr(B,C,Y+1,K*(-1),X),D is Z*A*K+X.

если "А" не последний элемент

получаем из матрици вспомогательную матрицу(F) путем зачеркивания первой

строки и столбц под номером "Y", найдем её придекат(Z) умножив его на "А" и прибавим его

к сумме остальных такихже призведений, полученых зачеркиванием разных столбцов.

причем каждый второй детерминант домножается на -1

 

g([A|[]],Y,[Q]):-f(A,Y,Q),!.

если это последняя строчка в матрице то уделяем из нее элемент под номером "Y"

и отбрасываем все остальные попытки обработать этот вариант

после этой строчки все предыдущие строки с удоленным элементом собираются в матрицу

 

g([A|B],Y,[Q|H]):-f(A,Y,Q),g(B,Y,H).

если это непоследняя строчка в матрице то берем первую строчку и удоляем

из неё элемент с №"Y",затем выполняем этуже ф-ию с матрицей без этой строчки

 

f([A|T],1,T):-!.

если встречаем 1 то возвращяется хвост строик, и отбрасываем другие варианты

f([A|T],Y,[A|F]):-E is Y-1,f(T,E,F).

если значение "Y" больше 1 то выполняем этуже функцию без первого элемента

по завершению все первые елементы и остаток собираются в строчку без одного элемента

 

pred([[X11,X12],[X21,X22]],X):-X is X11*X22-X12*X21,!.

pred([A|B],X):-pr(A,B,1,1,X).

pr([A|[]],C,Y,K,X):-g(C,Y,F),pred(F,Z),X is Z*A*K,!.

pr([A|B],C,Y,K,D):-g(C,Y,F),pred(F,Z),pr(B,C,Y+1,K*(-1),X),D is Z*A*K+X.

g([A|[]],Y,[Q]):-f(A,Y,Q),!.

g([A|B],Y,[Q|H]):-f(A,Y,Q),g(B,Y,H).

f([A|T],1,T):-!.

f([A|T],Y,[A|F]):-E is Y-1,f(T,E,F).

 

Задача 13: Собирает в список кол-во узлов лежащих на каждом уровне.(дерево бинарное).

?- pred(a(b(d(h,k),e(l(n,o),m)),c(f,g(r,p))),X).

X=[1,2,4,6,2]à

Yes

?-

pred(Tree,X):-getMaxLen(Tree,ML),findOnAllLevels(Tree,ML,[],X).

 

findOnAllLevels(Tree,0,A,A):-!.

findOnAllLevels(Tree,ML,A,X):-getCountOnLevel(Tree,ML,C),N is ML-1,findOnAllLevels(Tree,N,[C|A],X).

 

getCountOnLevel(Tree,1,1):-!.

getCountOnLevel(Tree,N,0):-atomic(Tree),N>=1.

getCountOnLevel(Tree,N,X):-Tree=..[H,O],M is N-1,getCountOnLevel(O,M,X).

getCountOnLevel(Tree,N,X):-Tree=..[H,L,R],M is N-1,getCountOnLevel(L,M,LX),getCountOnLevel(R,M,RX),X is RX+LX.

 

getMaxLen(Tree,1):-atomic(Tree).

getMaxLen(Tree,X):-Tree=..[H,O],getMaxLen(O,OX),X is OX+1.

getMaxLen(Tree,X):-Tree=..[H,L,R],getMaxLen(L,LX),getMaxLen(R,RX),ifthenelse(LX>RX,X is LX+1,X is RX+1).

Задача 14: Все возможные пары элементов списка.

?- pred([a,b,c,d,e],X).

X = [a,b] ->;

X = [a,c] ->;

X = [a,d] ->;

X = [a,e] ->;

X = [b,c] ->;

X = [b,d] ->;

X = [b,e] ->;

X = [c,d] ->;

X = [c,e] ->;

X = [d,e] ->;

No

?-

pred([H|T],[A,B]):-any([H|T],A,T1),any(T1,B,T2).

 

any([H|T],H,T).

any([H|T],X,Y):-any(T,X,Y).

 

Задача 15: (78) Подсчитать количество узлов дерева лежащих на заданной глубине.(произвольное дерево).

?- pred(s (f(b(m,k),a),t(a)),1,X).

X = 1

Yes

?- pred(s(f(b (m,k), a),t(a)),3,X).

X = 3

Yes

?- pred(s(f(b(m, k),a),t(a)),4,X).

X = 2

Yes

?-

 

pred(A,N,X):-f(A,N,X).

 

f(Tree,1,1):-!.

f(Tree,N,0):-atomic(Tree),!.

f(Tree,N,X):-M is N-1,Tree=..[H|T],a(T,M,X).

 

a([H|[]],N,X):-f(H,N,X).

a([H|T],N,X):-a(T,N,Y),f(H,N,Z),X is Z+Y.