/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Tightest known upper bounds for W in instances G-P-W. A trivial upper bound upper_/3 can be defined as: upper_(G, P, W) :- N #= G*P, Meet #= P - 1, W #= (N - 1) // Meet. However, for several instances, tighter upper bounds are known. In particular, we have the following differences: ?- upper(G,P,W), \+ upper_(G,P,W). G = 6, P = 5, W = 6 ; G = 6, P = 6, W = 3 ; G = 9, P = 4, W = 12 ; G = 10, P = 3, W = 15 ; false. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ upper(6,3,8). upper(6,4,7). upper(6,5,6). upper(6,6,3). upper(7,3,10). upper(7,4,9). upper(7,5,8). upper(7,6,8). upper(7,7,8). upper(8,3,11). upper(8,4,10). upper(8,5,9). upper(8,6,9). upper(8,7,9). upper(8,8,9). upper(9,3,13). upper(9,4,12). upper(9,5,11). upper(9,6,10). upper(9,7,10). upper(9,8,10). upper(9,9,10). upper(10,3,15). upper(10,4,13). upper(10,5,12). upper(10,6,11). upper(10,7,11). upper(10,8,11). upper(10,9,11). upper(10,10,11). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Best solutions found so far with constraint programming. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ csp(6,3,8). csp(6,4,7). csp(6,5,6). csp(6,6,3). csp(7,3,9). csp(7,4,7). csp(7,5,5). csp(7,6,4). csp(7,7,7). csp(8,3,10). csp(8,4,9). csp(8,5,6). csp(8,6,5). csp(8,7,4). csp(8,8,9). csp(9,3,11). csp(9,4,8). csp(9,5,6). csp(9,6,5). csp(9,7,4). csp(9,8,3). csp(9,9,3). csp(10,3,13). csp(10,4,9). csp(10,5,7). csp(10,6,6). csp(10,7,5). csp(10,8,4). csp(10,9,3). csp(10,10,3). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Best solutions found by local search. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ls(6,3,8). ls(6,4,6). ls(6,5,6). ls(6,6,3). ls(7,3,9). ls(7,4,7). ls(7,5,5). ls(7,6,4). ls(7,7,3). ls(8,3,10). ls(8,4,8). ls(8,5,6). ls(8,6,5). ls(8,7,4). ls(8,8,4). ls(9,3,11). ls(9,4,8). ls(9,5,6). ls(9,6,5). ls(9,7,4). ls(9,8,3). ls(9,9,3). ls(10,3,13). ls(10,4,9). ls(10,5,7). ls(10,6,6). ls(10,7,5). ls(10,8,4). ls(10,9,3). ls(10,10,3). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Best solutions found with memetic algorithm. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ma(6,3,8). ma(6,4,6). ma(6,5,6). ma(6,6,3). ma(7,3,9). ma(7,4,7). ma(7,5,5). ma(7,6,4). ma(7,7,4). ma(8,3,10). ma(8,4,8). ma(8,5,6). ma(8,6,5). ma(8,7,4). ma(8,8,4). ma(9,3,12). ma(9,4,9). ma(9,5,7). ma(9,6,6). ma(9,7,5). ma(9,8,4). ma(9,9,3). ma(10,3,13). ma(10,4,10). ma(10,5,8). ma(10,6,7). ma(10,7,5). ma(10,8,5). ma(10,9,4). ma(10,10,3). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Best solutions found with greedy randomized adaptive search. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ grasp(6,3,8). grasp(6,4,6). grasp(6,5,6). grasp(6,6,3). grasp(7,3,9). grasp(7,4,7). grasp(7,5,5). grasp(7,6,4). grasp(7,7,4). grasp(8,3,10). grasp(8,4,10). grasp(8,5,6). grasp(8,6,5). grasp(8,7,4). grasp(8,8,5). grasp(9,3,12). grasp(9,4,9). grasp(9,5,7). grasp(9,6,6). grasp(9,7,5). grasp(9,8,4). grasp(9,9,3). grasp(10,3,13). grasp(10,4,10). grasp(10,5,8). grasp(10,6,7). grasp(10,7,5). grasp(10,8,5). grasp(10,9,4). grasp(10,10,3). % hard_for_grasp(10,4,10). hard_for_grasp(10,6,7). hard_for_grasp(6,5,6). hard_for_grasp(9,3,12). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Describing barplots. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- use_module(library(lists)). :- use_module(library(format)). :- use_module(library(dcgs)). % G = number of groups per week barplot(G) --> { findall(P, csp(G,P,_), Ps), findall(W, all(G,_,W,_), Ws0), sort(Ws0, Ws), phrase((...,[MaxW]), Ws) }, row(Ps, G, grasp), row(Ps, G, ma), row(Ps, G, ls), row(Ps, G, csp), row(Ps, G, upper), "v <- rbind(grasp, ma, ls)\n", "colnames(v) <- c(", r_list(Ps), format_("postscript(\"g~w.ps\", width=5, height=5, page=\"special\")\n", [G]), format_("t <- barplot(v,yaxt=\"n\", ylab=\"number of weeks\", xlab=\"size of groups\", main=\"~w groups per week\", beside=T, ylim=c(0,~w), col=\"gray\", space=c(0.2,1))\n", [G,MaxW]), format_("axis(2, at=0:~w)\n", [MaxW]), "xs <- colMeans(t)\n", "for (i in 1:length(xs)) {\n\ l <- xs[i]-1.8\n\ r <- xs[i]+1.8\n\ lines(c(l,r), c(csp[i],csp[i]))\n\ lines(c(l,l), c(csp[i],csp[i]+0.2))\n\ lines(c(r,r), c(csp[i],csp[i]+0.2))\n\ lines(c(l,r), c(upper[i],upper[i]))\n\ lines(c(l,l), c(upper[i],upper[i]-0.2))\n\ lines(c(r,r), c(upper[i],upper[i]-0.2))\n}\n", "dev.off()\n". %?- phrase(barplot(6), Cs), format("~s", [Cs]). %?- grasp(7,X,Y). row(Ps, G, What) --> format_("~w <- c(", [What]), row_(Ps, G, What). r_list([]) --> ")\n". r_list([L|Ls]) --> format_("~w", [L]), ( { Ls == [] } -> ")\n" ; ", ", r_list(Ls) ). row_([], _, _) --> []. row_([P|Ps], G, What) --> { call(What, G, P, W) }, format_("~w", [W]), ( { Ps == [] } -> ")\n" ; ", ", row_(Ps, G, What) ). all(G, P, W, Which) :- member(Which, [grasp,ma,csp,ls,upper]), call(Which, G, P, W). %?- all(G, P, W, upper). %?- upper(N,N,X).