适合DVD上的电影,工作但风格/代码问题

时间:2012-04-03 16:57:48

标签: prolog knapsack-problem

我做了一个prolog程序,向我展示了在dvd上安装东西的最佳方法。问题在我参考的代码的注释中,我将在下面粘贴,但归结为:

  1. 是否有一种倒置切割算子可以让它搜索更多但是已经匹配了?请参阅fitexact,类似于fitexact(Size,Sum,L,L): - Sum

  2. 跟踪已处理的电影的最佳方法是什么?我收回他们,但不知道如何做到这一点。

  3. fitfuzzy使用if then构造。我不知道怎么想他们,在prolog中感觉很奇怪。试图让它递归让我非常困惑,但是:)

  4. 
        % given a list of movies and sizes, try to fit them all onto dvd's
        % wasting as little space as possible.
    
        % set the dvd size
        dvdsize(4812).
    
        % sum of all movies in the db
        movies_size(Size) :- findall(S, movie(_,S), LS), sum_list(LS,Size).
    
        % count of all movies in the db
        movies_count(Count) :- findall(S, movie(_,S), LS), length(LS,Count).
    
        % see which ones fit exactly
        % this is where i got into trouble, the original idea was to make
        % it like the fuzzy search below but i don't understand how i can 
        % express 'when there are no more movies which make an exact fit,
        % and the sum is smaller then the dvdsize the list is ok too'. 
        fitexact(Movies) :- dvdsize(Size), fitexact(Size, 0, [], Movies).
    
        % Stop when there's a perfect fit
        % so here i tried Size,Sum and Sum<Size in the body. That obviously
        % doesn't work since it instantly matches. 
        fitexact(Size, Size, Movies, Movies).
        % since otherwise the same movies show up on different dvd's i 
        % thought it would be best to delete them after they fitted. 
        % if I don't want to do that, what's the best way to make sure once
        % a movie is processed it won't show up again? Should it have an extra
        % flag like processed(movie(name,size,processed) or should i assert 
        % done dvd's and see if they're already in them? I wonder how long this
        % all would take since it's already quite slow as is.
        %% :-
        %%  forall(member(Movie,Movies), retract(movie(Movie,_))). %%, !.
    
        % Otherwise keep filling
        fitexact(Size, Sum, Acc, Movies) :-
          movie(Movie, MovieSize),
          \+ member(Movie, Acc), % no doubles!
          NewSum is Sum + MovieSize,
          NewSum =< Size,
          fitexact(Size, NewSum, [Movie|Acc], Movies). 
    
        removedvd(DVD) :- 
          forall(member(Movie,DVD),retract(movie(Movie,_))).
    
        % do a fuzzy fit, try exact fits with decreasing size when
        % there are no exact fits.
        fitfuzzy(DVD) :- dvdsize(Size), fitfuzzy(DVD,Size,0).
        fitfuzzy(_,Size,Size) :- movies_size(Size), !.
        fitfuzzy(_,Size,Size) :- dvdsize(Size), !.
        fitfuzzy(DVD,Size,Wasted) :-
          CheckSize is Size - Wasted,
        % this feels like a horrible way to do this. I very much like suggestions
        % about how to make it recursive or better in general.
          ( fitexact(CheckSize, 0, [], DVD)
          -> removedvd(DVD) 
          ;  NewWasted is Wasted + 1, 
             write('fitfuzzy: Increasing wasted space to '), write(NewWasted), nl,
             fitfuzzy(DVD,Size,NewWasted)
          ).
    
        status :-
          movies_count(MoviesLeft),
          movies_size(MoviesSize), 
          write('Movies left: '), write(MoviesLeft), nl,
          write('Size left  : '), write(MoviesSize), nl.
    
        burnloop :-
         movies_count(C), C>0,
         fitfuzzy(DVD),
         status,
         write('DVD = '), print(DVD),nl, nl,
         burnloop.
    
        % movies.db contains a list of movie(Name,Size). statements. It also
        % must have :- dynamic(movie/2). on top for retract to work.
        go :-
         ['movies.db'],
         burnloop.
    
    

4 个答案:

答案 0 :(得分:2)

只是一般性评论:我发现仍然是处理电影,而不是跟踪处理过的电影,我觉得更自然地首先获得(例如,通过findall / 3)电影列表需要处理,然后简单地关闭此列表。所以你有burn_dvd(List0, DVD, List),它将电影列表(可能与它们的大小结合,比如movie_size(Name, Size)形式的术语作为其第一个参数)构建一个DVD(通过选择尽可能多的电影)从List0适合单个DVD,例如在按大小等排序列表之后),第三个参数是剩余电影的列表。然后你有一个自然的扩展名burn_dvds(List,DVDs),它只是构建DVD,直到不再有电影为止:

