Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Prolog
Перезагрузить страницу Предлагаю решение самых распространенных задач на Vip 5.2
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
DenoZavr DenoZavr вне форума
Новичок
 
Сообщений: 2
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 13.10.2006
По умолчанию 13.10.2006, 10:05

Для начала покажу работу со списками.
Задача 1
/*Написать программу вычисления номера элемента в списке.*/
domains
list=integer*
predicates
member(list,integer,integer)
clauses
member([Head|_],Head,1).
member([_|Tail],Head,L):- member(Tail,Head,L1),L=L1+1.
goal
member([9,8,7,6,5,4,3,2,1],2,N).
Задача 2
/*Написать программу разделения списка на два так, чтобы нечетные (по номеру) элементы были в первом вписке, а четные - во втором.*/
domains
list = integer*
predicates
list1(list,list,list)
list2(list,list,list)
clauses
list1([],[],[]).
list1([Head1|Tail],[Head1|L1],L2):-list2(Tail,L1,L2).
list2([],[],[]).
list2([Head1|Tail],L1,[Head1|L2]):-list1(Tail,L1,L2).
goal
list1 ([1,2,3,4,5,6,7,8,9],L1,L2).
Задача 3
/*Написать программу удаления элемента из списка.*/
domains
list=integer*
predicates
delete(integer,list,list)
clauses
delete(X,[],[]).
delete(X,[X|T],L):-!,delete(X,T,L).
delete(X,[Y|L1],[Y|L2]):- delete(X,L1,L2).
goal
delete(8,[9,8,7,6,8,8,8,2,1],L).
Задача 4
/*инвертировать спиок*/
domains
list=integer*
predicates
inverse(list,list,list)
clauses
inverse([],L,L).
inverse([H|T],P,L) :- inverse(T,[H|P],L).
goal
inverse([1,2,3,4,5,6,7,8,9],[],Список).
Задача 5
/*Написать программу определения номера позиции в списке, с которого начинается заданный подсписок.*/
domains
list=integer*
predicates
first(list,list,integer,integer)
vho(list,list,integer,integer)
clauses
first([H|L1],[H|T],Nu,NN):-vho([H|L1],[H|T],Nu,NN).
first(L1,[_|XB],Nu,NN):-Nu1=Nu+1,first(L1,XB,Nu1,NN).
vho([],_,Nu,Nu).
vho([H1|T1],[H2|T2],Nu,Nn):-H1=H2,
vho(T1,T2,Nu,Nn).
goal
first([0],[3,4,0,7,0],1,NN).
Задача 6
/*Написать программу вычисления числа элементов списка, после заданного*/
domains
list = integer*.
predicates
counter(list,integer,integer).
len(list,integer).
clauses
counter([H|T],H,L) :- len(T,L).
counter([H|T],M,L) :- counter(T,M,L).
len([],0).
len([_|T],L):- len(T,L1),L=L1+1.
goal
counter([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15],1,C).
Задача 7
/*Написать программу замены всех четных (по номеру) элементов списка, на произвольную константу*/
domains
list=integer*
predicates
a1(list,integer,integer,integer,list)
a2(list,integer,integer,integer,list)
clauses
a1([],_,_,_,[]).
a1([H|T],N,N1,K,[H|L1]):- N1<N,N2=N1+1,a2(T,N,N2,K,L1).
a1([H|T],N,N1,K,[K|L1]):- N1>=N,a2(T,N,N1,K,L1).

a2([],_,_,_,[]).
a2([H|T],N,N1,K,[H|L1]):- N2=N1+1,a1(T,N,N1,K,L1).
goal
a1([1,2,3,4,5,6],1,2,0,L).
---------------------------------------------------------------------------------------------------------------------------

Далее предлагаю задачи на базы и динамические базы.
Задача 8
/*Предметная область – служба знакомств. Каждый клиент может быть описан структурой: фамилия, имя, отчество, характеристика клиента, требования к партнеру, список возможных партнеров. Характеристика клиента и требования к партнеру могут быть описаны одной структурой: возраст, образование, национальность, ежемесячный доход, владение жилой площадью, наличие детей, отсутствие вредных привычек. Возможный партнер может быть описан следующей структурой: фамилия, имя, отчество, характеристика партнера. Характеристика партнера может быть описана структурой, одинаковой со структурой характеристики клиента.
Реализовать следующие типы запросов:
1. Найти самого молодого возможного партнера в БД;
2. Найти клиента, у которого нет возможных партнеров;
3. Найти всех клиентов указанной национальности, не старше указанного возраста;
4. Найти всех партнеров указанного клиента без вредных привычек;
5. Найти всех клиентов, у которых нет детей, и которым подходит партнер, имеющий детей.
*/
domains
фамилия, имя, отчество, национальность, образование = string
дети, привычки, жилая_площадь = string
возраст, доход = integer
партнеры = партнер*
партнер = парт(фамилия, имя, отчество, характеристика_клиента)
характеристика_клиента = характеристика(возраст, образование, национальность, доход, дети, привычки, жилая_площадь)
клиент = клиент(фамилия, имя, отчество, характеристика_клиента, характеристика_клиента, партнеры)

predicates
база_данных_клиентов(клиент)
данные(клиент)
поиск(партнер,партнеры).
поиск_молодой_клиент
%клиент_без_партнера
%клиент_нац_возр(национальность,возраст)
%партнеры_клиента_без_привычек(фамилия, имя, отчество)
%клиент_нет_детей
facts
минимум(integer,фамилия, имя, отчество)
clauses
база_данных_клиентов(клиент("Шулындин", "Александр", "Вадимович",характеристика(39,"Высшее","Русский",2 5000,"да","нет","да"),
характеристика(30,"Высшее","Русский",10000, "нет","нет","нет"),
[парт("Иванова","Лариса","Сергеевна",характеристика (35,"Высшее","Русский",9000,"нет","нет","да")),
парт("Жданова","Варвара","Валериевна",характеристи ка(27,"Высшее","Русский",12000,"нет","да","да"))])).

база_данных_клиентов(клиент("Кондратьев", "Андрей", "Михайлович",характеристика(24, "Высшее", "Русский", 15000, "нет", "нет", "да"),
характеристика(30,"Высшее","Русский",10000, "нет","нет","нет"),
[парт("Иванова","Лариса","Сергеевна",характеристика (36,"Высшее","Русский",9000,"нет","да","нет")),
парт("Сидорова","Анна","Леонидовна",характеристика (34,"Высшее","Русский",12000,"нет","да","нет"))])).

база_данных_клиентов(клиент("Солдусова", "Елена", "Викторовна",характеристика(45,"Высшее","Русский", 25000,"нет", "нет", "да"),
характеристика(30,"Высшее","Русский",10000, "да","нет","нет"),
[парт("Попов","Дмитрий","Васильевич",характеристика (17,"Среднее","Русский",7000,"нет","да","да")),
парт("Макитрин","Владимир","Леонидович",характерис тика(31,"Высшее","Русский",20000,"да","нет","да")) ,
парт("Альмендеев","Алексей","Михайлович",характери стика(18,"Высшее","Русский",20000,"да","нет","да") )])).

база_данных_клиентов(клиент("Ефремова", "Лидия", "Николаевна",характеристика(21,"Высшее","Русский", 25000,"да", "нет", "да"),
характеристика(25,"Высшее","Русский",10000, "нет","нет","да"),[])).

база_данных_клиентов(клиент("Лисневская", "Ольга", "Андреева",характеристика(27,"Высшее","Татарин",25 000,"нет", "нет", "да"),
характеристика(29,"Высшее","Русский",10000, "да","нет","нет"),
[парт("Кадетов","Николай","Васильевич",характеристи ка(32,"Среднее","Русский",17000,"нет","да","да")),
парт("Маслов","Андрей","Алексеевич",характеристика (9,"Среднее","Русский",10000,"нет","да","нет"))])).

