I want to watch 6 episodes of "friends" in all possible permutations. How can I arrange the episodes in one string so that the substrings of length 6 cover all permutations? What are the shortest such strings?
What would be the Prolog code for that?
Here is a brute-force implementation with an attempt to build shorter solutions first.
superpermutation(Atom, Superpermutation) :-
bagof(Permutation, permute(Atom, Permutation), Permutations),
select(Permutation, Permutations, RemainingPermutations),
join(RemainingPermutations, Permutation, Superpermutation).
join([], Superpermutation, Superpermutation).
join(Permutations, Superpermutation, FinalSuperpermutation) :-
member(OnePermutation, Permutations),
atom_length(OnePermutation, Length), !,
%
between(1, Length, Position),
select(Permutation, Permutations, RemainingPermutations),
sub_atom(Permutation, Position, _, 0, Suffix),
sub_atom(Superpermutation, 0, _, _, Suffix),
sub_atom(Permutation, 0, Position, _, Prefix),
atom_concat(Prefix, Superpermutation, NewSuperpermutation),
join(RemainingPermutations, NewSuperpermutation, FinalSuperpermutation).
permute(Atom, PermutedAtom) :-
atom_chars(Atom, Chars),
permutation(Chars, PermutedChars),
atom_chars(PermutedAtom, PermutedChars).
Here are the first solutions found for n = 2 to 7.
n = 2
212
n = 3 (length = 9)
321323123
n = 4 (length = 33)
432143241324312434213423142341234
n = 5 (length = 153)
543215432514325413254312543521435241352431524351243542135423154235142354123545
321453241532451324531245342153425134253142534125345213452314523415234512345
n = 6 (length = 873, known shorter length = 872)
654321654326154326514326541326543126543621543625143625413625431625436125436521
436524136524316524361524365124365421365423165423615423651423654123654632154632
514632541632546132546312546352146352416352461352463152463512463542163542613542
631542635142635412635462135462315462351462354162354612354653214653241653246153
246513246531246534216534261534265134265314265341265346215346251346253146253416
253461253465213465231465234165234615234651234656432156432516432561432564132564
312564352164352614352641352643152643512643562143562413562431562435162435612435
642135642315642351642356142356412356453216453261453264153264513264531264536214
536241536245136245316245361245364215364251364253164253614253641253645213645231
645236145236415236451236456321456324156324516324561324563124563421563425163425
613425631425634125634521634526134526314526341526345126345621345623145623415623
451623456123456
n = 7 (length = 5913, known shorter length = 5908) (computation time ~ 10 secs)
765432176543271654327615432765143276541327654312765437216543726154372651437265
413726543172654371265437621543762514376254137625431762543716254376125437652143
765241376524317652437165243761524376512437654213765423176542371654237615423765
142376541237654732165473261547326514732654173265471326547312654736215473625147
362541736254713625473162547361254736521473652417365247136524731652473615247365
124736542173654271365427316542736154273651427365412736547213654723165472361547
236514723654172365471236547632154763251476325417632547163254761325476312547635
214763524176352471635247613524763152476351247635421763542716354276135427631542
763514276354127635472163547261354726315472635147263541726354712635476213547623
154762351476235417623547162354761235476532147653241765324716532476153247651324
765312476534217653427165342761534276513427653142765341276534721653472615347265
134726531472653417265347126534762153476251347625314762534176253471625347612534
765213476523147652341765234716523476152347651234765743216574326157432651743265
714326574132657431265743621574362517436257143625741362574316257436125743652174
365271436527413652743165274361527436512743657214365724136572431657243615724365
172436571243657421365742316574236157423651742365714236574123657463215746325174
632571463257416325746132574631257463521746352714635274163527461352746315274635
127463572146357241635724613572463157246351724635712463574216357426135742631574
263517426357142635741263574621357462315746235174623571462357416235746123574653
217465327146532741653274615327465132746531274653721465372416537246153724651372
465317246537124653742165374261537426513742653174265371426537412653746215374625
137462531746253714625374162537461253746521374652317465237146523741652374615237
465123746573214657324165732461573246517324657132465731246573421657342615734265
173426571342657314265734126573462157346251734625713462573146257341625734612573
465217346527134652731465273416527346152734651273465721346572314657234165723461
572346517234657123465764321576432517643257164325761432576413257643125764352176
435271643527614352764135276431527643512764357216435726143572641357264315726435
172643571264357621435762413576243157624351762435716243576124357642135764231576
423517642357164235761423576412357645321764532716453276145327641532764513276453
127645372164537261453726415372645137264531726453712645376214537624153762451376
245317624537162453761245376421537642513764253176425371642537614253764125376452
137645231764523716452376145237641523764512376457321645732614573264157326451732
645713264573126457362145736241573624517362457136245731624573612457364215736425
173642571364257316425736142573641257364521736452713645273164527361452736415273
645127364572136457231645723614572364157236451723645712364576321457632415763245
176324571632457613245763124576342157634251763425716342576134257631425763412576
345217634527163452761345276314527634152763451276345721634572613457263145726341
572634517263457126345762134576231457623415762345176234571623457612345767543216
754326175432671543267514326754132675431267543621754362715436275143627541362754
316275436127543672154367251436725413672543167254361725436712543675214367524136
752431675243617524367152436751243675421367542316754236175423671542367514236754
123675463217546327154632751463275416327546132754631275463721546372514637254163
725461372546317254637125463752146375241637524613752463175246371524637512463754
216375426137542631754263715426375142637541263754621375462317546237154623751462
375416237546123754673215467325146732541673254617325467132546731254673521467352
416735246173524671352467315246735124673542167354261735426713542673154267351426
735412673546217354627135462731546273514627354162735461273546721354672315467235
146723541672354617235467123546753214675324167532461753246715324675132467531246
753421675342617534267153426751342675314267534126753462175346271534627513462753
146275341627534612753467215346725134672531467253416725346172534671253467521346
752314675234167523461752346715234675123467564321756432715643275164327561432756
413275643127564372156437251643725614372564137256431725643712564375216437526143
752641375264317526437152643751264375621437562413756243175624371562437516243756
124375642137564231756423715642375164237561423756412375647321564732516473256147
325641732564713256473125647352164735261473526417352647135264731526473512647356
214735624173562471356247315624735162473561247356421735642713564273156427351642
735614273564127356472135647231564723516472356147235641723564712356475321647532
614753264175326471532647513264753126475362147536241753624715362475136247531624
753612475364217536427153642751364275316427536142753641275364721536472513647253
164725361472536417253647125364752136475231647523614752364175236471523647512364
756321475632417563247156324751632475613247563124756342175634271563427516342756
134275631427563412756347215634725163472561347256314725634172563471256347521634
752613475263147526341752634715263475126347562134756231475623417562347156234751
623475612347567432156743251674325617432567143256741325674312567435216743526174
352671435267413526743152674351267435621743562714356274135627431562743516274356
127435672143567241356724315672435167243561724356712435674213567423156742351674
235617423567142356741235674532167453261745326714532674153267451326745312674536
217453627145362741536274513627453162745361274536721453672415367245136724531672
453617245367124536742153674251367425316742536174253671425367412536745213674523
167452361745236714523674152367451236745632174563271456327415632745163274561327
456312745637214563724156372451637245613724563172456371245637421563742516374256
137425631742563714256374125637452163745261374526317452637145263741526374512637
456213745623174562371456237415623745162374561237456732145673241567324516732456
173245671324567312456734215673425167342561734256713425673142567341256734521673
452617345267134526731452673415267345126734562173456271345627314562734156273451
627345612734567213456723145672341567234516723456172345671234567
n = 8 -> Stack overflow!
The stack overflow for n = 8 is mostly caused by the bagof predicate. Anyone can remove this error?
This is my attempt, which appears to have a bug, but I don't see where it is exactly. If you see it, please let me know where it is.
First, let's follow the algorithm sketched by Wikipedia for N<5:
super([X], [X], 1).
super([X|Xs], Super, N) :-
%% obtain the superpermutation of N-1
super(Xs, Super0, N0),
succ(N0, N),
%% split Super0 into its individual permutations
split_permutations(N0, Super0, Permutations),
%% insert X into the middle of a copy of each of these
maplist(insert_surrounded(X), Permutations, NewPermutations),
%% concatenate the new permutations and deduplicate them
append(NewPermutations, SuperWithDupes),
deduplicate(SuperWithDupes, Super).
Now to make this go, we will need quite a few utility predicates, starting with deduplication and testing whether a sublist is a permutation:
deduplicate([X], [X]).
deduplicate([X,Y|Xs], Dedup) :-
(X == Y ->
deduplicate([Y|Xs], Dedup)
;
deduplicate([Y|Xs], Dedup1),
Dedup = [X|Dedup1]
).
is_unique([]).
is_unique([X|Xs]) :-
\+ memberchk(X, Xs),
is_unique(Xs).
Now to obtain the permutations from the N-1 call, I have split_permutations/3 which gives you back the permutations (in order) of an earlier call to super/2:
split_permutations(_, [], []).
split_permutations(Length, [X|Xs], Permutations) :-
split_permutations(Length, Xs, Permutations1),
length(L, Length),
(prefix(L, [X|Xs]), is_unique(L) ->
Permutations = [L|Permutations1]
;
Permutations = Permutations1
).
insert_surrounded/3 uses SWI-Prolog trick append/2:
insert_surrounded(X, Permutation, NewPermutation) :-
append([Permutation, [X], Permutation], NewPermutation).
For my own edification, I wrote a thing to output a list slammed together so that I could compare my output to Wikipedia's:
write_string([]) :- nl.
write_string([X|Xs]) :- write(X), write_string(Xs).
For N=3, I get the same thing as Wikipedia:
?- super([3,2,1], X, Y), write_string(X).
123121321
X = [1, 2, 3, 1, 2, 1, 3, 2, 1],
Y = 3 .
I note with some dissatisfaction that using the first item in the list rather than the last is forcing me to present the input reversed. I would believe it if this was my problem with the next output, which is N=4:
12341232314231312431213421313241323214321 (mine)
123412314231243121342132413214321 (Wikipedia)
I am thinking now that it would have been better to generate some sort of superpermutation tree, and then have an output or serialization routine that handles the deduplication, and then constructing the tree leaves it in a broken-up state throughout the program until the last step. It seems inefficient and/or a good way to introduce bugs to do the concatenating and then immediately break the concatenated strings back apart. I don't think that is essential to the algorithm though. Perhaps another intrepid Prolog programmer will see a trick here!
Related
I'm new to Prolog and I'm trying to write fully working magic square program, but to say the truth I don't really know how to do, I have started but I feel that I'm doing it wrong. I'm sharing my code and I hope someone will help me, now when numbers are good I get true, but when they are not I get like out of stack error... (here is only checking rows and columns I know about obliquely check)
thanks for your attention!
:- use_module(library(clpfd)).
:- use_module(library(lists)).
magicSq(List, N) :-
Number is N * N,
belongs(Number ,List), % check if numbers are correct.
all_different(List), % check if numbers not occur.
Suma is N*(N*N + 1)/2,
checkC(List,N,N,Suma), % check column
checkR(List,1,N,Suma). % check row
belongs(0, _).
belongs(N, List) :- member(N,List) , Index is N - 1 , belongs(Index, List).
consecutiveSum(_, 0 , _,0).
consecutiveSum(List, HowMuch , From,Sum):-
Index is HowMuch - 1,
From1 is From +1,
nth1(From, List,Element),
consecutiveSum(List,Index,From1,Z),
Sum is Z + Element,!.
sumObliCol(0,_, [], _,_). % sums by columns or obliquely
sumObliCol(X,Number, [H|T], Ind, Residue) :-
Index is Ind + 1,
Y is mod(Index,Number),
Y =:= Residue,
sumObliCol(Z,Number, T, Index,Residue),
X is Z + H, !.
sumObliCol(X,Number, [_|T], Ind,Residue) :-
Index is Ind + 1,
sumObliCol(X,Number, T, Index,Residue).
checkC(_,0,_,_). % check column
checkC(List,N, Number,Answ):-
N1 is N-1,
checkC(List,N1, Number,Answ),
sumObliCol(Ats,Number,List,0,N1),Ats is Answ,!.
checkR(_,N,Number,_):- N>(Number*Number). % check row
checkR(List,N,Number,Answ):-
consecutiveSum(List,Number,N,Sum), Sum is Answ,
N1 is N + Number,
checkR(List,N1, Number,Answ),!.
In programming one often assumes that
everything is deeply intertwingled ... since the cross-connections among the myriad topics of this world/program simply cannot be divided up neatly.1
But in Prolog, sometimes, we can divide things up much more neatly. In particular, if you concentrate on a single property like non-termination. So let's consider magic squares of size one — very magic indeed! Like so using a failure-slice:
?- magicSq(Xs,1), false.
magicSq(List, N) :-
Number is N * N,
belongs(Number ,List), false,
all_different(List),
Suma is N*(N*N + 1)/2,
checkC(List,N,N,Suma),
checkR(List,1,N,Suma).
belongs(0, _) :- false.
belongs(N1, List) :-
member(N1,List), false,
N2 is N1 - 1,
belongs(N2, List).
That's all you need to understand! Evidently, the List is unconstrained and thus the goal member(N1, List) cannot terminate. That's easy to fix, adding a goal length(List, Number). And still, the program does not terminate but in a different area:
?- magicSq(Xs,1), false.
magicSq(List, N) :-
Number is N * N,
length(List, Number),
belongs(Number ,List), false,
all_different(List),
Suma is N*(N*N + 1)/2,
checkC(List,N,N,Suma),
checkR(List,1,N,Suma).
belongs(0, _) :- false.
belongs(N1, List) :-
member(N1,List),
N2 is N1 - 1,
belongs(N2, List), false.
Now this does not terminate, for N1 may be negative, too. We need to improve that adding N1 > 0.
Now, considering the program with a false in front of all_different/1, I get:
?- time(magicSq(List, 3)).
% 8,571,007 inferences
That looks like an awful lot of inferences! In fact, what you are doing is to enumerate all possible configurations first. Thus, you do not use the powers of constraint programming. Please go through tutorials on this. Start here.
However, the problems do not stop here! There is much more to it, but the remaining program is very difficult to understand, for you are using the ! in completely unrelated places.
Kindly, could you help me in the following:
I am writing a Prolog program that takes two numbers digits then combine them as one number, for example:
Num1: 5
Num2: 1
Then the new number is 51.
Assume V1 is the first number digit and V2 is the second number digit. I want to combine V1 and V2 then multiply the new number with V3, so my question is how I can do it?
calculateR(R, E, V1, V2, V3, V4):-
R is V1 V2 * V3,
E is R * V4.
Your help is appreciated.
Here is another solution that is based on the idea of #aBathologist and that relies on ISO predicates only, and does not dependent on SWI's idiosyncratic modifications and extensions. Nor does it have most probably unwanted solutions like calculateR('0x1',1,1,17). nor calculateR(1.0e+30,0,1,1.0e+300). Nor does it create unnecessary temporary atoms.
So the idea is to restrict the definition to decimal numbers:
digit_digit_number(D1, D2, N) :-
number_chars(D1, [Ch1]),
number_chars(D2, [Ch2]),
number_chars(N, [Ch1,Ch2]).
Here is a version which better clarifies the relational nature of Prolog - using library(clpfd) which is available in many Prolog systems (SICStus, SWI, B, GNU, YAP). It is essentially the same program as the one with (is)/2 except that I added further redundant constraints that permit the system to ensure termination in more general cases, too:
:- use_module(library(clpfd)).
digits_radix_number(Ds, R, N) :-
digits_radix_numberd(Ds, R, 0,N).
digits_radix_numberd([], _, N,N).
digits_radix_numberd([D|Ds], R, N0,N) :-
D #>= 0, D #< R,
R #> 0,
N0 #=< N,
N1 #= D+N0*R,
digits_radix_numberd(Ds, R, N1,N).
Here are some uses:
?- digits_radix_number([1,4,2],10,N).
N = 142.
?- digits_radix_number([1,4,2],R,142).
R = 10.
?- digits_radix_number([1,4,2],R,N).
R in 5..sup, 4+R#=_A, _A*R#=_B, _A in 9..sup, N#>=_A,
N in 47..sup, 2+_B#=N, _B in 45..sup.
That last query asks for all possible radices that represent [1,4,2] as a number. As you can see, not anything can be represented that way. The radix has to be 5 or larger which is not surprising given the digit 4, and the number itself has to be at least 47.
Let's say we want to get a value between 1450..1500, what radix do we need to do that?
?- digits_radix_number([1,4,2],R,N), N in 1450..1500.
R in 33..40, 4+R#=_A, _A*R#=_B, _A in 37..44,
N in 1450..1500, 2+_B#=N, _B in 1448..1498.
Gnah, again gibberish. This answer contains many extra equations that have to hold. Prolog essentially says: Oh yes, there is a solution, provided all this fine print is true. Do the math yourself!
But let's face it: It is better if Prolog gives such hard-to-swallow answer than if it would say Yes.
Fortunately there are ways to remove such extra conditions. One of the simplest is called "labeling", where Prolog will "try out" value after value:
?- digits_radix_number([1,4,2],R,N), N in 1450..1500, labeling([],[N]).
false.
That is clear response now! There is no solution. All these extra conditions where essentially false, like all that fine print in your insurance policy...
Here's another question: Given the radix and the value, what are the required digits?
?- digits_radix_number(D,10,142).
D = [1,4,2]
; D = [0,1,4,2]
; D = [0,0,1,4,2]
; D = [0,0,0,1,4,2]
; D = [0,0,0,0,1,4,2]
; ... .
So that query can never terminate, because 00142 is the same number as 142. Just as 007 is agent number 7.
Here is a straight-forward solution that should work in any Prolog close to ISO:
digits_radix_to_number(Ds, R, N) :-
digits_radix_to_number(Ds, R, 0,N).
digits_radix_to_number([], _, N,N).
digits_radix_to_number([D|Ds], R, N0,N) :-
N1 is D+N0*R,
digits_radix_to_number(Ds, R, N1,N).
?- digits_radix_to_number([1,4,2],10,R).
R = 142.
Edit: In a comment, #false pointed out that this answer is SWI-Prolog specific.
You can achieve your desired goal by treating the numerals as atoms and concatenating them, and then converting the resultant atom into a number.
I'll use atom_concat/3 to combine the two numerals. In this predicate, the third argument with be the combination of atoms in its first and second arguments. E.g.,
?- atom_concat(blingo, dingo, X).
X = blingodingo.
Note that, when you do this with two numerals, the result is an atom not a number. This is indicated by the single quotes enclosing the the result:
?- atom_concat(5, 1, X).
X = '51'.
But 51 \= '51' and we cannot multiply an atom by number. We can use atom_number/2 to convert this atom into a number:
?- atom_number('51', X).
X = 51.
That's all there is to it! Your predicate might look like this:
calculateR(No1, No2, Multiplier, Result) :-
atom_concat(No1, No2, NewNoAtom),
atom_number(NewNoAtom, NewNo),
Result is NewNo * Multiplier.
Usage example:
?- calculateR(5, 1, 3, X).
X = 153.
Of course, you'll need more if you want to prompt the user for input.
I expect #Wouter Beek's answer is more efficient, since it doesn't rely on converting the numbers to and from atoms, but just uses the assumption that each numeral is a single digit to determine the resulting number based on their position. E.g., if 5 is in the 10s place and 1 is in the 1s place, then the combination of 5 and 1 will be 5 * 10 + 1 * 1. The answer I suggest here will work with multiple digit numerals, e.g., in calculateR(12, 345, 3, Result), Result is 1234 * 3. Depending on what you're after this may or may not be a desired result.
If you know the radix of the numbers involved (and the radix is the same for all the numbers involved), then you can use the reverse index of the individual numbers in order to calculate their positional summation.
:- use_module(library(aggregate)).
:- use_module(library(lists)).
digits_to_number(Numbers1, Radix, PositionalSummation):-
reverse(Numbers1, Numbers2),
aggregate_all(
sum(PartOfNumber),
(
nth0(Position, Numbers2, Number),
PartOfNumber is Number * Radix ^ Position
),
PositionalSummation
).
Examples of use:
?- digits_to_number([5,1], 10, N).
N = 51.
?- digits_to_number([5,1], 16, N).
N = 81.
(The code sample is mainly intended to bring the idea across. Notice that I use aggregate_all/3 from SWI-Prolog here. The same could be achieved by using ISO predicates exclusively.)
Working on a predicate, rotate(L,M,N), where L is a new list formed by rotating M to the right N times.
My approach was to just append the tail of M to its head N times.
rotate(L, M, N) :-
( N > 0,
rotate2(L, M, N)
; L = M
).
rotate2(L, [H|T], Ct) :-
append(T, [H], L),
Ct2 is Ct - 1,
rotate2(L, T, Ct2).
Currently, my code returns L equal to the original M, no matter what N is set to.
Seems like when I'm recursing, the tail isn't properly moved to the head.
You can use append to split lists, and length to create lists:
% rotate(+List, +N, -RotatedList)
% True when RotatedList is List rotated N positions to the right
rotate(List, N, RotatedList) :-
length(Back, N), % create a list of variables of length N
append(Front, Back, List), % split L
append(Back, Front, RotatedList).
Note: this only works for N <= length(L). You can use arithmetic to fix that.
Edit for clarity
This predicate is defined for List and N arguments that are not variables when the predicate is called. I inadvertently reordered the arguments from your original question, because in Prolog, the convention is that strictly input arguments should come before output arguments. So, List and N and input arguments, RotatedList is an output argument. So these are correct queries:
?- rotate([a,b,c], 2, R).
?- rotate([a,b,c], 1, [c,a,b]).
but this:
?- rotate(L, 2, [a,b,c]).
will go into infinite recursion after finding one answer.
When reading the SWI-Prolog documentation, look out for predicate arguments marked with a "?", as in length. They can be used as shown in this example.
We want to build a predicate that gets a list L and a number N and is true if N is the length of the longest sequence of list L.
For example:
?- ls([1,2,2,4,4,4,2,3,2],3).
true.
?- ls([1,2,3,2,3,2,1,7,8],3).
false.
For this I built -
head([X|S],X). % head of the list
ls([H|T],N) :- head(T,X),H=X, NN is N-1 , ls(T,NN) . % if the head equal to his following
ls(_,0) :- !. % get seq in length N
ls([H|T],N) :- head(T,X) , not(H=X) ,ls(T,N). % if the head doesn't equal to his following
The concept is simply - check if the head equal to his following , if so , continue with the tail and decrement the N .
I checked my code and it works well (ignore cases which N = 1) -
ls([1,2,2,4,4,4,2,3,2],3).
true ;
false .
But the true answer isn't finite and there is more answer after that , how could I make it to return finite answer ?
Prolog-wise, you have a few problems. One is that your predicate only works when both arguments are instantiated, which is disappointing to Prolog. Another is your style—head/2 doesn't really add anything over [H|T]. I also think this algorithm is fundamentally flawed. I don't think you can be sure that no sequence of longer length exists in the tail of the list without retaining an unchanged copy of the guessed length. In other words, the second thing #Zakum points out, I don't think there will be a simple solution for it.
This is how I would have approached the problem. First a helper predicate for getting the maximum of two values:
max(X, Y, X) :- X >= Y.
max(X, Y, Y) :- Y > X.
Now most of the work sequence_length/2 does is delegated to a loop, except for the base case of the empty list:
sequence_length([], 0).
sequence_length([X|Xs], Length) :-
once(sequence_length_loop(X, Xs, 1, Length)).
The call to once/1 ensures we only get one answer. This will prevent the predicate from usefully generating lists with sequences while also making the predicate deterministic, which is something you desired. (It has the same effect as a nicely placed cut).
Loop's base case: copy the accumulator to the output parameter:
sequence_length_loop(_, [], Length, Length).
Inductive case #1: we have another copy of the same value. Increment the accumulator and recur.
sequence_length_loop(X, [X|Xs], Acc, Length) :-
succ(Acc, Acc1),
sequence_length_loop(X, Xs, Acc1, Length).
Inductive case #2: we have a different value. Calculate the sequence length of the remainder of the list; if it is larger than our accumulator, use that; otherwise, use the accumulator.
sequence_length_loop(X, [Y|Xs], Acc, Length) :-
X \= Y,
sequence_length([Y|Xs], LengthRemaining),
max(Acc, LengthRemaining, Length).
This is how I would approach this problem. I don't know if it will be useful for you or not, but I hope you can glean something from it.
How about adding a break to the last rule?
head([X|S],X). % head of the list
ls([H|T],N) :- head(T,X),H=X, NN is N-1 , ls(T,NN) . % if the head equal to his following
ls(_,0) :- !. % get seq in length N
ls([H|T],N) :- head(T,X) , not(H=X) ,ls(T,N),!. % if the head doesn't equal to his following
Works for me, though I'm no Prolog expert.
//EDIT: btw. try
14 ?- ls([1,2,2,4,4,4,2,3,2],2).
true ;
false.
Looks false to me, there is no check whether N is the longest sequence. Or did I get the requirements wrong?
Your code is checking if there is in list at least a sequence of elements of specified length. You need more arguments to keep the state of the search while visiting the list:
ls([E|Es], L) :- ls(E, 1, Es, L).
ls(X, N, [Y|Ys], L) :-
( X = Y
-> M is N+1,
ls(X, M, Ys, L)
; ls(Y, 1, Ys, M),
( M > N -> L = M ; L = N )
).
ls(_, N, [], N).
So here it is : I'm trying to calculate the sum of all primes below two millions (for this problem), but my program is very slow. I do know that the algorithm in itself is terribly bad and a brute force one, but it seems way slower than it should to me.
Here I limit the search to 20,000 so that the result isn't waited too long.
I don't think that this predicate is difficult to understand but I'll explain it anyway : I calculate the list of all the primes below 20,000 and then sum them. The sum part is fine, the primes part is really slow.
problem_010(R) :-
p010(3, [], Primes),
sumlist([2|Primes], R).
p010(20001, Primes, Primes) :- !.
p010(Current, Primes, Result) :-
(
prime(Current, Primes)
-> append([Primes, [Current]], NewPrimes)
; NewPrimes = Primes
),
NewCurrent is Current + 2,
p010(NewCurrent, NewPrimes, Result).
prime(_, []) :- !.
prime(N, [Prime|_Primes]) :- 0 is N mod Prime, !, fail.
prime(ToTest, [_|Primes]) :- prime(ToTest, Primes).
I'd like some insight about why it is so slow. Is it a good implementation of the stupid brute force algorithm, or is there some reason that makes Prolog fall?
EDIT : I already found something, by appending new primes instead of letting them in the head of the list, I have primes that occur more often at start so it's ~3 times faster. Still need some insight though :)
First, Prolog does not fail here.
There are very smart ways how to generate prime numbers. But as a cheap start simply accumulate the primes in reversed order! (7.9s -> 2.6s) In this manner the smaller ones are tested sooner. Then, consider to test only against primes up to 141. Larger primes cannot be a factor.
Then, instead of stepping only through numbers not divisible by 2, you might add 3, 5, 7.
There are people writing papers on this "problem". See, for example this paper, although it's a bit of a sophistic discussion what the "genuine" algorithm actually was, 22 centuries ago when the latest release of the abacus was celebrated as Salamis tablets.
Consider using for example a sieve method ("Sieve of Eratosthenes"): First create a list [2,3,4,5,6,....N], using for example numlist/3. The first number in the list is a prime, keep it. Eliminate its multiples from the rest of the list. The next number in the remaining list is again a prime. Again eliminate its multiples. And so on. The list will shrink quite rapidly, and you end up with only primes remaining.
First of all, appending at the end of a list using append/3 is quite slow. If you must, then use difference lists instead. (Personally, I try to avoid append/3 as much as possible)
Secondly, your prime/2 always iterates over the whole list when checking a prime. This is unnecessarily slow. You can instead just check id you can find an integral factor up to the square root of the number you want to check.
problem_010(R) :-
p010(3, 2, R).
p010(2000001, Primes, Primes) :- !.
p010(Current, In, Result) :-
( prime(Current) -> Out is In+Current ; Out=In ),
NewCurrent is Current + 2,
p010(NewCurrent, Out, Result).
prime(2).
prime(3).
prime(X) :-
integer(X),
X > 3,
X mod 2 =\= 0,
\+is_composite(X, 3). % was: has_factor(X, 3)
is_composite(X, F) :- % was: has_factor(X, F)
X mod F =:= 0, !.
is_composite(X, F) :-
F * F < X,
F2 is F + 2,
is_composite(X, F2).
Disclaimer: I found this implementation of prime/1 and has_factor/2 by googling.
This code gives:
?- problem_010(R).
R = 142913828922
Yes (12.87s cpu)
Here is even faster code:
problem_010(R) :-
Max = 2000001,
functor(Bools, [], Max),
Sqrt is integer(floor(sqrt(Max))),
remove_multiples(2, Sqrt, Max, Bools),
compute_sum(2, Max, 0, R, Bools).
% up to square root of Max, remove multiples by setting bool to 0
remove_multiples(I, Sqrt, _, _) :- I > Sqrt, !.
remove_multiples(I, Sqrt, Max, Bools) :-
arg(I, Bools, B),
(
B == 0
->
true % already removed: do nothing
;
J is 2*I, % start at next multiple of I
remove(J, I, Max, Bools)
),
I1 is I+1,
remove_multiples(I1, Sqrt, Max, Bools).
remove(I, _, Max, _) :- I > Max, !.
remove(I, Add, Max, Bools) :-
arg(I, Bools, 0), % remove multiple by setting bool to 0
J is I+Add,
remove(J, Add, Max, Bools).
% sum up places that are not zero
compute_sum(Max, Max, R, R, _) :- !.
compute_sum(I, Max, RI, R, Bools) :-
arg(I, Bools, B),
(B == 0 -> RO = RI ; RO is RI + I ),
I1 is I+1,
compute_sum(I1, Max, RO, R, Bools).
This runs an order of magnitude faster than the code I gave above:
?- problem_010(R).
R = 142913828922
Yes (0.82s cpu)
OK, before the edit the problem was just the algorithm (imho).
As you noticed, it's more efficient to check if the number is divided by the smaller primes first; in a finite set, there are more numbers divisible by 3 than by 32147.
Another algorithm improvement is to stop checking when the primes are greater than the square root of the number.
Now, after your change there are indeed some prolog issues:
you use append/3. append/3 is quite slow since you have to traverse the whole list to place the element at the end.
Instead, you should use difference lists, which makes placing the element at the tail really fast.
Now, what is a difference list? Instead of creating a normal list [1,2,3] you create this one [1,2,3|T]. Notice that we leave the tail uninstantiated. Then, if we want to add one element (or more) at the end of the list we can simply say T=[4|NT]. awesome?
The following solution (accumulate primes in reverse order, stop when prime>sqrt(N), difference lists to append) takes 0.063 for 20k primes and 17sec for 2m primes while your original code took 3.7sec for 20k and the append/3 version 1.3sec.
problem_010(R) :-
p010(3, Primes, Primes),
sumlist([2|Primes], R).
p010(2000001, _Primes,[]) :- !. %checking for primes till 2mil
p010(Current, Primes,PrimesTail) :-
R is sqrt(Current),
(
prime(R,Current, Primes)
-> PrimesTail = [Current|NewPrimesTail]
; NewPrimesTail = PrimesTail
),
NewCurrent is Current + 2,
p010(NewCurrent, Primes,NewPrimesTail).
prime(_,_, Tail) :- var(Tail),!.
prime(R,_N, [Prime|_Primes]):-
Prime>R.
prime(_R,N, [Prime|_Primes]) :-0 is N mod Prime, !, fail.
prime(R,ToTest, [_|Primes]) :- prime(R,ToTest, Primes).
also, considering adding the numbers while you generate them to avoid the extra o(n) because of sumlist/2
in the end, you can always implement the AKS algorithm that runs in polynomial time (XD)