Repeating a list
Let's say I need a rep ("List", "Times", "TList") predicate that is true if the list is repeated. Temporary times in TList (for example rep([a,c],2,[a,c,a,c])
). It should work as long as two arguments are being created. Here's a somewhat working version:
rep(_,0,[]).
rep(List,1,List).
rep(List,Times,TList) :- integer(Times), Times>1,
succ(RemTimes,Times), append(List,RemList,TList),
rep(List,RemTimes,RemList).
rep(List,Times,TList) :- var(Times),
append(List,RemList,TList),
rep(List,RemTimes,RemList), !,
succ(RemTimes,Times).
Two questions:
- Isn't there some built-in one (which I can't find)?
- Is there a more direct way to do this? How to get rid of the last sentence? This is necessary because I couldn't find a way to express the relationship between Times and RemTimes when Times is not being created.
I am not aware of the specialized inline. Here's a procedure using the generating ability length / 2
rep(List, Times, TList) :-
( var(Times) ; Times > 0 ), % after joel76' comment...
( var(List) ; is_list(List) ), % after false' comment...
( var(TList) ; is_list(TList) ), % idem...
length(List, LA), LA > 0,
length(TList, LT), LT > 0,
Times is LT / LA,
findall(List, between(1, Times, _), [List|Ls]),
append([List|Ls], TList), !.
the final cut eliminates the loop when any list is free.
source to share
You are using SWI-Prolog, so you can do this:
:- use_module(library(lambda)).
rep(Lst, N, R) :-
( numlist(1,N, NL)
-> foldl(\_X^Y^Z^append(Y, Lst, Z), NL, [], R)
; R = []).
To resolve CapelliC's comment, does not report binding X to rep (X, 2, [a, b, a, b]) you should write
foldl(Lst +\_X^Y^Z^append(Y, Lst, Z), NL, [], R)
[Edit] Thanks @false! Interesting that
rep(Lst, N, R) :-
( nonvar(N)
-> length(NL, N),
foldl(Lst +\_^Y^append(Y, Lst), NL, [], R)
; foldl(Lst +\_^Y^append(Y, Lst), NL, [], R),
length(NL, N)),
!.
But unfortunately it loops with rep ([a, b], N, [a, c, a, c])!
source to share
A simple (but possibly ineffective) strategy is to scan the second list and check each time if the first is a sub-list of the remainder.
To check, you can use a statement prefix/2
from SWI-Prolog.
sublist_count(L, R, Times) :-
sublist_count(L, R, 0, Times).
sublist_count(L, [], Times, Times).
sublist_count(L, [R | Tail], Times, End) :-
prefix(L, [R | Tail]), !,
NewTimes is Times + 1,
sublist_count(L, Tail, NewTimes, End).
sublist_count(L, [R | Tail], Times, End) :-
sublist_count(L, Tail, Times, End).
source to share
Will the following make sense. (I don't handle the case where Times
undefined.)
rep(List, Times, TList) :-
length(List, ListLen),
PrefixLen is ListLen * Times,
open_list(List, OpenList, OpenList),
length(TList, PrefixLen),
append(TList, _, OpenList).
where is open_list/3
defined as:
open_list([], X, X).
open_list([H | T1], [H | T2], X) :-
open_list(T1, T2, X).
The idea is to create an infinite list and then disable the required prefix.
Usage example:
?- rep([a, c], 2, TList). TList = [a, c, a, c]. ?- rep(List, 2, TList). List = TList, TList = [] ; List = [_G886], TList = [_G886, _G886] ; List = [_G886, _G889], TList = [_G886, _G889, _G886, _G889] ;
source to share