данные(клиент(_,_,_,характеристика(_,_,_,_,_,_,_), характеристика(_,_,_,_,_,_,_),
_)).

поиск_молодой_клиент :- база_данных_клиентов(клиент(_,_,_,характеристика(_ ,_,_,_,_,_,_),характеристика(_
,_,_,_,_,_,_),L)),
поиск(парт(Ф,И,О,характеристика(Возраст,_,_,_,_,_, _)),L),минимум(N,Ф1,И1,О1),Воз
раст<N,retract(минимум(N,Ф1,И1,О1)),asserta(миниму м(Возраст,Ф,И,О)),fail.
минимум(100,ф,и,о).

%2-Запрос% клиент_без_партнера:- база_данных_клиентов(клиент(Ф,И,О,характеристика(_ ,_,_,_,_,_,_),характеристика(_
,_,_,_,_,_,_),L)), L=[], write(Ф," ",И," ",О," "), nl.
%3-Запрос%
%клиент_нац_возр(Нац,Возраст):- база_данных_клиентов(клиент(Ф,И,О,характеристика(N ,_,Нац,_,_,_,_),характеристика
(_,_,_,_,_,_,_),_)), Возраст>N, write(Ф," ",И," ",О," "), nl, fail.
%4-Запрос%
поиск(H, [H]).
поиск(H,[_|Хвост]):- поиск(H, Хвост).
%партнеры_клиента_без_привычек(Ф, И, О):- база_данных_клиентов(клиент(Ф,И,О,характеристика(_ ,_,_,_,_,_,_),характеристика(_
,_,_,_,_,_,_),L)), принадлежит(парт(Ф1,И1,О1,характеристика(_,_,_,_,_ ,"нет",_)),L), write(Ф1," ",И1," ",О1," "), nl, fail.
%5-Запрос%
%клиент_нет_детей:-база_данных_клиентов(клиент(Ф,И,О,характеристика(_ ,_,_,_,"нет",_,_),характеристика(_,_,_,_,"да",_,_) ,_)), write(Ф," ",И," ",О," "), nl, fail.
goal
not(поиск_молодой_клиент), минимум(Возраст,Фамилия,Имя,Отчество).
%клиент_без_партнера.
%клиент_нац_возр("Русский",30).
%партнеры_клиента_без_привычек("Солдусова", "Елена", "Викторовна").
%клиент_нет_детей.
Задача 9
/*Предметная область – спортивные соревнования. Каждое соревнование может быть описано структурой: ранг соревнований, вид спорта, год проведения, страна проведения, список команд - участников. Команды - участники могут быть описаны следующей структурой: название команды, страна, результаты соревнований. Результаты соревнований могут быть описаны списком структур: название команды – соперника, страна, тип результата (выигрыш, проигрыш, ничья).
Реализовать следующие типы запросов:
1. Найти все команды указанного ранга соревнований и года проведения, у которых не было ни одного проигрыша;
2. Найти все страны, где проводились Олимпийские игры до указанного года;
3. Найти всех соперников указанной команды в соревнованиях заданного ранга в заданном году;
4. Найти вид спорта, в котором проводились соревнования в заданном году;
5. Найти все команды указанной страны, участвовавшие в соревнованиях заданного ранга.
*/
domains
спортивные_соревнвания = структура_соревнований(ранг, спорт, год, страна, список_участников)
ранг, спорт, страна = string
год = integer
список_участников= участники*

участники = структура_участников(имя, страна, список_результатов)
имя = string
список_результатов = результаты_соревнований*

результаты_соревнований = структура_результатов (имя, страна, результат)
результат=string

