Prolog - replacing subterms - recursion

I'm doing some past exam papers for practice for my exam, and I've come across a question that I'm not quite sure how to tackle:
I know I've got to use the "univ" function to break up the term into a list, and then recurse through that list and check if any of the elements in the list equal the term we want to replace. However, I'm a bit lost with double recursing when the list contains another complex term that we have to break down further. My attempt so far is as follows:
complexTerm(X) :- nonvar(X), functor(X, _, A), A > 0.
replace(Term, Subterm, Subterm1, Term1) :-
Term =.. [H|T],
replaceSub([H|T], Subterm, Subterm1, Term1)
replaceSub([], Subterm, Subterm1, Term1).
replaceSub([H], Subterm, Subterm1, Term1) :-
atomic(X),
H == Subterm,
H = Subterm1.
replaceSub([H], Subterm, Subterm1, Term1) :-
complexTerm(H),
replace(H, Subterm, Subterm1, Term1).
replaceSub([H|T]) :- % not sure where to continue with this.
Any pointers would be much appreciated. Note that for the exam we can't use external modules.
Thanks for your time.

The key to such tasks is to recognize which cases you actually need to distinguish.
As it turns out: Not many.
For example:
replace(Subterm0, Subterm, Term0, Term) :-
( Term0 == Subterm0 -> Term = Subterm
; var(Term0) -> Term = Term0
; Term0 =.. [F|Args0],
maplist(replace(Subterm0,Subterm), Args0, Args),
Term =.. [F|Args]
).
I have taken the small liberty to use an argument order that makes maplist/3 applicable.
To quote from the Prolog standard:
8.5.3 (=..)/2 - univ
8.5.3.1 Description
'=..'(Term, List) is true iff:
- Term is an atomic term and List is the list whose
only element is Term, or
...
For this reason, atomic and complex terms can be handled uniformly in this case! There is no reason to distinguish between atomic and complex terms, nor is there any reason to treat lists specially in any way.
Example:
?- replace(1, 2, f(a,[[b]],g(1),X,h(z,1)), T).
T = f(a, [[b]], g(2), X, h(z, 2)).

Related

Prolog: Check predicate against every item in the list

Basically, I want to be able to check to see if at least one value in a list satisfies some predicate.
What I have so far:
need(x,y).
check_list(X,[H|T]) :-
need(H,X).
And so this works fine so long as I only have one value in the list. I'm not sure how to make it check the other values. When I try and use recursion I eventually find an element that satisfies the second predicate but it then goes back up the stack which will eventually cause it to be false.How can I make it 'break' essentially?
The backtracking you are seeing during recursion is Prolog attempting to find more ways for the predicate to succeed. This is a fundamental Prolog behavior and is what makes it useful. It seeks to find all of the solutions.
In your case, you only want to confirm one solution to the problem of, An element in the list that meets a specific criterion. For this, you could use a cut:
check_list(X, [H|_]) :-
need(X, H), !. % Don't backtrack after success
check_list(X, [_|T]) :-
check_list(X, T).
Or you could use once/1 which is specifically designed to handle cases where you only want a single solution:
check_list(X, [H|_]) :-
need(X, H).
check_list(X, [_|T]) :-
check_list(X, T).
check_list_once(X, L) :- once(check_list(X, L)).
Here is an example of what you can do.
I want to check is numbers are odd.
is_even(X) :-
X mod 2 =:= 0.
check_list(L, CL) :-
include(is_even, L, CL).
with result
?- check_list([1,2,3,4,5], L).
L = [2, 4].
?- check_list([1,3,5], L).
L = [].
You can use simple recursion:
need(x,y).
check_list(X,[H|T]) :-
( need(H,X) -> true;
check_list(X,T) ).
You can see in the examples below that this definition is deterministic:
?- check_list(y,[1,2,3]).
false.
?- check_list(y,[x,2,3]).
true.
?- check_list(y,[1,2,x]).
true.
?- check_list(Y,[1,2,x]).
Y = y.
?- check_list(Y,[1,2,3]).
false.
?- check_list(Y,[1,x,3]).
Y = y.
?- check_list(Y,[1,X,3]).
Y = y,
X = x.
?- check_list(Y,[1,2,3]), Y = x.
false.
?- check_list(Y,[1,2,3]), Y = y.
false.
?- check_list(Y,[1,2,3]).
false.
?- check_list(Y,[1,2,x]), Y = y.
Y = y.
Though if you want your queries to have uninstantiated variables e.g check_list(Y,[1,2,x]). and you add another fact need(x,z). Then:
?- check_list(Y,[1,2,x]).
Y = y.
Returns only one result and not Y = z. You could use if_/3 from library reif if you want a better definition of check_list/3.

Recursive count SWI-Prolog

I am trying to count a whole Europe population using this fucntion:
printEuropePopulation(A) :-
country(_, X, _, _),
printEuropePopulation(A+X),
true.
printEuropePopulation(A) :- write(A).
And program gives me
Out of local stack
when I call my func
printEuropePopulation(0)
Facts looks like:
country("Slovenia",20,2009,27300).
country("Finland",338,5238,35500).
country("France",549,60876,33800).
How can I fix it? Thanks in advance.
You cannot do this with a recursive predicate I think? It is easier to collect all the facts and then find the sum.
total_population(Total) :-
findall(P, country_population(_, P), Ps),
list_sum(Ps, Total).
In your definition you are taking the area it seems, but I take the population in thousands:
country_population(C, P) :- country(C, _, P, _).
If you want to find the sum you can do a recursive predicate because now you have all the population counts (the second argument?) in a list.
list_sum([], 0).
list_sum([X|Xs], Sum) :-
list_sum(Xs, S0),
Sum is S0 + X.
Now you can query it to find the sum of the second arguments of country
?- total_population(P).
P = 68123.
But if you are using SWI-Prolog you can also use one library which is called "aggregate" because you can use it to aggregate for example the sum:
?- aggregate_all(sum(P), country(_, _, P, _), Total_population).
Total_population = 68123.

Permutation predicate in Prolog

I have written the following in Prolog (I am using version 7.4.0-rc1), trying to define a predicate insertPermutation/2 which is true if and only if both arguments are lists, one a permutation of the other.
delete(X,[X|T],T). % Base case, element equals head.
delete(X,[A|B],[A|C]) :- delete(X,B,C). % And/or repeat for the tail.
insert(X,Y,Z) :- delete(X,Z,Y). % Inserting is deletion in reverse.
insertPermutation([],[]). % Base case.
insertPermutation([H|T],P) :- insertPermutation(Q,T), insert(H,Q,P). % P permutation of T, H inserted.
I have already been made aware that delete is not a good name for the above helper predicate. We are required to write these predicates, and we cannot use the built-in predicates. This is why I wrote the above code in this way, and I chose the name I did (because I first wrote it to delete an element). It is true if and only if the third argument is a list, equal to the list in the second argument with the first instance of the first argument removed.
The insertPermutation predicate recursively tests if P equals a permutation of the tail of the first list, with the head added in any position in the permutation. This way it works to the base case of both being empty lists.
However, the permutation predicate does not behave the way I want it to. For instance, to the query
?- insertPermutation([1,2,2],[1,2,3]).
Prolog does not return false, but freezes. To the query
?- insertPermutation(X,[a,b,c]).
Prolog responds with
X = [a, b, c] ;
X = [b, a, c] ;
X = [c, a, b] ;
X = [a, c, b] ;
X = [b, c, a] ;
X = [c, b, a] ;
after which it freezes again. I see these problems are related, but not how. Can someone point out what case I am missing?
Edit: Two things, this is homework, and I need to solve this problem using an insert predicate. I wrote this one.
The answer is to change the last line
% P permutation of T, H inserted.
insertPermutation([H|T],P) :-
insertPermutation(Q,T),
insert(H,Q,P).
% P permutation of T, H inserted.
insertPermutation(P,[H|T]) :-
insertPermutation(Q,T),
insert(H,Q,P).
The use cases only needed to check if the first element is a permutation of the latter, not the other way around (or vice versa). Anti-climatic, but the answer to my problem.

What is a good way to define a finite multiplication table in Isar?

Suppose I have a binary operator f :: "sT => sT => sT". I want to define f so that it implements a 4x4 multiplication table for the Klein four group, shown here on the Wiki:
http://en.wikipedia.org/wiki/Klein_four-group
Here, all I'm attempting to do is create a table with 16 entries. First, I define four constants like this:
consts
k_1::sT
k_a::sT
k_b::sT
k_ab::sT
Then I define my function to implement the 16 entries in the table:
k_1 * k_1 = k_1
k_1 * k_a = k_a
...
k_ab * k_ab = k_1
I don't know how to do any normal-like programming in Isar, and I've seen on the Isabelle user's list where it was said that (certain) programming-like constructs have been intentionally de-emphasized in the language.
The other day, I was trying to create a simple, contrived function, and after finding the use of if, then, else in a source file, I couldn't find a reference to those commands in isar-ref.pdf.
In looking at the tutorials, I see definition for defining functions in a straightforward way, and other than that, I only see information on recursive and inductive functions, which require datatype, and my situation is more simple than that.
If left to my own devices, I guess I would try and define a datatype for those 4 constants shown above, and then create some conversion functions so that I end up with a binary operator f :: sT => sT => sT. I messed around a little with trying to use fun, but it wasn't turning out to be a simple deal.
I had done a little experimenting with fun and inductive
UPDATE: I add some material here in response to the comment telling me that Programming and Proving is where I'll find the answers. It seems I might be going astray of the ideal Stackoverflow format.
I had done some basic experimenting, mainly with fun, but also with inductive. I gave up on inductive fairly fast. Here's the type of error I got from simple examples:
consts
k1::sT
inductive k4gI :: "sT => sT => sT" where
"k4gI k1 k1 = k1"
--"OUTPUT ERROR:"
--{*Proofs for inductive predicate(s) "k4gI"
Ill-formed introduction rule ""
((k4gI k1 k1) = k1)
Conclusion of introduction rule must be an inductive predicate
*}
My multiplication table isn't inductive, so I didn't see that inductive was what I should spend my time chasing.
"Pattern matching" seems a key idea here, so I experimented with fun. Here's some really messed up code trying to use fun with only a standard function type:
consts
k1::sT
fun k4gF :: "sT => sT => sT" where
"k4gF k1 k1 = k1"
--"OUTPUT ERROR:"
--"Malformed definition:
Non-constructor pattern not allowed in sequential mode.
((k4gF k1 k1) = k1)"
I got that kind of error, and I had read things like this in Programming and Proving:
"Recursive functions are defined with fun by pattern matching over datatype constructors.
That all gives a novice the impression that fun requires datatype. As far its big brother function, I don't know about that.
It seems here, all I need is a recursive function with 16 base cases, and that would define my multiplication table.
Is function the answer?
In editing this question, I remembered function from the past, and here's function at work:
consts
k1::sT
function k4gF :: "sT => sT => sT" where
"k4gF k1 k1 = k1"
try
The output of try is telling me it can be proved (Update: I think it's actually telling me that only 1 of the proof steps can be prove.):
Trying "solve_direct", "quickcheck", "try0", "sledgehammer", and "nitpick"...
Timestamp: 00:47:27.
solve_direct: (((k1, k1) = (k1, k1)) ⟹ (k1 = k1)) can be solved directly with
HOL.arg_cong: ((?x = ?y) ⟹ ((?f ?x) = (?f ?y))) [name "HOL.arg_cong", kind "lemma"]
HOL.refl: (?t = ?t) [name "HOL.refl"]
MFZ.HOL⇣'eq⇣'is⇣'reflexive: (?r = ?r) [name "MFZ.HOL⇣'eq⇣'is⇣'reflexive", kind "theorem"]
MFZ.HOL_eq_is_reflexive: (?r = ?r) [name "MFZ.HOL_eq_is_reflexive", kind "lemma"]
Product_Type.Pair_inject:
(⟦((?a, ?b) = (?a', ?b')); (⟦(?a = ?a'); (?b = ?b')⟧ ⟹ ?R)⟧ ⟹ ?R)
[name "Product_Type.Pair_inject", kind "lemma"]
I don't know what that means. I only know about function because of trying to prove an inconsistency. I only know it doesn't complain as much. If using function like this is how I define my multiplication table, then I'm happy.
Still, being an argumentative type, I didn't learn about function in a tutorial. I learned about it several months ago in a reference manual, and I still don't know much about how to use it.
I have a function which I prove with auto, but the function is probably no good, fortunately. That adds to the function's mystery. There's information on function in Defining Recursive Functions in Isabelle/HOL, and it compares fun and function.
However, I haven't seen one example of fun or function that doesn't use a recursive datatype, such as nat or 'a list. Maybe I didn't look hard enough.
Sorry for being verbose and this not ending up as a direct question, but there's no tutorial with Isabelle that takes a person directly from A to B.
Below, I don't adhere to an "only answer the question" format, but I am responding to my own question, and so everything I say will be of interest to the original poster.
(2nd update begin)
This should be my last update. To be content with "unsophisticated methods", it helps to be able to make comparisons to see the "low tech" way can be the best way.
I finally quit trying to make my main type work with the new type, and I just made me a Klein four-group out of a datatype like this, where the proof of associativity is at the end:
datatype AT4k = e4kt | a4kt | b4kt | c4kt
fun AOP4k :: "AT4k => AT4k => AT4k" where
"AOP4k e4kt y = y"
| "AOP4k x e4kt = x"
| "AOP4k a4kt a4kt = e4kt"
| "AOP4k a4kt b4kt = c4kt"
| "AOP4k a4kt c4kt = b4kt"
| "AOP4k b4kt a4kt = c4kt"
| "AOP4k b4kt b4kt = e4kt"
| "AOP4k b4kt c4kt = a4kt"
| "AOP4k c4kt a4kt = b4kt"
| "AOP4k c4kt b4kt = a4kt"
| "AOP4k c4kt c4kt = e4kt"
notation
AOP4k ("AOP4k") and
AOP4k (infixl "*" 70)
theorem k4o_assoc2:
"(x * y) * z = x * (y * z)"
by(smt AOP4k.simps(1) AOP4k.simps(10) AOP4k.simps(11) AOP4k.simps(12)
AOP4k.simps(13) AOP4k.simps(2) AOP4k.simps(3) AOP4k.simps(4) AOP4k.simps(5)
AOP4k.simps(6) AOP4k.simps(7) AOP4k.simps(8) AOP4k.simps(9) AT4k.exhaust)
The consequence is that I am now content with my if-then-else multiplication function. Why? Because the if-then-else function is very conducive to simp magic. This pattern matching doesn't work any magic in and of itself, not to mention that I would still have to work out the coercive subtyping part of it.
Here's the if-then-else function for the 4x4 multiplication table:
definition AO4k :: "sT => sT => sT" where
"AO4k x y =
(if x = e4k then y else
(if y = e4k then x else
(if x = y then e4k else
(if x = a4k y = c4k then b4k else
(if x = b4k y = c4k then a4k else
(if x = c4k y = a4k then b4k else
(if x = c4k y = b4k then a4k else
c4k)))))))"
Because of the one nested if-then-else statement, when I run auto, it produces 64 goals. I made 16 simp rules, one for every value in the multiplication table, so when I run auto, with all the other simp rules, the auto proof takes about 90ms.
Low tech is the way to go sometimes; it's a RISC vs. CISC thing, somewhat.
A small thing like a multiplication table can be important for testing things, but it can't be useful if it's gonna slow my THY down because it's in some big loop that takes forever to finish.
(2nd update end)
(Update begin)
(UPDATE: My question above falls under the category "How do I do basic programming in Isabelle, like with other programming languages?" Here, I go beyond the specific question some, but I try to keep my comments about the challenge to a beginner who is trying to learn Isabelle when the docs are at the intermediate level, at least, in my opinion they are.
Specific to my question, though, is that I have need for a case statement, which is a very basic feature of many, many programming languages.
In looking for a case statement today, I thought I hit gold after doing one more search in the docs, this time in Isabelle - A Proof Assistant for
Higher-Order Logic.
On page 5 it documents a case statement, but on page 18, it clarifies that it's only good for datatype, and I seem to confirm that with an error like this:
definition k4oC :: "kT => kT => kT" (infixl "**" 70) where
"k4oC x y = (case x y of k1 k1 => k1)"
--{*Error in case expression:
Not a datatype constructor: "i130429a.k1"
In clause
((k1 k1) ⇒ k1)*}
This is an example that a person, whether expert or beginner, has a need for a tutorial to run through the basic programming features of Isabelle.
If you say, "There are tutorials that do that." I say, "No, there aren't, not in my opinion".
The tutorials emphasize the important, sophisticated features of Isabelle that separate it from the crowd.
That's commentary, but it's commentary meant to tie into the question, "How do I learn Isabelle?", and which my original question above is related to.
The way you learn Isabelle without being a PhD graduate student at Cambridge, TUM, or NICTA, is you struggle for 6 to 12 months or more. If during that time you don't abandon, you can be at a level that will allow you to appreciate the intermediate level instruction available. Experience may vary.
For me, the 3 books that will take me to the next level of proving, weaning me off of auto and metis, when I find time to go through them, are
Isabelle - A Proof Assistant for Higher-Order Logic
Programming and Proving in Isabelle/HOL
Isabelle/Isar --- a versatile environment for human-readable formal proof documents
If someone says, "You've abused the Stackoverflow answer format by engaging in long-winded commentary and opinion."
I say, "Well, I asked for a good way to do some basic programming in Isabelle, where I was hoping for something more sophisticated than a big if-then-else statement. No one provided anything close to what I asked for. In fact, I am who provided a pattern matching function, and what I needed to do it is not even close to being documented. Pattern matching is a simple concept, but not necessarily in Isabelle, due to the proof requirements for recursive functions. (If there's a simple way to do it to replace my if-then-else function below, or even a case statement way, I'd sure like to know.)
Having said that, I am inclined to take some liberties, and there are, at this time, only 36 views for this page anyway, of which probably, at least 10 come from my browser.
Isabelle/HOL is a powerful language. I'm not complaining. It only sounds like it.)
(Update end)
It can count for a lot just to know that something is true or false, in this case being told that function can work with non-inductive types. However, how I end up using function below is not a result of anything I've seen in any one Isabelle document, and I had need for this former SO question on coercive subtyping:
What is an Isabelle/HOL subtype? What Isar commands produce subtypes?
I end up with two ways that I completed a 2x2 part of my multiplication table. I link here to the theory: as ASCII friendly A_i130429a.thy, jEdit friendly i130429a.thy, the PDF, and folder.
The two ways are:
The clumsy but fast and simp friendly if-then-else way. The definition takes 0ms, and the proof takes 155ms.
The pattern matching way using function. Here I could think aloud in public for a long time about this way of doing things, but I won't. I know I'll use what I've learned here, but it's definitely not an elegant solution for a simple multiplication table function, and it's far from obvious that a person would have to do all that to create a basic function that uses pattern matching. Of course, maybe I don't have to do all that. The definition takes 391ms, and the proof takes 317ms.
As to having to resort to using if-then-else, either Isabelle/HOL is not feature rich when it comes to basic programming statements, or these basic statements aren't documented. The if-then-else statement is not even in the Isar Reference Manual index. I think, "If it's not documented, maybe there's a nice, undocumented case statement like Haskell has". Still, I'd take Isabelle over Haskell any day.
Below, I explain the different sections of A_i130429a.thy. It's sort of trivial, but not completely, since I haven't seen an example to teach me how to do that.
I start with a type and four constants, which remain undefined.
typedecl kT
consts
k1::kT
ka::kT
kb::kT
kab::kT
Of note is that the constants remain undefined. That I'm leaving a lot of things undefined is part of why I have problems finding good examples in docs and sources to use as templates for myself.
I do a test to try and intelligently use function on a non-inductive datatype, but it doesn't work. With my if-then-else function, after I figure out I'm not restricting my function domain, I then see that the problem with this function was also with the domain. The function k4f0 is wanting x to be k1 or ka for every x, which obviously is not true.
function k4f0 :: "kT => kT" where
"k4f0 k1 = k1"
| "k4f0 ka = ka"
apply(auto)
apply(atomize_elim)
--"goal (1 subgoal):
1. (!! (x::sT). ((x = k1) | (x = ka)))"
I give up and define me an ugly function with if-then-else.
definition k4o :: "kT => kT => kT" (infixl "**" 70) where
"k4o x y =
(if x = k1 & y = k1 then k1 else
(if x = k1 & y = ka then ka else
(if x = ka & y = k1 then ka else
(if x = ka & y = ka then k1 else (k1)
))))"
declare k4o_def [simp add]
The hard part becomes trying to prove associativity of my function k4o. But that's only because I'm not restricting the domain. I put in an implication into the statement, and the auto magic kicks in, the fastforce magic is there also, and faster, so I use it.
abbreviation k4g :: "kT set" where
"k4g == {k1, ka}"
theorem
"(x \<in> k4g & y \<in> k4g & z \<in> k4g) --> (x ** y) ** z = x ** (y ** z)"
by(fastforce)(*155ms*)
The magic makes me happy, and I'm then motivated to try and get it done with function and pattern matching. Because of the recent SO answer on coercive subtyping, linked to above, I figure out how to fix the domain with typedef. I don't thinks it's the perfect solution, but I definitely learned something.
typedef kTD = "{x::kT. x = k1 | x = ka}"
by(auto)
declare [[coercion_enabled]]
declare [[coercion Abs_kTD]]
function k4f :: "kTD => kTD => kT" (infixl "***" 70) where
"k4f k1 k1 = k1"
| "k4f k1 ka = ka"
| "k4f ka k1 = ka"
| "k4f ka ka = k1"
by((auto),(*391ms*)
(atomize_elim),
(metis (lifting, full_types) Abs_kTD_cases mem_Collect_eq),
(metis (lifting, full_types) Rep_kTD_cases Rep_kTD_inverse mem_Collect_eq),
(metis (lifting, full_types) Rep_kTD_cases Rep_kTD_inverse mem_Collect_eq),
(metis (lifting, full_types) Rep_kTD_cases Rep_kTD_inverse mem_Collect_eq),
(metis (lifting, full_types) Rep_kTD_cases Rep_kTD_inverse mem_Collect_eq))
termination
by(metis "termination" wf_measure)
theorem
"(x *** y) *** z = x *** (y *** z)"
by(smt
Abs_kTD_cases
k4f.simps(1)
k4f.simps(2)
k4f.simps(3)
k4f.simps(4)
mem_Collect_eq)(*317ms*)
A more or less convenient syntax for defining a "finite" function is the function update syntax: For a function f, f(x := y) represents the function %z. if z = x then y else f z. If you want to update more than one value, separate them with commas: f(x1 := y1, x2 := y2).
So, for example function which is addition for 0, 1 and undefined else could be written as:
undefined (0 := undefined(0 := 0, 1 := 1),
1 := undefined(0 := 1, 1 := 2))
Another possibility to define a finite function is to generate it from a list of pairs; for example with map_of. With f xs y z = the (map_of xs (y,z)), then the above function could be written as
f [((0,0),0), ((0,1),1), ((1,0),1), ((1,1),1)]
(Actually, it is not quite the same function, as it might behave differently outside the defined Domain).

count the number of calls of a clause

I have a clause like following:
lock_open:-
conditional_combination(X),
equal(X,[8,6,5,3,6,9]),!,
print(X).
this clause succeed. But I want to know how many times conditional_combination() is called before equal(X,[8,6,5,3,6,9]) is become true. the program is to generate a permutation by following some rules. And I need to how many permutation is need to generate to get a particular value like 865369.
What you actually want is something slightly different: You want to count the number of answers (so far) of a goal.
The following predicate call_nth(Goal_0, Nth) succeeds like call(Goal_0) but has an additional argument which indicates that the answer found is the n-th answer. This definition is highly specific to SWI or YAP. Do not use things like nb_setarg/3 in your general programs, but use them for well encapsulated cases as this one. Even within
those two systems, the precise meaning of these constructs is not well defined for the general case. Here is a definition for SICStus. Update: use unsigned_64 in newer versions instead of unsigned_32.
call_nth(Goal_0, Nth) :-
nonvar(Nth),
!,
Nth \== 0,
\+arg(Nth,+ 1,2), % produces all expected errors
State = count(0,_), % note the extra argument which remains a variable
Goal_0,
arg(1, State, C1),
C2 is C1+1,
( Nth == C2
-> !
; nb_setarg(1, State, C2),
fail
).
call_nth(Goal_0, Nth) :-
State = count(0,_), % note the extra argument which remains a variable
Goal_0,
arg(1, State, C1),
C2 is C1+1,
nb_setarg(1, State, C2),
Nth = C2.
A more robust abstraction is provided by Eclipse:
call_nth(Goal_0, Nth) :-
shelf_create(counter(0), CounterRef),
call(Goal_0),
shelf_inc(CounterRef, 1),
shelf_get(CounterRef, 1, Nth).
?- call_nth(between(1,5,I),Nth).
I = Nth, Nth = 1
; I = Nth, Nth = 2
; I = Nth, Nth = 3
; I = Nth, Nth = 4
; I = Nth, Nth = 5.
So simply wrap it around:
lock_open :-
call_nth(conditional_combination(X), Nth),
X = [8,6,5,3,6,9],
!,
....
If you are using SWI prolog you can use nb_getval/2 and nb_setval/2 to achieve what you want:
lock_open:-
nb_setval(ctr, 0), % Initialize counter
conditional_combination(X),
nb_inc(ctr), % Increment Counter
equal(X,[8,6,5,3,6,9]),
% Here you can access counter value with nb_getval(ctr, Value)
!,
print(X).
nb_inc(Key):-
nb_getval(Key, Old),
succ(Old, New),
nb_setval(Key, New).
Other prologs have other means to do the same, look for global variables in your prolog implementation. In this snippet I used the term ctr to hold the current goal counter. You can use any term there that is not used in your program.
While working on a module "micro", I recently invented pivots. They are inspired by the thread / pipe pattern to pass around data. A pivot is a bounded queue of maximum length one, the pivot_put/1 does a copy of the given term as well. But for performance reasons they don't use a synchronized and are non-blocking.
In as far they are very similar to nb_setarg/3, except that they don't destruct a Prolog term, but instead they update a Java data structure. As a result they are little bit safer than the non-logical term operations. Also they don't need some call_cleanup/3, since they are Java garbage collected.
In as far they are more similar than nb_setarg/3, than using some explicit allocate and dealloccate of structures. So for example a solution for SICStus Prolog could be:
call_nth(Goal_0, Nth) :-
new(unsigned_32, Counter),
call_cleanup(call_nth1(Goal_0, Counter, Nth),
dispose(Counter)).
call_nth1(Goal_0, Counter, Nth) :-
call(Goal_0),
get_contents(Counter, contents, Count0),
Count1 is Count0+1,
put_contents(Counter, contents, Count1),
Nth = Count1.
With pivots, there is even no 32-bit limitation, and we can directly do:
call_nth(G, C) :-
pivot_new(P),
pivot_put(P, 0),
call(G),
pivot_take(P, M),
N is M+1,
pivot_put(P, N),
C = N.

Resources