burn_dvds([], []) :- !.
burn_dvds(Movies0, [DVD|DVDs]) :-
    burn_dvd(Movies0, DVD, Movies),
    burn_dvds(Movies, DVDs).

不需要断言/ 1或缩回/ 1。如果burn_dvd / 3非确定性地构建单个DVD,则可以使用多种解决方案,这是您可能想要的,也看起来很自然。

使用if-then-else是完全可以的,但是,模式匹配可以表达的所有内容都应该通过模式匹配来表示,因为它通常会产生更通用且更有效的代码。

format / 2也可以帮助你输出:而不是:

write('Movies left: '), write(MoviesLeft), nl

你可以写:

format("Movies left: ~w\n", [MoviesLeft])

通常,很少需要手动输出,因为您始终可以为您提供顶级打印解决方案。在我们的例子中,当您查询时,burn_dvds / 2自然会将DVD列表作为答案。

答案 1 :(得分:1)

  1. 如果您希望事情的行为就像在提供每个解决方案之后一直要求另一个解决方案,但将它们全部收集到一个列表中,findall就是您想要的。

  2. 如果在单个查询中发生这种情况,您可以传递已用过的电影列表。例如,刻录循环将把目前使用的电影列表作为参数; fitfuzzy将采取该列表&amp;添加添加了该DVD的电影的新版本,然后将该新列表传递给burnloop。或者,由于DVD​​中有新电影,请编写一个新的谓词,将DVD中的电影添加到旧列表中以制作新电影。

  3. 如果你让fitexact像现在一样继续下去,但是保留最接近DVD大小的电影列表,那么当没有完全填满DVD时,它会产生该列表,而不是失败

答案 2 :(得分:1)

Prolog的“最佳实践规则”说应该避免断言/收回,除非需要绝对(即没有声明方法)。

这是一个使用select / 3生成所有组合的程序

movie(a, 10).
movie(b, 3).
movie(c, 5).
movie(d, 6).
movie(e, 10).

dvdsize(20).

burn(Best) :-
    findall(N-S, movie(N,S), L),
    dvdsize(Max),
    setof(Wasted-Sequence, fitmax(L, Max, Wasted, Sequence), All),
    All = [Best|_],
    maplist(writeln, All).

fitmax(L, AvailableRoom, WastedSpace, [Title|Others]) :-
    select(Title - MovieSize, L, R),
    MovieSize =< AvailableRoom,
    RoomAfterMovie is AvailableRoom - MovieSize,
    fitmax(R, RoomAfterMovie, WastedSpace, Others).

fitmax(_, WastedSpace, WastedSpace, []).

输出:

?- burn(X).
0-[a,e]
0-[e,a]
1-[a,b,d]
1-[a,d,b]
1-[b,a,d]
1-[b,d,a]
1-[b,d,e]
1-[b,e,d]
1-[d,a,b]
1-[d,b,a]
1-[d,b,e]
1-[d,e,b]
1-[e,b,d]
1-[e,d,b]
2-[a,b,c]
2-[a,c,b]
2-[b,a,c]
2-[b,c,a]
2-[b,c,e]
2-[b,e,c]
2-[c,a,b]
2-[c,b,a]
2-[c,b,e]
2-[c,e,b]
2-[e,b,c]
2-[e,c,b]
4-[a,d]
4-[d,a]
4-[d,e]
4-[e,d]
5-[a,c]
5-[c,a]
5-[c,e]
5-[e,c]
6-[b,c,d]
6-[b,d,c]
6-[c,b,d]
6-[c,d,b]
6-[d,b,c]
6-[d,c,b]
7-[a,b]
7-[b,a]
7-[b,e]
7-[e,b]
9-[c,d]
9-[d,c]
10-[a]
10-[e]
11-[b,d]
11-[d,b]
12-[b,c]
12-[c,b]
14-[d]
15-[c]
17-[b]
20-[]
X = 0-[a, e].

答案 3 :(得分:1)

我之前的回答是“快速而肮脏”,随着电影数量的增长,很快就显示出了它的极限。这里有一个更好的方法来找到最佳拟合,并与之前的答案进行比较(根据测试要求重新制定)。

标记背包建议优化的关键,正确的Axel在发布问题时使用。我在CLP(FD)支持中搜索了解决问题的适当方法,这里是:

:- [library(clpfd)].

%%  use CLP(FD) to find best fit
%
burn_knapsack(Best, Wasted) :-
    dvdsize(Max),
    findall(Title - Size, movie(Title, Size), Movies),
    knaps(Movies, Max, Best, Wasted).

knaps(Movies, Max, Best, Wasted) :-
    findall([Flag, Title, Size],
        (Flag in 0..1, member(Title - Size, Movies)), AllMovies),
    transpose(AllMovies, [ToBurn, Titles, Sizes]),

    Actual #=< Max,
    scalar_product(Sizes, ToBurn, #=, Actual),
    labeling([max(Actual)], [Actual|ToBurn]),
    findall(Title, (nth1(I, ToBurn, 1),
            nth1(I, Titles, Title)), Best),
    Wasted is Max - Actual.

%%  compute all combinations of movies that fit on a dvd
%   it's a poor man clpfd:scalar_product/4
%
burn_naive(Best, Wasted) :-
    dvdsize(Max),
    findall(Title - Size, movie(Title, Size), Movies),
    naive(Movies, Max, Best, Wasted).

naive(Movies, Max, Best, Wasted) :-
    setof(Wasted-Sequence, fitmax(Movies, Max, Wasted, Sequence), [Wasted-Best|_]).

fitmax(L, AvailableRoom, WastedSpace, [Title|Others]) :-
    select(Title - MovieSize, L, R),
    MovieSize =< AvailableRoom,
    RoomAfterMovie is AvailableRoom - MovieSize,
    fitmax(R, RoomAfterMovie, WastedSpace, Others).
fitmax(_, WastedSpace, WastedSpace, []).

%%  run test with random generated list
%
%   From,To are num.of.movies
%   SzMin, SzMax min/max+1 of each movie size
%
test_performance(From, To, DvdSize, SzMin, SzMax) :-
    forall((between(From, To, NumMovies),
        gen_movies(NumMovies, SzMin, SzMax, Movies)
           ),
           (   (   NumMovies < 11
           ->  test(naive, Movies, DvdSize)
           ;   true
           ),
           test(knaps, Movies, DvdSize)
           )).
test(Method, Movies, DvdSize) :-
    time(once(call(Method, Movies, DvdSize, Best, Wasted))),
    writeln((Method, Best, Wasted)).

gen_movies(NumMovies, SzMin, SzMax, Movies) :-
    findall(Title-Size,
        (   between(1, NumMovies, Title),
            random(SzMin, SzMax, Size)
        ), Movies).

我将天真的测试限制在少于11部电影,以避免堆栈溢出

?- test_performance(8,20, 30, 3,7).
% 93,155 inferences, 0,140 CPU in 0,140 seconds (100% CPU, 665697 Lips)
naive,[1,2,3,5,6],0
% 235,027 inferences, 0,159 CPU in 0,159 seconds (100% CPU, 1481504 Lips)
knaps,[2,3,5,6,8],0
% 521,369 inferences, 0,782 CPU in 0,783 seconds (100% CPU, 666694 Lips)
naive,[1,2,3,4,5,6],0
% 163,858 inferences, 0,130 CPU in 0,131 seconds (100% CPU, 1255878 Lips)
knaps,[3,4,5,6,7,9],0
% 1,607,675 inferences, 2,338 CPU in 2,341 seconds (100% CPU, 687669 Lips)
naive,[1,2,3,4,7,8],0
% 184,056 inferences, 0,179 CPU in 0,180 seconds (100% CPU, 1027411 Lips)
knaps,[5,6,7,8,9,10],0
% 227,510 inferences, 0,156 CPU in 0,156 seconds (100% CPU, 1462548 Lips)
knaps,[5,6,8,9,10,11],0
% 224,621 inferences, 0,155 CPU in 0,155 seconds (100% CPU, 1451470 Lips)
knaps,[6,7,8,9,10,11,12],0
% 227,591 inferences, 0,159 CPU in 0,159 seconds (100% CPU, 1434836 Lips)
knaps,[5,7,9,10,11,12,13],0
% 389,764 inferences, 0,263 CPU in 0,263 seconds (100% CPU, 1482017 Lips)
knaps,[5,8,9,10,12,13,14],0
% 285,944 inferences, 0,197 CPU in 0,198 seconds (100% CPU, 1448888 Lips)
knaps,[8,9,10,12,13,14,15],0
% 312,936 inferences, 0,217 CPU in 0,217 seconds (100% CPU, 1443891 Lips)
knaps,[10,11,12,14,15,16],0
% 343,612 inferences, 0,238 CPU in 0,238 seconds (100% CPU, 1445670 Lips)
knaps,[12,13,14,15,16,17],0
% 403,782 inferences, 0,277 CPU in 0,278 seconds (100% CPU, 1456345 Lips)
knaps,[11,12,13,15,16,17],0
% 433,078 inferences, 0,298 CPU in 0,298 seconds (100% CPU, 1455607 Lips)
knaps,[14,15,16,17,18,19],0
% 473,792 inferences, 0,326 CPU in 0,327 seconds (100% CPU, 1451672 Lips)
knaps,[14,15,16,17,18,19,20],0
true.