predicates
comp(спортивные_соревнвания)
поиск_проигравших(список_результатов)
поиск_команд(список_участников)
поиск_команд2(список_участников, имя)
поиск_команд3(список_участников, страна)
find1(ранг, год)
find2(страна, год)
find3(имя, ранг, год)
find4(спорт,год)
find5(страна,ранг)
facts
dcom1(имя)
dcom2(страна)
dcom3(список_результатов)
dcom4(спорт)
dcom5(имя)
clauses
%1-struc
comp(структура_соревнований("Олимпада","Футбол",19 80,"Россия",
[структура_участников("Интер","Италия",[структура_результатов("Спартак","Россия","Проигрыш "),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Real","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Спартак","Россия",[структура_результатов("Интер","Россия","Победа"),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Real","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Реал","Испания",[структура_результатов("Спартак","Россия","Проигрыш "),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")])])).
%2-struc
comp(структура_соревнований("Олимпада","All",2000, "Australia",
[структура_участников("Россия","Россия",[структура_результатов("Италия","Италия","Победа"),
структура_результатов("Германия","Германия","Проиг рыш")]),
структура_участников("Италия","Италия",[структура_результатов("Россия","Россия","Проигрыш" ),
структура_результатов("Германия","Германия","Проиг рыш")]),
структура_участников("Германия","Германия",[структура_результатов("Италия","Италия","Победа"),
структура_результатов("Россия","Россия","Проигрыш" )])])).
%3-struc
comp(структура_соревнований("Чемпион_России","Футб ол",2005,"Россия",
[структура_участников("Крылья_Советов","Россия",[структура_результатов("Спартак","Россия","Победа") ,
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Спартак","Россия",[структура_результатов("Зенит","Россия","Победа"),
структура_результатов("Крылья_Советов","Россия","П роигрыш")]),
структура_участников("Зенит","Россия",[структура_результатов("Спартак","Россия","Победа") ,
структура_результатов("Крылья_Советов","Россия","П роигрыш")])])).
%4-struc
comp(структура_соревнований("Чемпион_Европы","Футб ол",2000,"Greece",
[структура_участников("Интер","Италия",[структура_результатов("Спартак","Россия","Проигрыш "),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Спартак","Россия",[структура_результатов("Интер","Россия","Победа"),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Реал","Испания",[структура_результатов("Спартак","Россия","Проигрыш "),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")])])).
%5-struc
comp(структура_соревнований("Чемпион_Италии","Футб ол",2002,"Италия",
[структура_участников("Интер","Италия",[структура_результатов("Спартак","Россия","Победа") ,
структура_результатов("Крылья_Советов","Россия","П обеда"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")]),
структура_участников("Челси","Англия",[структура_результатов("Интер","Россия","Победа"),
структура_результатов("Крылья_Советов","Россия","П обеда"),
структура_результатов("Реал","Испания","Победа"),
структура_результатов("Зенит","Россия","Победа")]),
структура_участников("Реал","Испания",[структура_результатов("Спартак","Россия","Проигрыш "),
структура_результатов("Крылья_Советов","Россия","П роигрыш"),
структура_результатов("Челси","Англия","Победа"),
структура_результатов("Зенит","Россия","Проигрыш")])])).

%F I N D S
% 1 **** ------------------------------------------------------------------------------------------
поиск_проигравших([H1|T1]) :- H1=структура_результатов(_,_,"Проигрыш"),!.
поиск_проигравших([H1|T1]) :- поиск_проигравших(T1).
поиск_команд([]).
поиск_команд([]):-dcom1(Team),write('#',Team).
поиск_команд([H|T]) :- H=структура_участников(Team,_,L1),not( поиск_проигравших(L1)),write(Team),nl,not(dcom1(Te am)),assertz(dcom1(Team)),поис
к_команд(T).
поиск_команд([H|T]) :- H=структура_участников(Team,_,L1),поиск_проигравши х(L1),поиск_команд(T).

%find1(_,_):-dcom1(Team),write('#',Team).
find1(Rang,Year) :- comp(структура_соревнований(Rang,_,Year,_,List_tea m)),поиск_команд(List_team),fa
il.
% 2 **** ------------------------------------------------------------------------------------------
find2(_,_):-dcom2(Country),write('#',Country).
find2(Country,YearFnd) :- comp(структура_соревнований("Олимпада",_,Year,Coun try,_)),Year<YearFnd,not(dcom2(Country)),assertz(d com2(Country)).
% 3 **** ------------------------------------------------------------------------------------------
поиск_команд2([],_).

поиск_команд2([H2|T2],Tm) :- H2=структура_участников(Tm,_,L2), nl, not(dcom3(L2)),
asserta(dcom3(L2)),write(L2),nl,поиск_команд2(T2,T m).

поиск_команд2([H2|T2],Tm) :- поиск_команд2(T2,Tm).
find3(Team1,Rang1,Year1) :- dcom3(L2),!,write('#',L2),nl.
find3(Team1,Rang1,Year1) :- comp(структура_соревнований(Rang1,_,Year1,_,List_t eam1)),
поиск_команд2(List_team1,Team1).

% 4 **** ------------------------------------------------------------------------------------------
find4(Sport,YearFnd) :- dcom4(Sport),write('#',Sport).
find4(Sport,YearFnd) :- comp(структура_соревнований(_,Sport,Year,_,_)),Yea r=YearFnd,not(dcom4(Sport)),as
sertz(dcom4(Sport)).
% 5 **** ------------------------------------------------------------------------------------------
поиск_команд3([],_).
поиск_команд3([H3|T3],Cont) :- H3=структура_участников(Tm,Cont,_),not(dcom5™),
write('*',Tm),nl,assertz(dcom5™).
поиск_команд3([H3|T3],Cont) :- поиск_команд3(T3,Cont).
find5(_,_):-dcom5™,write('#',Tm).
find5(Cn,Rang2) :- comp(структура_соревнований(Rang2,_,_,_,List_team2 )),
поиск_команд3(List_team2,Cn).
goal
%find1("Чемпион_Италии",2002), find1("Чемпион_Италии",2002), nl.
%find2(Con,2000), find2(Con,2000), nl.
find3("Интер","Чемпион_Италии",2002), nl, find3("Интер","Чемпион_Италии",2002), nl.
%find4(Sport,2000),find4(Sport,2000).
%find5("Испания","Чемпион_Италии"),find5("Испания" ,"Чемпион_Италии").
Задача 10
/*Задание.
1. Создать базу данных о заданной предметной области в виде множества
фактов языка Пролог.
Информацию о каждом компоненте БД представить в виде структуры.
2. Разработать набор предикатов, осуществляющих взаимодействие с БД,
при помощи которых можно реализовать все типы запросов,
приведенные в варианте задания.
3. Предусмотреть проверку факта, являющегося ответом на запрос в БД.
Если такой факт существует,то выдать его в качестве ответа на запрос.
Если такого факта не существует в базе данных,
то запустить запрос на выполнение и записать результат в БД.
Предметная область - видеотека. Каждая видеокассета может быть описана структурой:
название фильма, год создания, киностудия, атрибуты фильма.
Атрибуты фильма могут быть описаны структурой: автор сценария, режиссер,
исполнители основных ролей, премии.
Исполнители основных ролей могут быть описаны списком из следующих структур:
фамилия, роль.
Премии могут быть описаны списком из следующих структур: название фестиваля,
год проведения, вид премии.
Реализовать следующие типы запросов:
1. Найти все фильмы определенного режиссера, за указанный период;
2. Найти все фильмы, получившие премии на определенном фестивале;
3. Найти всех режиссеров, фильмы которых создавались на одной киностудии;
4. Найти все роли, определенного актера, которые он сыграл в фильмах, которые получили какие-либо премии;
5. Найти всех сценаристов, в фильмах которых снимался определенный актер.

*/
domains
исполнители=исполнитель*
исполнитель=исполнитель(фамилия, роль)
название_фестиваля, вид_премии, фамилия, роль,автор_сценария, режиссер, роль, название, студия = symbol
год = ushort
премии=премия*
премия= премия(название_фестиваля, год, вид_премии)
атрибуты = атрибуты(автор_сценария, режиссер, исполнители, премии)
видеокассета = видеокассета(название, год, студия, атрибуты)

/************************************************** ******************************
**************************/
facts %динамическая база данных - хранит результаты запросов
база1(название, режиссер, год, год)
база2(название,название_фестиваля)
база3(режиссер, студия)
база4(фамилия, роль)
база5(фамилия, автор_сценария)
/************************************************** ******************************
*******************************/
predicates
видеокассета(название, год, студия, атрибуты)
%1. Найти все фильмы определенного режиссера, за указанный период;
фильмы_режиссер_период( режиссер, год, год)
%2. Найти все фильмы, получившие премии на определенном фестивале;
фильм_премии_на_фестивате(название_фестиваля)
подпрога2(название_фестиваля, премии, название).
%3. Найти всех режиссеров, фильмы которых создавались на одной киностудии;
режиссеры_киностудия(студия)
%4. Найти все роли, определенного актера, которые он сыграл в фильмах, которые получили какие-либо премии;
роли_премии(фамилия)
подпрога4(исполнители, фамилия,премии)

%5. Найти всех сценаристов, в фильмах которых снимался определенный актер.
сценаристы_актер(фамилия)
подпрога5(фамилия,исполнители, автор_сценария)
программа
код(integer)
цикл
показать_все

/************************************************** ******************************
******************************/
clauses
цикл.
цикл:-цикл.

видеокассета(игра, 1997, polygram,
атрибуты(автор1, девид_финчер, [исполнитель(майкл_дуглас, николас),исполнитель(шон_пенн, конрад)], %%%
[премия(канны, 1998, женская_роль)])).

видеокассета(человек_мотылёк, 2001, miramax,
атрибуты(автор1, марк_пеллингтон, [исполнитель(ричард_гир,джон_клайн),исполнитель(лор а_линни, подруга)], %%
[премия(ника, 2000, сценарий),премия(тефи, 2000, мужская_роль)])).
видеокассета(мутанты, 1997, miramax,
атрибуты(автор3, дель_торо,[ исполнитель(мира_сорвино,мутант1)],
[премия(оскар, 1998, спец_эффекты)])).
видеокассета(сладкий_ноябрь,2000, warner_bros,
атрибуты(автор1,пет_о_коннор, [исполнитель(киану_ривс,нельсон),исполнитель(шарлиз _терон, сара)],
[])). %%
видеокассета(пираты_карибского_моря, 2003, walt_disney,
атрибуты(автор1, орландо_блум, [исполнитель(джонни_депп, капитан)],
[премия(ника, 2003, режессура)])).
видеокассета(королева_проклятых, 1999, polygram,
атрибуты(автор3, дель_торо, [исполнитель(стьюард_таунсенд, летат),исполнитель(элайа, акаша)], %%
[премия(оскар, 2000, мужская_роль),премия(оскар, 2000, женская_роль)])).
видеокассета(матрица2, 2003, warner_bros,
атрибуты(автор3, wachowski, [исполнитель(киану_ривс, нео),исполнитель(кари_анн_мосс, она)], %%
[премия(оскар, 2003, мужская_роль),премия(оскар, 2003, женская_роль)])).

видеокассета(матрица3, 2003, warner_bros,
атрибуты(автор3, wachowski, [исполнитель(киану_ривс, нео),исполнитель(кари_анн_мосс, она)], %%
[])).

%************************************************* *******************************
******************************
%1. Найти все фильмы определенного режиссера, за указанный период;
фильмы_режиссер_период( Режиссер, Год1, Год2):-
база1(Название, Режиссер, Год1, Год2), write(Название).
фильмы_режиссер_период( Режиссер, Год1, Год2):-
видеокассета(Название, Год, _, атрибуты(_, Режиссер,_,_ )), Год>=Год1, Год<=Год2,
not(база1(Название, Режиссер, Год1, Год2)),
assertz(база1(Название, Режиссер, Год1, Год2)),
write(Название,". "),fail.
фильмы_режиссер_период( _, _, _):- nl.

%************************************************* *******************************
******************************
%2. Найти все фильмы, получившие премии на определенном фестивале;
фильм_премии_на_фестивате(Название_фестиваля):-
база2(Название,Название_фестиваля),write(Название) .
фильм_премии_на_фестивате(Название_фестиваля):-
видеокассета(Название, _,_,атрибуты(_,_,_,Список)), подпрога2(Название_фестиваля,Список,Название), fail.
фильм_премии_на_фестивате(_):- nl.

подпрога2(_,[], _):-!.
подпрога2(Название_фестиваля,[премия(Название_фестиваля,_,_)|Хвост], Название):-
not(база2(Название, Название_фестиваля)),
assertz(база2(Название, Название_фестиваля)),
write(Название," ."), подпрога2(Название_фестиваля, Хвост, Название).
подпрога2(Название_фестиваля,[премия(_,_,_)|Хвост], Название):-
подпрога2(_, Хвост, Название).

%************************************************* *******************************
******************************
%3. Найти всех режиссеров, фильмы которых создавались на одной киностудии;
режиссеры_киностудия(Студия):-база3(Режиссер, Студия), write(Студия).
режиссеры_киностудия(Студия):-
видеокассета(_,_,Студия,атрибуты(_, Режиссер,_,_)),
not(база3(Режиссер, Студия)), assertz(база3(Режиссер, Студия)),
write(Режиссер,". "), fail.
режиссеры_киностудия(_):-nl.

%************************************************* *******************************
*************************
%4. Найти все роли, определенного актера, которые он сыграл в фильмах, которые получили какие-либо премии;
роли_премии(Фамилия):-база4(Фамилия, Роль), write(Роль).
роли_премии(Фамилия):-видеокассета(_,_,_,атрибуты(_,_,Список_исполнителе й, Список_премий)),
подпрога4(Список_исполнителей, Фамилия,Список_премий), fail.
роли_премии(_):-nl.

подпрога4([],_,[]):-!.
подпрога4([исполнитель(Фамилия,Роль)|Хвост], Фамилия,Список_премий):-
not(база4(Фамилия, Роль)),assertz(база4(Фамилия, Роль)), write(Роль,", "),
подпрога4(Хвост, Фамилия,Список_премий).
подпрога4([исполнитель(Фамилия1,Роль)|Хвост], Фамилия,Список_премий):-
подпрога4(Хвост, Фамилия,Список_премий).

%************************************************* *******************************
*************************
%5. Найти всех сценаристов, в фильмах которых снимался определенный актер.
сценаристы_актер(Фамилия):- база5(Фамилия, Сценарист), write(Сценарист).
сценаристы_актер(Фамилия):-
видеокассета(_,_,_,атрибуты(Сценарист,_,Список_исп олнителей,_)),
подпрога5(Фамилия,Список_исполнителей, Сценарист),fail.
сценаристы_актер(_):-nl.

подпрога5(_,[],_):-!.
подпрога5(Фамилия,[исполнитель(Фамилия,_)|Хвост], Сценарист):-
not(база5(Фамилия, Сценарист)), assertz(база5(Фамилия, Сценарист)),
write(Сценарист,", "), подпрога5(Фамилия, Хвост, Сценарист).
подпрога5(Фамилия,[исполнитель(_,_)|Хвост], Сценарист):- подпрога5(Фамилия,Хвост,Сценарист).


/************************************************** ******************************
*************************/
код(0):- write("ВСЕ!!!!"),nl.
код(1):-
write("1. Найти все фильмы определенного режиссера, за указанный период; "), nl,
write("Введите фамилию режиссера: "), readln(Режиссер),
write("С какого года смотреть: "), readint(Год1),
write("По какой год смотреть: "), readint(Год2), write( ":- "),
фильмы_режиссер_период( Режиссер, Год1, Год2), nl, nl, fail.
код(2):-
write("2. Найти все фильмы, получившие премии на определенном фестивале."), nl,
write("Введите названпие фестиваля: "), readln(Название_фестиваля), write( ":- "),
фильм_премии_на_фестивате(Название_фестиваля), nl, nl, fail.
код(3):-
write("3. Найти всех режиссеров, фильмы которых создавались на одной киностудии."), nl,
write("Введите название киностудии: "), readln(Студия), write( ":- "),
режиссеры_киностудия(Студия), nl, nl, fail.
код(4):-
write("4. Найти все роли, определенного актера, которые он сыграл в фильмах,"),nl,
write(" которые получили какие-либо премии."), nl,
write("Введите фамилию актера: "), readln(Фамилия), write( ":- "),
роли_премии(Фамилия), nl, nl, fail.
код(5):-
write("5. Найти всех сценаристов, в фильмах которых снимался определенный актер."), nl,
write("Введите фамилию актера: "), readln(Фамилия), write(":-"),
сценаристы_актер(Фамилия), write("."), nl, nl, fail.

код(6):- показать_все, fail.

% печать всех элементов базы данных
показать_все:- видеокассета(Назв, Год, Студ, атрибуты(Сцен, Реж, Исп, Прем)),
write("видеокассета(",Назв,", ",Год,", ",Студ,", атрибуты(",Сцен,", ",Реж,", ",Исп,", ",ПРем,")) "), nl, fail.
показать_все:- nl, nl.

программа:- цикл, readint(Num),код(Num),!.
goal
программа.
--------------------------------------------------------------------------------------------------------------------------
Далее представляю игровые задачки и головоломки.
Задача коммивояжера
/************************************************** ************
Коммивояжёр. Поиск в глубину.
************************************************** ************/
domains ss = string*
database
путь(string,integer,string)
оценка(ss,integer)
predicates
оптим_маршрут(ss,integer)
маршруты(string,integer,ss,integer)
вариант(string,integer,string,ss,integer)
участок(string,integer,string)
уник(ss,ss,integer)
удалить(string,ss,ss)
принадлеж(string,ss)

clauses
оптим_маршрут(Маршрут,Длина):-путь(Начало,_,_),!,
findall(Город,путь(Город,_,_),Города),
уник(Города,_,Количество),
маршруты(Начало,Количество,Маршрут,Длина),!.

маршруты(Начало,Количество,_,_):-вариант(Начало,Количество,Начало,[Начало],0),fail.
маршруты(_,_,Маршрут,Длина):-
оценка(Маршрут,Длина).

вариант(Начало,0,От,Маршрут,Длина):-участок(От,Участок,Начало),
Длина1=Длина+Участок,
not(оценка(_,_)),
assert(оценка([Начало|Маршрут],Длина1)).
вариант(Начало,0,От,Маршрут,Длина):-участок(От,Участок,Начало),
Длина1=Длина+Участок,
оценка(_,Длина0),Длина1<Длина0,
retract(оценка(_,Длина0)),
assert(оценка([Начало|Маршрут],Длина1)).
вариант(Начало,К,От,Маршрут,Длина):-К>0,
участок(От,Участок,До),
not(принадлеж(До,Маршрут)),
Длина1=Участок+Длина, К1=К-1,
вариант(Начало,К1,До,[До|Маршрут],Длина1).

уник([Э|Х],[Э|Х2],Число):-удалить(Э,Х,Х1),!,
уник(Х1,Х2,Число1),Число = Число1+1.
уник([],[],0).
удалить(Э,[Э|Х],Х1):-!,удалить(Э,Х,Х1).
удалить(Э,[А|Х],[А|Х1]):-!,удалить(Э,Х,Х1).
удалить(_,[],[]).

участок(От,Длин,До):-путь(От,Длин,До).
участок(От,Длин,До):-путь(До,Длин,От).

принадлеж(Город,[Город|_]):-!.
принадлеж(Город,[_|Города]):-принадлеж(Город,Города).

путь("Курск",120,"Магадан").
путь("Курск",40,"Азов").
путь("Магадан",110,"Орёл").
путь("Магадан",52,"Колыма").
путь("Орёл",32,"Азов").
путь("Орёл",105,"Колыма").
путь("Азов",112,"Колыма").
goal
оптим_маршрут(Маршрут,Длина).

Задача о рюкзаке
domains
объем = integer
предметы = integer*
predicates
ранец(предметы,объем,предметы)
clauses
ранец(L,C,[A|D]):- L=[A|B],A<=C,G=C-A,ранец(B,G,D).
ранец([A|B],C,D):- A<=C,ранец(B,C,D).
ранец([],0,[]).
goal
ранец([1,2,3,4,5,6,7,8,9],40,Объем).

“Игра в восемь”
Domains
charlist=char*
coord=integer*.
point=coord*.
tree=tree(point,integer,integer,trees);leaf(point, integer,integer).
trees=tree*.
points=point*.
ind=yes;no;never.
adopt=adopt(point,integer).
adopts=adopt*.
ints=integer*.

predicates
evrsearch(point,points).
widen(points,tree,integer,tree,ind,points).
continue(points,tree,integer,tree,ind,ind,points).
foster_list(integer,adopts,trees).
insert(tree,trees,trees).
f(tree,integer).
opt_f(trees,integer).
min(integer,integer,integer).
max_f(integer).
aim(point).
bagof(point,points,adopts,adopts).
h(point,integer).
after(point,point,integer).
belong(adopt,adopts,integer).
belong(point,points,integer).
belong(integer,ints,integer).
belong(coord,point,integer).
move(coord,coord,point,point).
distance(coord,coord,integer).
sumdistance(point,point,integer).
regulate(point,integer).
regulate(point,coord,integer).
score(coord,coord,integer).
showsol(points).
showpos(point).

char_int_(charlist,coord,coord,integer).
convert(integer,coord,coord).
do_(integer,coord,point,point).
contains(integer,coord,integer,integer).
contain(coord,point,integer,integer).
c(point,integer,coord).
string_chlist(string,charlist).
hello(point,point).
Start.
Ex(char).
St(char).
Start1(point,point,integer).
Clrcentr(integer,point,point).
sc(point,point,coord,point).
conv(point,point,point).
Comp(coord).
doit(point,integer,point,integer).
do1(point,integer,point,integer).
Issolut(point,integer,point,integer,integer).
Chek(integer,point).

Goal

St('y').

Clauses

Comp(H):- H=[1,3];
H=[3,3];
H=[1,1];
H=[3,1].

Start1([H|T],Sol,J):- H=[2,2], Sol=[H|T];Comp(H), after([H|T],W,C),
Start1(W,Sol,J);
contain([2,2],[H|T],0,J), Sol=[H|T].

Clrcentr(J,[H|T],Sol1):- Y=H, Sol=[[2,2]], sc(T,Sol,Y,Sol1).

sc([],Sol,_,Sol).
sc([H|T],Sol,Y,SS):- H=[2,2], Sol1=[Y|Sol],
sc(T,Sol1,Y,SS);
Sol1=[H|Sol], sc(T,Sol1,Y,SS).

conv([],Res,Res).
conv([H|S],Res,W):- Res1=[H|Res], Conv(S,Res1,W).

do1(P,I,[],I).
do1(P,I,[H|T],Q1):- doit(P,J,T,Count), I1=I+Count, do1(P,I1,T,Q1).

doit(P,_,[],0).
doit(P,I,[H|T],Count):- contain(H,P,1,J), Issolut(P,0,T,J,Count).

Issolut(P,I,[],J,I).
Issolut(P,I,[H|T],J,A):- contain(H,P,1,K),
K-J>0,
Issolut(P,I,T,J,A);
I1=I+1, Issolut(P,I1,T,J,A).

Start:-
hello(Res,AimRes),!,
Start1(Res,Solution,J),
Clrcentr(J,Solution,Sol),
conv(Sol,[],[H|Sol1]),
L=[[2,2],[1,3],[2,3],[3,3],[3,2],[3,1],[2,1],[1,1],[1,2]],
do1(Sol1,0,L,Count),!,
Count1=Count mod 2,
Chek(Count1,Res).

Chek(Cnt,Res):- Cnt=0,
evrsearch(Res,[H1|Solution1]),
not(H1=[[9,9]]),
showsol([H1|Solution1]);
H=H1, not(H=[[9,9]]),
write(" ЌҐв аҐиҐ*Ёп "), readchar(_);
nl, write(" ЏҐаҐЇ®«*Ґ*ЁҐ б⥪ "),
readchar(_),9=0.

Ex(Ch):-
write(" Џ®ўв®аЁ¬? (y) "), readchar(Ch).

St(Ch):- Ch='y',Start,
Ex(Ch1), St(Ch1);
!.

char_int_(_,IntList,L,11):- L=IntList. % ‚л१ Ґ¬ 11 бЁ¬ў®«®ў.
char_int_([H|T],IntList,L,I):- char_int(H,Y1),
Y=Y1-48, T1=[Y|IntList],
I1=I+1, char_int_(T,T1,L,I1).

contains(R,[R|T],I,I). % Џа®ўҐа塞 ЇаЁ* ¤«Ґ¦*®бвм н«Ґ¬Ґ*в R бЇЁбЄг [H|T]
contains(R,[H|T],I,J):- I1=I+1, contains(R,T,I1,J). % Ё дЁЄбЁа㥬 ҐЈ® *®¬Ґа.

contain(R,[R|T],I,I). % Џа®ўҐа塞 ЇаЁ* ¤«Ґ¦*®бвм н«Ґ¬Ґ*в R бЇЁбЄг [H|T]
contain(R,[H|T],I,J):- I1=I+1, contain(R,T,I1,J). % Ё дЁЄбЁа㥬 ҐЈ® *®¬Ґа.

c([H|T],1,H). % Џ® *®¬Ґаг н«Ґ¬Ґ*в гбв * ў«Ёў Ґ¬ ҐЈ® Є®®а¤Ё* вл.
c([H|T],I,L):- I1=I-1, c(T,I1,L).

convert(R,E,L):-
CoordList=[[3,1],[2,1],[1,1],[0,0],[3,2],[2,2],[1,2],[0,0],[3,3],[2,3],[1,3]],
contains(R,E,1,J), c(CoordList,J,L).

do_(-1,E,Ls,Res):- Res=Ls.
do_(R,E,Ls,Res):- convert(R,E,L), Ls1=[L|Ls],
R1=R-1, do_(R1,E,Ls1,Res).

string_chlist("",[]).
string_chlist(S,[H|T]):- frontchar(S,H,S1),
string_chlist(S1,T).

hello(Res,AimRes):-
string_chlist(S,Charlist), %ЏҐаҐў®¤Ё¬ бва®Єг ў бЇЁб®Є бЁ¬ў®«®ў
char_int_(Charlist,[],E,0), %ЏҐаҐў®¤Ё¬ бЇЁб®Є бЁ¬ў®«®ў ў бЇЁб®Є зЁбҐ«
do_(8,E,[],Res), % ‚ жЁЄ«Ґ бЇЁб®Є зЁбҐ« ЇҐаҐў®¤Ё¬ % ў бЇЁб®Є Є®®а¤Ё* в
write("123"),nl,
write("804"),nl,
write("765");
write(" ‚л ўўҐ«Ё *ҐЄ®а४в*лҐ ¤ **лҐ."),
readchar(_),
write(" Џ®ўв®аЁ¬? (y) "),
readchar(Ch), nl, Ch='y',
hello(Res1,AimRes1).

max_f(32767).

evrsearch(Start,Solution):-
max_f(Fmax), % Fmax>«оЎ®© f-®жҐ*ЄЁ
widen([],leaf(Start,0,0),Fmax,_,yes,Solution).


widen(P,leaf(B,_,_),_,_,yes,[B|P]):-
aim(B).
widen(P,leaf(B,F,G),Lim,Der1,Issol,Sol):-
F<=Lim,
bagof(B,P,Adopted,[]),!,
foster_list(G,Adopted,DD),
opt_f(DD,F1),
widen(P,tree(B,F1,G,DD),Lim,Der1,Issol,Sol);
Issol=never. % ЌҐв ЇаҐҐ¬*ЁЄ®ў - вгЇЁЄ
widen(P,tree(B,F,G,[D|DD]),Lim,Der1,Issol,Sol):-
F<=Lim,
opt_f(DD,OF),
min(Lim,OF,Lim1),
widen([B|P],D,Lim1,D1,Issol1,Sol),
continue(P,tree(B,F,G,[D1|DD]),Lim,Der1,Issol1,Issol,Sol).
widen(_,tree(_,_,_,[]),_,_,never,_):- !. % ’гЇЁЄ®ў®Ґ ¤ҐаҐў® - *Ґв аҐиҐ*Ё©
widen(_,Der,Lim,Der,no,_):-
f(Der,F),
F>Lim. % ђ®бв ®бв *®ў«Ґ*

widen(_,_,_,_,_,[H|Sol]):- Storage(A,_,_),
A<20000,
% makewindow($4E,$4F,$4E," ЋиЁЎЄ ",12,14,6,21),
% nl, write(" ЏҐаҐЇ®«*Ґ*ЁҐ б⥪ "),
% readchar(_),
H=[[9,9]],!.


continue(_,_,_,_,yes,yes,Sol).
continue(P,tree(B,F,G,[D1|DD]),Lim,Der1,no,Issol,Sol):-
insert(D1,DD,HDD),
opt_f(HDD,F1),
widen(P,tree(B,F1,G,HDD),Lim,Der1,Issol,Sol).
continue(P,tree(B,F,G,[D1|DD]),Lim,Der1,never,Issol,Sol):-
Issol1=never,
HDD=DD,
opt_f(HDD,F1),
widen(P,tree(B,F1,G,HDD),Lim,Der1,Issol,Sol).

foster_list(_,[],[]).
foster_list(G0,[adopt(B,C)|BB],DD):-
G=G0+C,
h(B,H), % ќўаЁбвЁЄ h(B)
F=G+H,
foster_list(G0,BB,DD1),
insert(leaf(B,F,G),DD1,DD).

% ‚бв ўЄ ¤ҐаҐў „ ў бЇЁб®Є ¤ҐаҐўмҐў „„ б б®еа *Ґ*ЁҐ¬
% гЇ®а冷з*®бвЁ Ї® f-®жҐ*Є ¬
insert(D,DD,[D|DD]):-
f(D,F),
opt_f(DD,F1),
F<=F1,!.
insert(D,[D1|DD],[D1|DD1]):-
insert(D,DD,DD1).

% Џ®«гзҐ*ЁҐ f-®жҐ*®Є
f(leaf(_,F,_),F).
f(tree(_,F,_,_),F).

opt_f([D|_],F):- f(D,F).
opt_f([],Fmax):- max_f(Fmax).

min(X,Y,X):- X<=Y,!.
min(X,Y,Y).

aim([[2,2],[1,3],[2,3],[3,3],[3,2],[3,1],[2,1],[1,1],[1,2]]).

bagof(B,P,AN,A):-
after(B,B1,C),
not(belong(B1,P,_)),
not(belong(adopt(B1,C),A,_)),
bagof(B,P,AN,[adopt(B1,C)|A]),!.
bagof(B,P,A,A).

belong(B,[B|_],1).
belong(B,[H|P],N):- belong(B,P,N1), N=N1+1.

after([Vacant|List],[Piece|List1],1):-
% ‘в®Ё¬®бвм ўбҐе ¤гЈ а ў*л 1
move(Vacant,Piece,List,List1).
% ЏҐаҐбв ўЁў Џгбв® (Vacant) Ё Piece Ї®«гз Ґ¬ List1

move(P,F,[F|C],[P|C]):- distance(P,F,1).
move(P,F,[F1|C],[F1|C1]):- move(P,F,C,C1).

distance([X,Y],[X1,Y1],P):-
% Њ *еҐввҐ*®ўбЄ®Ґ а бббв®п*ЁҐ ¬Ґ¦¤г Є«ҐвЄ ¬Ё
X2=X, X3=X1,
Y2=Y, Y3=Y1,
P=abs(X-X1)+abs(Y-Y1).

% ќўаЁбвЁзҐбЄ п ®жҐ*Є h а ў* б㬬Ґ а ббв®п*Ё© дЁиҐЄ
% ®в Ёе "楫Ґўле" Є«Ґв®Є Ї«об "б⥯Ґ*м гЇ®а冷зҐ**®бвЁ",
% г¬*®¦Ґ*** п * 3
h([Vacant|List],H):-
aim([Vacant1|AList]),
Sumdistance(List,AList,P),
regulate(List,Reg),
H=P+3*Reg.

Sumdistance([],[],0).
Sumdistance([F|C],[F1|C1],P):-
distance(F,F1,P1),
Sumdistance(C,C1,P2),
P=P1+P2.

regulate([First|C],Reg):-
regulate([First|C],First,Reg).
regulate([F1,F2|C],First,Reg):-
score(F1,F2,Reg1),
regulate([F2|C],First,Reg2),
Reg=Reg1+Reg2.
regulate([Last],First,Reg):-
score(Last,First,Reg).

score([2,2],_,1):-!. %”ЁиЄЁ ў жҐ*вॠ- 1 ®зЄ®
score([1,3],[2,3],0):-!. % Џа ўЁ«м* п Ї®б«Ґ¤®ў ⥫м*®бвм
score([2,3],[3,3],0):-!.
score([3,3],[3,2],0):-!.
score([3,2],[3,1],0):-!.
score([3,1],[2,1],0):-!.
score([2,1],[1,1],0):-!.
score([1,1],[1,2],0):-!.
score([1,2],[1,3],0):-!.
score(_,_,2):-!. %ЌҐЇа ўЁ«м* п Ї®б«Ґ¤®ў ⥫м*®бвм

% Ћв®Ўа ¦Ґ*ЁҐ аҐи о饣® ЇгвЁ ў ўЁ¤Ґ бЇЁбЄ Ї®§ЁжЁ© * ¤®бЄҐ
showsol([]).
showsol([Pos|List]):-
showsol(List),
nl, write("---"),
showpos(Pos),
ReadChar(_).

% Ћв®Ўа ¦Ґ*ЁҐ Ї®§ЁжЁЁ * ¤®бЄҐ
showpos(Pos):-
belong(Y,[3,2,1],_), % Џ®а冷Є Y-Є®®а¤Ё* в
nl, belong(X,[1,2,3],_), % Џ®а冷Є X-Є®®а¤Ё* в
belong([X,Y],Pos,N),
N1=N-1,
write(N1),
fail. % ‚®§ўа в б ЇҐаҐе®¤®¬ Є б«Ґ¤г饩 Є«ҐвЄҐ
showpos(_).

Задача о людоедах и миссионерах
domains
состояние = состояние(integer,integer,symbol)
список_состояний = состояние*
predicates
перевозить(integer,integer)
разрешенное_состояние(integer,integer)
решение(состояние,список_состояний,список_состояни й)
сдедать_движение(состояние,состояние,состояние)
новое_состояние(состояние,состояние)
поиск(состояние,список_состояний)
clauses
решение(состояние(0, 0, вправо), _, []).
решение(ТекущееСостояние, ПосещенноеСостояние, [Перемещение|ХвостПеремещениея]) :-
новое_состояние(ТекущееСостояние, СледующееСостояние),
not(поиск(СледующееСостояние, ПосещенноеСостояние)),
сдедать_движение(ТекущееСостояние, СледующееСостояние, Перемещение),
решение(СледующееСостояние, [СледующееСостояние|ПосещенноеСостояние], ХвостПеремещениея).

поиск(H,[H|_]).
поиск(H,[_|T]):-поиск(H,T).

сдедать_движение(состояние(M1, K1, влево), состояние(M2, K2, вправо), состояние(M, K, вправо)) :-
M = M1 - M2,
K = K1 - K2.
сдедать_движение(состояние(M1, K1, вправо), состояние(M2, K2, влево), состояние(M, K, влево)) :-
M = M2 - M1,
K = K2 - K1.
перевозить(2, 0).
перевозить(1, 0).
перевозить(1, 1).
перевозить(0, 1).
перевозить(0, 2).

разрешенное_состояние(X, X).
разрешенное_состояние(3, X).
разрешенное_состояние(0, X).

новое_состояние(состояние(M1, K1, влево), состояние(M2, K2, вправо)) :-
перевозить(M, K),
M <= M1,
K <= K1,
M2 = M1 - M,
K2 = K1 - K,
разрешенное_состояние(M2, K2).
новое_состояние(состояние(M1, K1, вправо), состояние(M2, K2, влево)) :-
перевозить(M, K),
M2 = M1 + M,
K2 = K1 + K,
M2 <= 3,
K2 <= 3,
разрешенное_состояние(M2, K2).
goal
решение(состояние(3,3,влево), [состояние(3,3,влево)], Путь).

Задача нахождения плана переупорядочивания кубиков
domains
list = char*
predicates
inverse(list,list,list);
perest(list,list,list,list,integer)
start(list,list)

Проверить является ли заданное бинарное дерево идеально сбалансированным дихотомическим деревом.
domains
treetype=tree(byte,treetype,treetype);empty

predicates
dichotomich(treetype)
checkleft(byte,treetype)
checkright(byte,treetype)
count(treetype,byte)
balance(treetype)
check(treetype)

clauses
checkleft(_,empty):-!.
checkleft(Elem,tree(Elemleft,Left,Right)):- Elem>Elemleft,
checkleft(Elem,Left),
checkleft(Elem,Right),!.
checkright(_,empty):-!.
checkright(Elem,tree(Elemright,Left,Right)):- Elem<Elemright,
checkright(Elem,Left),
checkright(Elem,Right),!.

dichotomich(empty).
dichotomich(tree(Elem,Left,Right)):- checkleft(Elem,Left),
checkright(Elem,Right),
dichotomich(Left),
dichotomich(Right).

count(empty,0).
count(tree(_,Left,Right),N):-count(Left, Nl),
count(Right,Nr),N=Nl+Nr+1.

balance(empty).
balance(tree(_,Left,Right)):- count(Left,Nl),count(Right,Nr),
Nl-Nr<=1,
Nl-Nr>=-1,
balance(Left),
balance(Right).

check(Tree):-nl,write("Whether the dichotomizing tree balanced is?"),nl,
write("Answer: "),
dichotomich(Tree),
balance(Tree).

goal
%check(tree(13,tree(8,tree(1,empty,empty),tree(9,e mpty,empty)),tree(27,empty,tree
(34,tree(31,empty,empty),tree(60,empty,empty))))).
%check(tree(13,tree(8,tree(1,empty,empty),tree(9,e mpty,empty)),tree(27,tree(20,em
pty,empty),tree(34,empty,tree(60,empty,empty))))).
% balance(tree(13,tree(8,tree(1,empty,empty),tree(12 ,tree(23,empty,empty),empty)),
tree(27,empty,tree(34,empty,empty)))).
%dichotomich(tree(13,tree(8,tree(1,empty,empty),tr ee(12,tree(23,empty,empty),empt
y)),tree(27,empty,tree(34,empty,empty)))).
balance(tree(6,tree(5,tree(4,empty,empty),empty),e mpty)).
clauses
inverse([],L,L).
inverse([H1|T1],P,L) :- inverse(T1,[H1|P],L).

perest([],[],_,_,0):-!.

perest(T1,[H2],T3,[H4|T4],0):-H2=H4,write("\n2->3"),perest(T1,[],[H2|T3],T4,0).

perest([H1|T1],T2,T3,[H4|T4],0):- H1=H4,write("\n1->3"),perest(T1,T2,[H1|T3],T4,0).
perest(T1,[H2],T3,[H4|T4],0):-H2<>H4,write("\n2->3"),perest(T1,[],[H2|T3],[H4|T4],1).


perest([H11,H12|T1],[],T3,[H4|T4],0) :- H12=H4,write("\n1->2"),write("\n1->3"),perest(T1,[H11],[H12|T3],T4,0).


perest([H1|T1],[],T3,[H4|T4],X):-H1<>H4,write("\n1->3"),X1=X+1,perest(T1,[],[H1|T3],[H4|T4],X1).
perest([H1|T1],[],T3,[H4|T4],X):-H1=H4,write("\n1->2"),perest(T1,[H1],T3,[H4|T4],X).
perest(T1,[H1],[H3|T3],T4,X):-H1=H4,write("\n3->1"),X1=X-1,perest([H3|T1],[H1],T3,T4,X1).


start(L1,L2) :- inverse(L2,[],L3),perest(L1,[],[],L3,0).

goal
%5 start(['a','b','c','d'], ['b','d','c','a']).

%4 start(['a','b','c'], ['b','c','a']).
start(['a','c','d','b'], ['b','d','a','c']).

Задача о раскрашивании карты.
domains
R = string
S = R*
Страна = страна(string,R,S)
Карта = Страна*
predicates
раскрасить(Карта,S)
цвет_страны(Страна,S)
выбрать(R,S,S)
members(S,S)
member(R,S)

clauses
раскрасить([Страна|Карта],Цвета):-
цвет_страны(Страна,Цвета),
раскрасить(Карта,Цвета).
раскрасить([],_).

цвет_страны(страна(_,Цвет,Соседи),Цвета):-
выбрать(Цвет,Цвета,Цвета1),
members(Соседи,Цвета1).

выбрать(X,[X|L],L).
выбрать(X,[Y|L],[Y|T]):-выбрать(X,L,T).

members([X|L],T):-member(X,T),members(L,T).
members([],_).
member(X,[X|_]).
member(X,[_|T]):-member(X,T).
goal
Цвета = ["красный","жёлтый","синий","белый"],
Карта = [страна("Чили",A,[B,C,D]),
страна("Перу",B,[A,C,E]),
страна("Панама",C,[A,B,D,E,F]),
страна("Ямайка",D,[A,C,F]),
страна("Васюки",E,[B,C,F]),
страна("Лилипутия",F,[E,C,D])],
раскрасить(Карта,Цвета),!.


Задача о кратчайшем связывающем дереве
/*Пусть aij - расстояния между i-м и j-м городом.
Требуется построить систему дорог между городами так, чтобы Lsum -> min и
из любого города можно было бы попасть в любой другой город.*/

domains
city = symbol
cities = city*
path = city*
way = way( city, city)
ways = way*
pathes = path*

predicates
repeat

inList( way, ways)
inList( city, path)
inList( city, cities)
inList( path, pathes)
enumItems( ways, integer)
enumItems( cities, integer)
append( pathes, pathes, pathes)

existWay( city, city)

path( city, city)

path1( city, path)
findPath( city, city)
is_found( integer)

inputMap( char)
inputMap1
inputMap4
nondeterm inputWay( integer, cities, ways)
nondeterm includeCity( city, cities, cities)
nondeterm includeWay( way, ways, ways)

endFind

database
map( cities, ways)
found_count( integer)
pathes( pathes)

goal
nl, write( "Будете вводить карту (y/n)?"),
readchar( UA), inputMap( UA),
nl, write( "Введите начальную вершину: " ), readln( BegCity),
write( "Введите конечную вершину: "), readln( EndCity),
nl, write( "Найденные пути:"),
!,
time( H1, M1, S1, _),
findPath( BegCity, EndCity),
time( H2, M2, S2, _),
endFind,
Time = (H2-H1)*3600 + (M2-M1)*60 + (S2-S1),
nl,
nl, write( "Время поиска - ", Time, " сек."),
nl, write( "Конец. Нажмите любую клавишу...")
.

clauses

repeat.
repeat :- repeat.

/************************************************** **************/
/* Работа со списками */
/************************************************** **************/

inList( Item, [Item | _]).
inList( Item, [_ | Tail]) :-
inList( Item, Tail)
.

enumItems( [], 0).
enumItems( [_ | List], NumItems) :-
enumItems( List, SubNumItems),
NumItems = SubNumItems + 1
.

append( [], List, List).
append( [Item | L1], L2, [Item | L3]) :-
append( L1, L2, L3)
.

/************************************************** **************/
/* Работа с картами */
/************************************************** **************/

existWay( X, Y) :-
map( _, Ways),
inList( way( X, Y), Ways)
.

/************************************************** **************/
/* Поиск */
/************************************************** **************/

found_count( 0).

pathes( []).

path1( BegCity, [BegCity | CurPath]) :-
!,
L = [BegCity | CurPath],
pathes( Pathes),
not( inList( L, Pathes)),
append( Pathes, [L], NewPathes),
retract( pathes( _)),
assert( pathes( NewPathes)),
nl, write( " "), write( L),
found_count( F),
retract( found_count( _)),
NF = F + 1,
assert( found_count( NF)),
!, fail
.
path1( BegCity, [CurCity | CurPath]) :-
existWay( NextCity, CurCity),
not( inList( NextCity, CurPath)),
path1( BegCity, [NextCity, CurCity | CurPath])
.

path( BegCity, EndCity) :-
path1( BegCity, [EndCity])
.
path( _, _).

is_found( 0) :-
nl, write( " Нет"), !
.
is_found( N) :-
nl, write( "Всего: "), write( N)
.

findPath( BegCity, EndCity) :-
path( BegCity, EndCity),
found_count( F),
is_found( F)
.

/************************************************** **************/
/* Ввод карты */
/************************************************** **************/

inputMap( 'y') :-
inputMap4.
inputMap( 'Y') :-
inputMap4.
inputMap( _) :-
inputMap1.

inputMap1 :-
write( "Нет"),
assert( map(
[a, b, c, d, e],
[ way(a, b), way(b, c), way(c, a)
, way(b, d), way(c, d), way(b, e), way(c, e)
, way(d, a)])
)
.


inputMap4 :-
write( "Да"),
nl, write( "Введите количество путей: "),
readint( NumWays),
inputWay( NumWays, Cities, Ways),
enumItems( Cities, NumCities),
nl, write( "Всего городов: ", NumCities),
assert( map( Cities, Ways))
.

inputWay( 0, [], []).
inputWay( NumWays, Cities, Ways) :-
NewNumWays = NumWays - 1,
inputWay( NewNumWays, Cities1, Ways1),
repeat,
nl, write( "Путь #", NumWays), nl,
write( " Нач.город: "), readln( City1),
write( " Кон.город: "), readln( City2),
includeWay( way( City1, City2), Ways1, Ways),
includeCity( City1, Cities1, Cities2),
includeCity( City2, Cities2, Cities)
.

includeCity( City, [], [City]).
includeCity( City, [City | OtherCities], [City | OtherCities]).
includeCity( City, [City0 | OtherCities], [City0 | NewCities]) :-
includeCity( City, OtherCities, NewCities)
.

includeWay( way(City1, City2), [], [way( City1, City2)]).
includeWay( way(City1, City2), [way(City1, City2) | OtherWays], [way(City1, City2) | OtherWays]) :-
write( "Путь между этими городами уже введен! Повторите ввод."), nl,
!, fail.
includeWay( way(City1, City2), [Way0 | OtherWays], [Way0 | NewWays]) :-
includeWay( way(City1, City2), OtherWays, NewWays).
/************************************************** **************/
/* Проверка успешности поиска */
/************************************************** **************/
endFind :-
beep,
retract( map( _, _)),
retract( found_count( _)),
assert( found_count( 0))
Ответить с цитированием
  (#2 (permalink)) Старый
Mnior Mnior вне форума
Member
 
Сообщений: 487
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 19.12.2002
По умолчанию 13.10.2006, 10:38

Пока не могу врубиться ваще ни во что, зачем и почему, так как чел либо сильно спешит, либо не уважает читателей.

Прошу, когда выставляешь код, окантуй его тегами кода.
Ответить с цитированием
  (#3 (permalink)) Старый
Винитарх Винитарх вне форума
Специалист
 
Аватар для Винитарх
 
Сообщений: 7,864
Сказал(а) спасибо: 2
Поблагодарили 287 раз(а) в 287 сообщениях
Регистрация: 01.03.2003
Адрес: Краснодар
По умолчанию 14.10.2006, 03:13

Kolobaz !!!
Мы очень рады видеть Вас на нашем форуме. Вы привели очень много исходников и это, как факт, очень похвально. Однако, по правилам форума создаваемые темы должны быть посвящены одной теме (простите за каламбур), а у Вас их больше десятка. Во-вторых, у Вас есть программы, которые либо неэффективны, либо взяты с форума.
Например, задача №2 (разделение списка на два так, чтобы нечетные (по номеру) элементы были в первом вписке, а четные - во втором.) имеет лучшее решение:
Код:
domains
list = integer*
predicates
раздел(list,list,list)
clauses
раздел([Нечёт,Чёт|L],[Нечёт|L1],[Чёт|L2]):-раздел(L,L1,L2).
раздел([Нечёт|L],[Нечёт],[]).
раздел(_,[],[]).
Задача №3 (удаление элемента из списка) должна быть сформулирована так: удаление ВСЕХ ВХОЖДЕНИЙ элемента из списка.
Задача №5 (определение номера позиции в списке, с которого начинается заданный подсписок) имеет решение один предикатом:
Код:
domains IL = integer*
predicates
nondeterm sub_PosSL(IL,IL,integer)
goal sub_PosSL([8,2,4,3,5,1],[3,5,1],Pos).
clauses
sub_PosSL(_,[],I):-bound(I).
sub_PosSL([A|L],[A|L1],1):-sub_PosSL(L,L1,1).
sub_PosSL([A|L],[B|L1],I):-A<>B,sub_PosSL(L,[B|L1],J),I=J+1.
плюс к этому на форуме лежит прога параллельного поиска подсписка в списке, имеющая непревзойдённые временные характеристики.
Решение задачи коммивояжера Вы взяли с форума. Даже не удосужились изменить имена предикатов, переменных и сеть городов.
Исходник решения задачи о раскраске карты Вы тоже взяли с форума - совпадение полное, вплоть до названий стран.
В следующий раз будьте внимательны.

Цитата:
Прошу, когда выставляешь код, окантуй его тегами кода.
Видать придётся это делать мне
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Решение задач $ back191 Задания за деньги 0 26.03.2012 12:54
Решение задач Nooau Pascal 1 09.01.2012 18:49
решение задач на Прологе farzona Задания за деньги 2 07.11.2011 20:45
Решение математических задач алгоритмом Esca Java 2 21.02.2011 20:54
Необходимо решение задач Pavlik24 Prolog 4 10.01.2010 17:07
Решение задач на VBA ivory Visual Basic 1 09.04.2009 23:29
Решение простых задач на С++ fetfrumos Вопросы начинающих программистов 3 01.04.2009 08:08
ПАЗЛСПОРТ, решение интересных задач loginN Prolog 28 08.05.2008 02:44
Одно решение NP-полных задач Винитарх Prolog 6 16.03.2007 20:55
Решение логических задач!!! Sever Prolog 1 19.04.2005 20:18
Решение задач математическим способом Anonymous Вопросы начинающих программистов 1 07.06.2004 14:49



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов