Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Prolog
Перезагрузить страницу Поищу ка в ширину ка (произносить с японским акцентом)))
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию Поищу ка в ширину ка (произносить с японским акцентом))) - 01.04.2012, 19:56

Visual Prolog Код:
shirka.cl:
class shirka
    open core
domains
    predicate_nd{A,B} = (A) -> B nondeterm.
predicates
     chain:(Elem*,predicate_dt{Elem},predicate_nd{Elem,Elem}) -> Elem* determ.
predicates
    classInfo : core::classInfo.
end class shirka
chain:
1. Список начальных состояний.
2. Предикат детерм - условие на конечное состояние.
3. Предикат нондетерм - переход из состояния в состояние.
На выходе цепь состояний.

Visual Prolog Код:
shirka.pro:
implement shirka
    open core, list, redBlackTree
clauses
     chain(StartList,Determ,_) = [Out]:- Out=getMember_nd(StartList), Determ(Out), !.
     chain(StartList,Determ,Nondeterm) = Out:-
                                         List=varM::new(StartList),
                                         Tree=varM::new(empty()),    
                                         forAll(StartList,{(Start):- Tree:value:=insert(Tree:value,Start,Start)}),
                                         Chain=varM::new([]),
     std::repeat(),
     List:value:= [ New || Old=getMember_nd(List:value), New=Nondeterm(Old),                  
               if Determ(New) then Chain:value:=getChain(Old,[New],Tree:value), !
                                     else  not(_=tryLookUp(Tree:value,New)), Tree:value:=insert(Tree:value,New,Old)   end if ],
     (    List:value=[], !, fail;   Chain:value<>[], Out=Chain:value, !   ).
class predicates
     getChain:(Elem,Elem*,tree{Elem,Elem}) -> Elem*.
clauses
     getChain(A,[B|C],D) = getChain(E,[A,B|C],D):- A<>B, E=tryLookUp(D,A), !.
     getChain(_,A,_) = A.
constants
    className = "shirka".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement shirka

РедБлэк не самое шустрое дерево, с памятью не понятки и прочая - чисто набросочек с консолькой поиграться)))
Примерчики следуют.
Ответить с цитированием
  (#2 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 01.04.2012, 19:58

Минимум обменов чего-то там усортировать:
Visual Prolog Код:
implement main
    open core, console, list
class facts
     c:unsigned:= 0.
clauses
    run():- init(),
      Start=[4,2,1,4,3,5,4,3,2,1],
      FinishCond={(sort(Start))},
     
 (   forAll(  shirka::chain([Start],FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
     write("фигушки...")   ),
   
         write("\n\n.........................................."), _=readChar().

class predicates
      step:(integer*) -> integer* nondeterm.
      mv:(integer*) -> integer* nondeterm.
clauses
      step(A) = mv(A).
      step([A|B]) = [A|step(B)].
      %
      mv([A,B|C]) = [B,A|C]:- B<A.
      mv([A,B|C]) = [D,B|E]:- [D|E]=mv([A|C]).
 
constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).
Цитата:
0. [4,2,1,4,3,5,4,3,2,1]
1. [3,2,1,4,3,5,4,4,2,1]
2. [1,2,1,4,3,5,4,4,2,3]
3. [1,1,2,4,3,5,4,4,2,3]
4. [1,1,2,2,3,5,4,4,4,3]
5. [1,1,2,2,3,3,4,4,4,5]

..........................................
step здесь халтура полная - по серьёзному надо много чего учитывать. Лень заморачиваться.
Здесь и далее примерчики простоты для, а не оптимизации ради.
Ответить с цитированием
  (#3 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 01.04.2012, 20:00

Ханойские блинчики:
Visual Prolog Код:
implement main
    open core, console, list
class facts
     c:unsigned:= 0.
clauses
    run():- init(),
      Start=[[],[],[],[],[1,2,3,4,5,6,7,8]],
      FinishCond={([[1,3,5,7],[2,4,6,8],[],[],[]])},
     
 (   forAll(  shirka::chain([Start],FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
     write("фигушки...")   ),
   
         write("\n\n.........................................."), _=readChar().

class predicates
     step:(integer**) -> integer** nondeterm.
clauses
     step(A) = down(B,C):- B=up(A,C).
class predicates
     up:(integer**,integer**) -> integer nondeterm (i,o).
clauses
     up([[A|B]|C],[B|C]) = A.
     up([A|B],[A|C]) = up(B,C).
class predicates
     down:(integer,integer**) -> integer** nondeterm.
clauses
     down(A,[B|C]) = [[A|B]|C]:- if B=[D|_] then A<D end if.
     down(A,[B|C]) = [B|down(A,C)].

constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).
Цитата:
0. [[],[],[],[],[1,2,3,4,5,6,7,8]]
1. [[1],[],[],[],[2,3,4,5,6,7,8]]
2. [[1],[2],[],[],[3,4,5,6,7,8]]
3. [[1],[2],[3],[],[4,5,6,7,8]]
4. [[1],[2],[3],[4],[5,6,7,8]]
5. [[1],[2],[],[3,4],[5,6,7,8]]
6. [[1],[],[],[2,3,4],[5,6,7,8]]
7. [[1],[5],[],[2,3,4],[6,7,8]]
8. [[1],[5],[6],[2,3,4],[7,8]]
9. [[],[5],[1,6],[2,3,4],[7,8]]
10. [[7],[5],[1,6],[2,3,4],[8]]
11. [[5,7],[],[1,6],[2,3,4],[8]]
12. [[5,7],[8],[1,6],[2,3,4],[]]
13. [[5,7],[8],[1,6],[3,4],[2]]
14. [[3,5,7],[8],[1,6],[4],[2]]
15. [[1,3,5,7],[8],[6],[4],[2]]
16. [[1,3,5,7],[6,8],[],[4],[2]]
17. [[1,3,5,7],[4,6,8],[],[],[2]]
18. [[1,3,5,7],[2,4,6,8],[],[],[]]

..........................................
Второй аргумент в shirka::chain предикат детерм не просто так, кстати. Можно развлекаться.
Здесь, например, если раскидать чёт-нечёт по разным кучкам и не важно где будут эти кучки, то:
Visual Prolog Код:
...
FinishCond={(Finish):- difference([[1,3,5,7],[2,4,6,8]],Finish)=[]},
...
И:
Цитата:
0. [[],[],[],[],[1,2,3,4,5,6,7,8]]
1. [[1],[],[],[],[2,3,4,5,6,7,8]]
2. [[1],[2],[],[],[3,4,5,6,7,8]]
3. [[],[1,2],[],[],[3,4,5,6,7,8]]
4. [[3],[1,2],[],[],[4,5,6,7,8]]
5. [[3],[1,2],[4],[],[5,6,7,8]]
6. [[],[1,2],[3,4],[],[5,6,7,8]]
7. [[5],[1,2],[3,4],[],[6,7,8]]
8. [[5],[1,2],[3,4],[6],[7,8]]
9. [[],[1,2],[3,4],[5,6],[7,8]]
10. [[7],[1,2],[3,4],[5,6],[8]]
11. [[5,7],[1,2],[3,4],[6],[8]]
12. [[3,5,7],[1,2],[4],[6],[8]]
13. [[1,3,5,7],[2],[4],[6],[8]]
14. [[1,3,5,7],[2],[4],[],[6,8]]
15. [[1,3,5,7],[2],[],[],[4,6,8]]
16. [[1,3,5,7],[],[],[],[2,4,6,8]]

..........................................
Ответить с цитированием
  (#4 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 01.04.2012, 20:01

Переправа.
["_boat","man","women","girl","girl","boy","boy","b andit","policeman"]
Лодка вмещает двоих.
Управляет лодкой кто-то из ["man","women","policeman"].
Мэна нельзя оставлять с гёрлами без вумен.
Вумен нельзя оставлять с боями без мэна.
Бандита без полисмена нельзя оставлять ни с кем.
Visual Prolog Код:
implement main
    open core, console, list
class facts
     c:unsigned:= 0.
     all:string*:= sort(["_boat","man","women","girl","girl","boy","boy","bandit","policeman"]).
     cap:string*:= ["man","women","policeman"].
     toMove:string**:= erroneous.
clauses
    run():- init(),
 toMove:=[sort(L)|| V=getMember_nd(cap),  (  L=[V];  Y=getMember_nd(all), Y<>"_boat", Y<>V, not(ups([V,Y])), L=[V,Y]  )],
 toMove:=removeDuplicates(toMove),
      Start=tuple(all,[]),
      FinishCond={(tuple([],all))},
     
 (   forAll(shirka::chain([Start],FinishCond,step),{(tuple(X,Z)):- write(c,". ",X,':',Z,"\n\n"), c:=c+1}), !;
     write("фигушки...")   ),
                        write("\n\n.........................................."), _=readChar().

class predicates
     step:(tuple{string*,string*}) -> tuple{string*,string*} nondeterm.
clauses
     step(tuple(["_boat"|A],B)) = tuple(C,["_boat"|D]):- !, move(A,C,B,D).
     step(tuple(A,[_|B])) = tuple(["_boat"|C],D):- move(B,D,A,C).
class predicates
     move:(string*,string*,string*,string*) nondeterm (i,o,i,o).
clauses
     move(A,B,C,D):- E=getMember_nd(toMove),   not(exists(E,{(Ej):- not(isMember(Ej,A))})),
                            B=fold(E,{(X,Y)=remove(Y,X)},A), not(ups(B)),
                            D=sort(append(C,E)), not(ups(D)).      
class predicates
     ups:(string*) nondeterm.
clauses
     ups(A):- difference(["women","boy"],A)=[], not(isMember("man",A)).
     ups(A):- difference(["man","girl"],A)=[], not(isMember("women",A)).
     ups(A):- A=[_,_|_], isMember("bandit",A), not(isMember("policeman",A)).
constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).
Цитата:
0. ["_boat","bandit","boy","boy","girl","girl","man"," policeman","women"]:[]
1. ["boy","boy","girl","girl","man","women"]:["_boat","bandit","policeman"]
2. ["_boat","boy","boy","girl","girl","man","policeman ","women"]:["bandit"]
3. ["boy","girl","girl","man","women"]:["_boat","bandit","boy","policeman"]
4. ["_boat","bandit","boy","girl","girl","man","police man","women"]:["boy"]
5. ["bandit","girl","girl","policeman","women"]:["_boat","boy","boy","man"]
6. ["_boat","bandit","girl","girl","man","policeman"," women"]:["boy","boy"]
7. ["bandit","girl","girl","policeman"]:["_boat","boy","boy","man","women"]
8. ["_boat","bandit","girl","girl","policeman","wo men"]:["boy","boy","man"]
9. ["girl","girl","women"]:["_boat","bandit","boy","boy","man","policeman"]
10. ["_boat","girl","girl","man","women"]:["bandit","boy","boy","policeman"]
11. ["girl","girl"]:["_boat","bandit","boy","boy","man","policeman","wo men"]
12. ["_boat","girl","girl","women"]:["bandit","boy","boy","man","policeman"]
13. ["girl"]:["_boat","bandit","boy","boy","girl","man","policem an","women"]
14. ["_boat","bandit","girl","policeman"]:["boy","boy","girl","man","women"]
15. ["bandit"]:["_boat","boy","boy","girl","girl","man","policeman ","women"]
16. ["_boat","bandit","policeman"]:["boy","boy","girl","girl","man","women"]
17. []:["_boat","bandit","boy","boy","girl","girl","man"," policeman","women"]

..........................................
Ответить с цитированием
  (#5 (permalink)) Старый
Винитарх Винитарх вне форума
Специалист
 
Аватар для Винитарх
 
Сообщений: 7,956
Сказал(а) спасибо: 2
Поблагодарили 303 раз(а) в 303 сообщениях
Регистрация: 01.03.2003
Адрес: Краснодар
По умолчанию 01.04.2012, 20:20

Превосходно!
Вопросы в Бурбаковском стиле {Да/Нет}.
А минимальный путь на графе между вершинами А и В? (в ориентированном графе и неориентированном)?
Или задачу Эйнштейна?
Просто интересны границы применимости.
Ответить с цитированием
Ads.
  (#6 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 01.04.2012, 21:33

Цитата:
Сообщение от Винитарх Посмотреть сообщение
Просто интересны границы применимости.
Я сам ещё не в курсе)))
Эйнштейна строить не буду из принципа)))
Просто графы запросто. Пофиг ориентация. Сегодня вряд ли, а завтра чего добавлю.
Ответить с цитированием
  (#7 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 02.04.2012, 10:57

Графы:
step(A)=B:- rebro(A,B); rebro(B,A). % rebro(B,A) для ориентированного лишнее.

Граф мне выдумывать лениво, посему шахматная доска и ход конём.
Минимум шагов из А в Б:
Visual Prolog Код:
implement main
open core, console, list
class facts
c:unsigned:= 0.
size:integer:= 8.
clauses
run():- init(),
Start=[1,1],
FinishCond={([8,8])},
 
( forAll(shirka::chain([Start],FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
write("фигушки...") ),
write("\n\n.........................................."), _=readChar().
 
class predicates
step:(integer*) -> integer* nondeterm.
clauses
step([A,B]) = [C,D]:- [X,Y]=getMember_nd([[-2,-1],[-2,1],[-1,-2],[-1,2],[1,-2],[1,2],[2,-1],[2,1]]),
C=A+X, C>0, C<=size,
D=B+Y, D>0, D<=size.
constants
className = "main".
classVersion = "".
clauses
classInfo(className, classVersion).
end implement main
goal
mainExe::run(main::run).
Цитата:
0. [1,1]
1. [2,3]
2. [1,5]
3. [2,7]
4. [4,6]
5. [6,7]
6. [8,8]

..........................................

Типа "лабиринт": конкретный старт, минимум шагов до одного из "выходов".
Visual Prolog Код:
...
FinishCond={(Finish):- isMember(Finish,[[7,5],[6,7],[5,5]])},
...
Цитата:
0. [1,1]
1. [2,3]
2. [1,5]
3. [3,4]
4. [5,5]

..........................................
Ответить с цитированием
  (#8 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 02.04.2012, 11:02

Из А в Б с проходом по заданным вершинам:

Visual Prolog Код:
implement main
open core, console, list
class facts
c:unsigned:= 0.
size:integer:= 8.
clauses
run():- init(),
Start=tuple([1,1],[[4,2],[1,7],[7,5],[6,6]]),
FinishCond={(tuple([8,8],[]))},
 
( forAll(shirka::chain([Start],FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
write("фигушки...") ),
write("\n.........................................."), _=readChar().
 
class predicates
step:(tuple{integer*,integer**}) -> tuple{integer*,integer**} nondeterm.
clauses
step(tuple([A,B],Q)) = tuple([C,D],remove(Q,[C,D])):- [X,Y]=getMember_nd([[-2,-1],[-2,1],[-1,-2],[-1,2],[1,-2],[1,2],[2,-1],[2,1]]),
C=A+X, C>0, C<=size,
D=B+Y, D>0, D<=size.
constants
className = "main".
classVersion = "".
clauses
classInfo(className, classVersion).
end implement main
goal
mainExe::run(main::run).
Цитата:
0. tuple([1,1],[[4,2],[1,7],[7,5],[6,6]])
1. tuple([2,3],[[4,2],[1,7],[7,5],[6,6]])
2. tuple([1,5],[[4,2],[1,7],[7,5],[6,6]])
3. tuple([3,6],[[4,2],[1,7],[7,5],[6,6]])
4. tuple([1,7],[[4,2],[7,5],[6,6]])
5. tuple([2,5],[[4,2],[7,5],[6,6]])
6. tuple([1,3],[[4,2],[7,5],[6,6]])
7. tuple([2,1],[[4,2],[7,5],[6,6]])
8. tuple([4,2],[[7,5],[6,6]])
9. tuple([5,4],[[7,5],[6,6]])
10. tuple([6,6],[[7,5]])
11. tuple([5,4],[[7,5]])
12. tuple([7,5],[])
13. tuple([6,7],[])
14. tuple([8,8],[])

..........................................
Мона зациклить:
Visual Prolog Код:
...
FinishCond={(tuple([1,1],[]))},
...
Цитата:
0. tuple([1,1],[[4,2],[1,7],[7,5],[6,6]])
1. tuple([2,3],[[4,2],[1,7],[7,5],[6,6]])
2. tuple([1,5],[[4,2],[1,7],[7,5],[6,6]])
3. tuple([3,6],[[4,2],[1,7],[7,5],[6,6]])
4. tuple([1,7],[[4,2],[7,5],[6,6]])
5. tuple([2,5],[[4,2],[7,5],[6,6]])
6. tuple([3,3],[[4,2],[7,5],[6,6]])
7. tuple([4,5],[[4,2],[7,5],[6,6]])
8. tuple([6,6],[[4,2],[7,5]])
9. tuple([5,4],[[4,2],[7,5]])
10. tuple([7,5],[[4,2]])
11. tuple([5,4],[[4,2]])
12. tuple([4,2],[])
13. tuple([2,3],[])
14. tuple([1,1],[])

..........................................
Можно сделать "гонца": из А обойти [....] без определённой конечной вершины.
Visual Prolog Код:
...
FinishCond={(tuple(_,[]))},
...
Цитата:
0. tuple([1,1],[[4,2],[1,7],[7,5],[6,6]])
1. tuple([2,3],[[4,2],[1,7],[7,5],[6,6]])
2. tuple([4,2],[[1,7],[7,5],[6,6]])
3. tuple([5,4],[[1,7],[7,5],[6,6]])
4. tuple([6,6],[[1,7],[7,5]])
5. tuple([5,4],[[1,7],[7,5]])
6. tuple([7,5],[[1,7]])
7. tuple([5,4],[[1,7]])
8. tuple([3,3],[[1,7]])
9. tuple([2,5],[[1,7]])
10. tuple([1,7],[])

..........................................
Мона просто чего-то там обойти за минимум шагов. Пофиг откуда, пофиг куда:
Visual Prolog Код:
...
ToPass=[[4,2],[1,7],[7,5],[6,6]],
FinishCond={(tuple(_,[]))},
 
( forAll(shirka::chain( map(ToPass,{(Q)=tuple(Q,remove(ToPass,Q))}), FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
...
Цитата:
0. tuple([4,2],[[1,7],[7,5],[6,6]])
1. tuple([5,4],[[1,7],[7,5],[6,6]])
2. tuple([6,6],[[1,7],[7,5]])
3. tuple([5,4],[[1,7],[7,5]])
4. tuple([7,5],[[1,7]])
5. tuple([5,4],[[1,7]])
6. tuple([3,3],[[1,7]])
7. tuple([2,5],[[1,7]])
8. tuple([1,7],[])

..........................................
Для подобной хрени, кстати, начальных состояний список.
Примеры по обходу вершин. Рёбра обходить не сложнее.
Примеры допускают повторный проход по одной и той же вершине. Запретить провтор просто, если добавить в состояние список пройденных вершин.

P.S. Состояния целиком печатаю - так как-то понятнее, наверное)))
Ответить с цитированием
  (#9 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 02.04.2012, 11:55

Дай, думаю, в два "гонца" попробую(двойной старт из [1,1], минимум шагов пройти по [[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]]).

Visual Prolog Код:
implement main
open core, console, list
class facts
c:unsigned:= 0.
size:integer:= 8.
clauses
run():- init(),
Start=tuple([[1,1],[1,1]],[[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]]),
FinishCond={(tuple(_,[]))},
 
( forAll(shirka::chain([Start],FinishCond,step),{(X):- write(c,". ",X,"\n\n"), c:=c+1}), !;
write("фигушки...") ),
write("\n.........................................."), _=readChar().
 
class predicates
step:(tuple{integer**,integer**}) -> tuple{integer**,integer**} nondeterm.
clauses
step(tuple(A,B)) = tuple(sort(C),D):- st(A,C,B,D).
 
class predicates
st:(integer**,integer**,integer**,integer**) nondeterm (i,o,i,o).
clauses
 
st([[A,B]|C],[[D,E]|F],G,H):- G<>[], !,
[X,Y]=getMember_nd([[-2,-1],[-2,1],[-1,-2],[-1,2],[1,-2],[1,2],[2,-1],[2,1]]),
D=A+X, D>0, D<=size, E=B+Y, E>0, E<=size,
st(C,F,remove(G,[D,E]),H).
st(A,A,B,B).
 
 
constants
className = "main".
classVersion = "".
clauses
classInfo(className, classVersion).
end implement main
goal
mainExe::run(main::run).
Цитата:
0. tuple([[1,1],[1,1]],[[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]])
1. tuple([[2,3],[2,3]],[[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]])
2. tuple([[1,5],[3,5]],[[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]])
3. tuple([[2,7],[4,7]],[[2,5],[4,6],[8,2],[1,8],[8,7],[6,8]])
4. tuple([[4,6],[6,8]],[[2,5],[8,2],[1,8],[8,7]])
5. tuple([[2,5],[8,7]],[[8,2],[1,8]])
6. tuple([[3,7],[6,6]],[[8,2],[1,8]])
7. tuple([[1,8],[7,4]],[[8,2]])
8. tuple([[2,6],[8,2]],[])

..........................................
Ответить с цитированием
  (#10 (permalink)) Старый
Винитарх Винитарх вне форума
Специалист
 
Аватар для Винитарх
 
Сообщений: 7,956
Сказал(а) спасибо: 2
Поблагодарили 303 раз(а) в 303 сообщениях
Регистрация: 01.03.2003
Адрес: Краснодар
По умолчанию 02.04.2012, 12:44

Занёс тему в рубрикатор.
Ответить с цитированием
  (#11 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 14.04.2012, 14:16

Примерчик на графья взвешенные:
Задача о коммивояжере
Минимальный цикл через все города, если кто не в курсе.
Visual Prolog Код:
implement main
    open core, console, list
clauses
    run():- init(),
        Cs = removeDuplicates([Cj|| (  put(Cj,_,_);  put(_,_,Cj) )]),
        (   [F|_]=Cs,
            Start=tuple(F,0,Cs),
            FinishCond={(tuple(F,0,[]))},
            Chain=shirka::chain([Start],FinishCond,step),
                    Way=map(filter(Chain,{(tuple(_,0,_))}),{(tuple(X,_,_))=X}),
                    write(Way,'\n',wayLength(Way)), !;
            write("фигушки...")   ),
                        write("\n.........................................."), _=readChar().
class predicates
     step:(tuple{string,integer,string*}) -> tuple{string,integer,string*} nondeterm.
clauses
     step(tuple(A,0,B)) = tuple(C,D-1,remove(B,C)) :- !, ( put(A,D,C); put(C,D,A) ), isMember(C,B).
     step(tuple(A,B,C)) = tuple(A,B-1,C).
     
class facts
    put:(string,integer,string).
clauses
    put("Курск",12,"Орёл").
    put("Курск",120,"Магадан").
    put("Курск",40,"Азов").
    put("Курск",90,"Колыма").
    put("Магадан",110,"Орёл").
    put("Магадан",52,"Колыма").
    put("Магадан",100,"Азов").  
    put("Орёл",32,"Азов").
    put("Орёл",105,"Колыма").
    put("Азов",112,"Колыма").
class predicates
     wayLength:(string*) -> integer.
clauses
     wayLength([A,B|C]) = D+wayLength([B|C]) :- ( put(A,D,B); put(B,D,A) ), !.
     wayLength(_) = 0.
constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).

Цитата:
["Курск","Орёл","Азов","Магадан","Колыма","Курс к"]
286
..........................................
Ответить с цитированием
  (#12 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 01.05.2012, 19:22

Минимум цветов раскрасить карту.
Граф

Visual Prolog Код:
implement main
    open core, console, list
clauses
    run():- init(),
            Vs=sort(removeDuplicates([ V ||  ( rbr(V,_) ; rbr(_,V) ) ])),
        (   Chain=shirka::chain([Vs],{([])},{([X|Y])=rmv(Y,[X],[])}),
                    showColors(1,Chain), !;
            write("фигушки...")   ),
                        write("\n.........................................."), _=readChar().
class predicates
    rmv : (integer*,integer*,integer**) -> integer* nondeterm.
clauses
    rmv([A|B],C,D) = [A|rmv(B,C,D)] :-  rbr(getMember_nd(C),A), !.
    rmv([A|B],C,D) = rmv(B,[A|C],filter(D,{(Dj):-not(isMember(A,Dj))})).
    rmv([A|B],C,D) = [A|rmv(B,C,[[X||rbr(A,X)]|D])] :- !.
    rmv(_,_,[]) = [].
class predicates
    showColors : (integer,integer**).
clauses
    showColors(A,[B,C|D]) :- !, Color=difference(B,C),
                                          if rbr(getMember_nd(Color),getMember_nd(Color)), ! then write("Ups...\n") end if,
                                          write(A,". ",Color), nl, nl, showColors(A+1,[C|D]).
    showColors(_,_).
class facts
    rbr : (integer,integer).
clauses
    rbr(1,2). rbr(1,5). rbr(1,20). rbr(2,3). rbr(2,18). rbr(3,4). rbr(3,16). rbr(4,5). rbr(4,14). rbr(5,6). rbr(6,7). rbr(6,13).
    rbr(7,8). rbr(7,20). rbr(8,9). rbr(8,12). rbr(9,10). rbr(9,19). rbr(10,11). rbr(10,17). rbr(11,12). rbr(11,15). rbr(12,13).
    rbr(13,14). rbr(14,15). rbr(15,16). rbr(16,17). rbr(17,18). rbr(18,19). rbr(19,20).
constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).

Цитата:
1. [1,3,6,8,10,14,18]
2. [2,4,7,11,13,16,19]
3. [5,9,12,15,17,20]
..........................................
Ответить с цитированием
Ads
  (#13 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 16.05.2012, 14:23

Даны 2 кувшина объёмом 7 и 5 литров изначально пустых.
Найти такую последовательность действий чтобы в результате кувшин объемом 7 литров содержал 4 литра воды (содержимое 2-го не важно). Возможны действия:
1. любой кувшин может быть наполнен из внешнего источника;
2. любой кувшин может быть опустошен;
3. вода может переливаться из кувшина А в Б с условием что в результате кувшин А будет пустым, либо кувшин Б - полным.


Visual Prolog Код:
implement main
    open core, console, list
clauses
    run():- init(),
        (   Chain=shirka::chain([tuple(0,0)], {(tuple(_,4))}, step),
                    write(Chain), !;
            write("фигушки...")   ),
                        write("\n.........................................."), _=readChar().
class predicates
    step : (tuple{integer,integer}) -> tuple{integer,integer} nondeterm.
clauses
    step(tuple(A,B)) = getMember_nd([tuple(0,B),tuple(A,0),tuple(cap1,B),tuple(A,cap2)]).
    step(tuple(A,B)) = tuple(C,D) :-  (  act(A,C,cap2,B,D)  ;  act(B,D,cap1,A,C)  ).
class predicates
    act : (integer,integer,integer,integer,integer) determ (i,o,i,i,o).
clauses
    act(A,B,C,D,E) :- A>0, D<C, if A<C-D then B=0, E=D+A else E=C, B=A-C+D end if.
class facts
    cap1 : integer := 5.
    cap2 : integer := 7.
constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
goal
    mainExe::run(main::run).

Цитата:
[tuple(0,0),tuple(0,7),tuple(5,2),tuple(0,2),tuple( 2,0),tuple(2,7),tuple(5,4)]
..........................................
Ответить с цитированием
  (#14 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 26.05.2012, 11:24

Цитата:
Есть поле из 10 ячеек и 9 фишек.
Надо из начального состояния перевести фишки в конечное состояние. Х - свободная ячейка. Передвигать можно на место свободной ячейки или через одну фишку на место свободной ячейки.
Начальное состояние:
1 2 3 4 5 6 7 8 9 10
H I A B C D E F G X
Конечное состояние:
1 2 3 4 5 6 7 8 9 10
G I B A C D E F H X
Visual Prolog Код:
implement main
    open core, console, list
clauses
    run():- init(),
           Start=['h','i','a','b','c','d','e','f','g',' '],
           Finish=['g','i','b','a','c','d','e','f','h',' '],
       
        (   Chain=shirka::chain([Start], {(Finish)}, step),
                    forAll(Chain, {(Cj) :- write(c,". ",Cj,"\n\n"), c:=c+1}), !;
            write("фигушки...")   ),
                        write("\n.........................................."), _=readChar().
class predicates
    step : (char*) -> char* nondeterm.
clauses
    step([A,B,' '|C]) = [' ',B,A|C].
    step([A,' '|B]) = [' ',A|B].
    step([' ',A,B|C]) = [B,A,' '|C].
    step([' ',A|B]) = [A,' '|B].
    step([A|B]) = [A|step(B)] :- A<>' '.
class facts
    c : unsigned := 0.

constants
    className = "main".
    classVersion = "".
clauses
    classInfo(className, classVersion).
end implement main
Цитата:
0. ['h','i','a','b','c','d','e','f','g','X']
1. ['h','i','a','b','c','d','e','X','g','f']
2. ['h','i','a','b','c','d','X','e','g','f']
3. ['h','i','a','b','c','d','g','e','X','f']
4. ['h','i','a','b','c','d','g','X','e','f']
5. ['h','i','a','b','c','X','g','d','e','f']
6. ['h','i','a','b','X','c','g','d','e','f']
7. ['h','i','a','b','g','c','X','d','e','f']
8. ['h','i','a','b','g','X','c','d','e','f']
9. ['h','i','a','X','g','b','c','d','e','f']
10. ['h','i','X','a','g','b','c','d','e','f']
11. ['X','i','h','a','g','b','c','d','e','f']
12. ['i','X','h','a','g','b','c','d','e','f']
13. ['i','a','h','X','g','b','c','d','e','f']
14. ['i','a','X','h','g','b','c','d','e','f']
15. ['i','a','g','h','X','b','c','d','e','f']
16. ['i','a','g','h','b','X','c','d','e','f']
17. ['i','a','g','X','b','h','c','d','e','f']
18. ['i','X','g','a','b','h','c','d','e','f']
19. ['X','i','g','a','b','h','c','d','e','f']
20. ['g','i','X','a','b','h','c','d','e','f']
21. ['g','i','b','a','X','h','c','d','e','f']
22. ['g','i','b','a','c','h','X','d','e','f']
23. ['g','i','b','a','c','X','h','d','e','f']
24. ['g','i','b','a','c','d','h','X','e','f']
25. ['g','i','b','a','c','d','X','h','e','f']
26. ['g','i','b','a','c','d','e','h','X','f']
27. ['g','i','b','a','c','d','e','X','h','f']
28. ['g','i','b','a','c','d','e','f','h','X']
..........................................
Ответить с цитированием
  (#15 (permalink)) Старый
aag aag вне форума
ушёл... не вернётся)))
 
Сообщений: 3,400
Сказал(а) спасибо: 0
Поблагодарили 82 раз(а) в 82 сообщениях
Регистрация: 29.11.2008
По умолчанию 26.05.2012, 11:35

В #14 в коде 'X', а не пробел, пардон...
Ответить с цитированием
Ответ

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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск в ширину (миссионеры и людоеды) на SWI-Prolog Alenkakiss Prolog 14 10.11.2013 11:51
Поиск в ширину lisper:( Lisp 3 24.12.2011 17:04
Поиск в ширину lollipop Prolog 3 21.10.2011 19:13
Обход дерева в ширину. Kenguru Prolog 2 13.06.2011 04:02
Граф - поиск в ширину Chummy Prolog 36 28.10.2010 18:10
Как определить ширину текста в пикселях imported_s_corp Java 8 08.08.2010 12:49
Обход дерева в ширину frikorsar Prolog 1 16.01.2009 14:39
Как поменять ширину строки usik Delphi 1 09.04.2008 08:29
Обход дерева в глубину и ширину L Вопросы начинающих программистов 0 12.12.2005 10:06
Как обозначить поиск в ширину acronim Prolog 1 10.11.2004 00:11
Как правильно произносить С++ Mak С/С++ 4 28.10.2003 16:30



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