Prolog - PCP solver - prolog

I'm wondering if there's an (understandable) way to brute force solve Post correspondence problem using prolog predicates?
for example:
?- pcp(["1","11"),("10111","101")], S).
S = [2,1,1]

Ok, here's a possible program, which uses breadth first search, to find increasingly bigger solution to the problem.
1 ?- [user].
Start the search at solutions of size 1
|: pcp(Ts,S) :- pcp(Ts,S,1).
Try finding a solution at the current size, and if you don't find one try the next size
|: pcp(Ts,S,N) :- pcp_solve(Ts,("",""),S,N).
|: pcp(Ts,S,N) :- N2 is N+1, pcp(Ts,S,N2).
If at the end of your solution of the correct size, the strings are matched completely then the problem is solved
|: pcp_solve(_,("",""),[],0).
Big step for checking the solution: get the tuple element indexed in the solution from the list of string tuples, append the strings in this tuple to the strings from the last step, match everything that's the same, leaving at least one of the strings empty, then go onto the next part of the solution. (Obviously, if the strings don't match at some point matchreduce will fail.)
|: pcp_solve(Ts,A,[I|S],N) :- N>0, N2 is N-1, nth1(I,Ts,T),
|: bothappend(A,T,AT), matchreduce(AT,ATr), pcp_solve(Ts,ATr,S,N2).
Here are the rest of the predicates:
|: bothappend((A1,B1),(A2,B2),(A3,B3)) :- append(A1,A2,A3), append(B1,B2,B3).
|: matchreduce(([],B),([],B)) :- !.
|: matchreduce((A,[]),(A,[])).
|: matchreduce(([X|A],[X|B]),(Ao,Bo)) :- matchreduce((A,B),(Ao,Bo)).
The append and nth1 predicates are in the lists library (SWI-Prolog) but can be implemented easily!
|: :- use_module(library(lists)).
% library(error) compiled into error 0.01 sec, 9,640 bytes
% library(lists) compiled into lists 0.03 sec, 22,996 bytes
|:
% user://1 compiled 0.12 sec, 25,600 bytes
true.
Here's your test case:
2 ?- pcp([("1","11"),("10111","101")], S).
S = [2, 1, 1] ;
S = [2, 1, 1, 2, 1, 1] ;
S = [2, 1, 1, 2, 1, 1, 2, 1, 1] ;
S = [2, 1, 1, 2, 1, 1, 2, 1, 1|...] .
And a couple from wikipedia:
3 ?- pcp([("a","baa"),("ab","aa"),("bba","bb")], S).
S = [3, 2, 3, 1] ;
S = [3, 2, 3, 1, 3, 2, 3, 1] ;
S = [3, 2, 3, 1, 3, 2, 3, 1, 3|...] .
4 ?- pcp([("bb","b"),("ab","ba"),("c","bc")], S).
S = [1, 3] ;
S = [1, 2, 3] ;
S = [1, 2, 2, 3] ;
S = [1, 3, 1, 3] ;
S = [1, 2, 2, 2, 3] ;
S = [1, 2, 3, 1, 3] ;
S = [1, 3, 1, 2, 3] ;
S = [1, 2, 2, 2, 2, 3] ;
S = [1, 2, 2, 3, 1, 3] ;
S = [1, 2, 3, 1, 2, 3] ;
S = [1, 3, 1, 2, 2, 3] ;
S = [1, 3, 1, 3, 1, 3] ;
S = [1, 2, 2, 2, 2, 2, 3] ;
S = [1, 2, 2, 2, 3, 1, 3] ;
S = [1, 2, 2, 3, 1, 2, 3] ;
S = [1, 2, 3, 1, 2, 2, 3] ;
S = [1, 2, 3, 1, 3, 1, 3] ;
S = [1, 3, 1, 2, 2, 2, 3] ;
S = [1, 3, 1, 2, 3, 1, 3] ;
S = [1, 3, 1, 3, 1, 2, 3] ;
S = [1, 2, 2, 2, 2, 2, 2, 3] ;
S = [1, 2, 2, 2, 2, 3, 1, 3] ;
S = [1, 2, 2, 2, 3, 1, 2, 3] ;
S = [1, 2, 2, 3, 1, 2, 2, 3] ;
S = [1, 2, 2, 3, 1, 3, 1, 3] ;
S = [1, 2, 3, 1, 2, 2, 2, 3] ;
S = [1, 2, 3, 1, 2, 3, 1, 3] ;
S = [1, 2, 3, 1, 3, 1, 2, 3] ;
S = [1, 3, 1, 2, 2, 2, 2, 3] ;
S = [1, 3, 1, 2, 2, 3, 1, 3] ;
S = [1, 3, 1, 2, 3, 1, 2, 3] ;
S = [1, 3, 1, 3, 1, 2, 2, 3] ;
S = [1, 3, 1, 3, 1, 3, 1, 3] ;

Related

How to get the Nth arrangement in a Combinatoric sequence and vice-versa?

how do I get the Nth arrangement out of all possible combinations of arranging 4 indistinguishable balls in 3 distinct buckets. if Bl = number of balls and Bk = number of buckets e.g. for Bl = 4, Bk = 3 the possible arrangements are :
004,013,022,031,040,103,112,121,130,202,211,220,301,310,400 .
the first arrangement(N=0) is 004(i.e. bucket 1 = 0 balls, bucket 2 = 0 balls, bucket 3 = 4 balls) and the last(N=14) is 400. so say I have 103 N would be equal to 5. I want to be able to do
int Bl=4,Bk=3;
getN(004,Bl,Bk);// which should be = 0
getNthTerm(8,Bl,Bk);// which should be = 130
P.S: max number of terms for the sequence is (Bl+Bk-1)C(Bk-1) where C is the combinatorics/combination operator. Obtained from stars and bars
As far as I know, there is no faster way of doing this than combinatorial decomposition which takes roughly O(Bl) time.
We simply compute the number of balls which go into the each bucket for the selected index, working one bucket at a time. For each possible assignment to the bucket we compute the number of possible arrangements of the remaining balls and buckets. If the index is less than that number, we select that arrangement; otherwise we put one more ball in the bucket and subtract the number of arrangements we just skipped from the index.
Here's a C implementation. I didn't include the binom function in the implementation below. It's usually best to precompute the binomial coefficients over the range of values you are interested in, since there won't normally be too many. It is easy to do the computation incrementally but it requires a multiplication and a division at each step; while that doesn't affect the asymptotic complexity, it makes the inner loop much slower (because of the divide) and increases the risk of overflow (because of the multiply).
/* Computes arrangement corresponding to index.
* Returns 0 if index is out of range.
*/
int get_nth(long index, int buckets, int balls, int result[buckets]) {
int i = 0;
memset(result, 0, buckets * sizeof *result);
--buckets;
while (balls && buckets) {
long count = binom(buckets + balls - 1, buckets - 1);
if (index < count) { --buckets; ++i; }
else { ++result[i]; --balls; index -= count; }
}
if (balls) result[i] = balls;
return index == 0;
}
There are some interesting bijections that can be made. Finally, we can use ranking and unranking methods for the regular k-combinations, which are more common knowledge.
A bijection from the number of balls in each bucket to the ordered multiset of choices of buckets; for example: [3, 1, 0] --> [1, 1, 1, 2] (three choices of 1 and one choice of 2).
A bijection from the k-subsets of {1...n} (with repetition) to k-subsets of {1...n + k − 1} (without repetition) by mapping {c_0, c_1...c_(k−1)} to {c_0, c_(1+1), c_(2+2)...c_(k−1+k−1)} (see here).
Here's some python code:
from itertools import combinations_with_replacement
def toTokens(C):
return map(lambda x: int(x), list(C))
def compositionToChoice(tokens):
result = []
for i, t in enumerate(tokens):
result = result + [i + 1] * t
return result
def bijection(C):
result = []
k = 0
for i, _c in enumerate(C):
result.append(C[i] + k)
k = k + 1
return result
compositions = ['004','013','022','031','040','103','112',
'121','130','202','211','220','301','310','400']
for c in compositions:
tokens = toTokens(c)
choices = compositionToChoice(tokens)
combination = bijection(choices)
print "%s --> %s --> %s" % (tokens, choices, combination)
Output:
"""
[0, 0, 4] --> [3, 3, 3, 3] --> [3, 4, 5, 6]
[0, 1, 3] --> [2, 3, 3, 3] --> [2, 4, 5, 6]
[0, 2, 2] --> [2, 2, 3, 3] --> [2, 3, 5, 6]
[0, 3, 1] --> [2, 2, 2, 3] --> [2, 3, 4, 6]
[0, 4, 0] --> [2, 2, 2, 2] --> [2, 3, 4, 5]
[1, 0, 3] --> [1, 3, 3, 3] --> [1, 4, 5, 6]
[1, 1, 2] --> [1, 2, 3, 3] --> [1, 3, 5, 6]
[1, 2, 1] --> [1, 2, 2, 3] --> [1, 3, 4, 6]
[1, 3, 0] --> [1, 2, 2, 2] --> [1, 3, 4, 5]
[2, 0, 2] --> [1, 1, 3, 3] --> [1, 2, 5, 6]
[2, 1, 1] --> [1, 1, 2, 3] --> [1, 2, 4, 6]
[2, 2, 0] --> [1, 1, 2, 2] --> [1, 2, 4, 5]
[3, 0, 1] --> [1, 1, 1, 3] --> [1, 2, 3, 6]
[3, 1, 0] --> [1, 1, 1, 2] --> [1, 2, 3, 5]
[4, 0, 0] --> [1, 1, 1, 1] --> [1, 2, 3, 4]
"""

Counting number of paths between two nodes in Prolog program

I need some help for counting the number of combinations from which a destination node can be reached.
I found the program for finding the different paths. But in the end I need to have some query
%Edge List (Knowledge Base)
edge(1,2).
edge(1,4).
edge(2,4).
edge(3,6).
edge(3,7).
edge(4,3).
edge(4,5).
edge(5,6).
edge(5,7).
edge(6,5).
edge(7,5).
edge(8,6).
edge(8,7).
%Program
path(X,Y,[X,Y]):- edge(X,Y).
path(X,Y,[X|Xs]):- edge(X,W), path(W,Y,Xs).
-------------------------------------------------
%Query
path(1, 7, P).
%Results
Z = [1, 2, 4, 3, 6, 5, 7];
Z = [1, 2, 4, 3, 6, 5, 6, 5, 7];
.........................
But what if I want to run a query that gives me the number of these paths.
?-path(1, 7, count).
should return 2
First of all you're answer fall into cycles and does not terminate, you could keep a list of what you've visited in order to avoid visit same nodes twice:
path(X,Y,L):-path(X,Y,L,[X]).
path(X,Y,[X,Y],L):- \+member(Y,L),edge(X,Y).
path(X,Y,[X|Xs],L):- edge(X,W),\+ member(W,L) ,path(W,Y,Xs,[W|L]).
Now if you query:
?- path(1, 7, P).
P = [1, 2, 4, 3, 7] ;
P = [1, 2, 4, 3, 6, 5, 7] ;
P = [1, 2, 4, 5, 7] ;
P = [1, 4, 3, 7] ;
P = [1, 4, 3, 6, 5, 7] ;
P = [1, 4, 5, 7] ;
false.
So the valid paths are not 2, since the above six paths are valid.
Now to count the paths you could try:
findall(P, path(1,7,P), Paths), length(Paths, N).
as suggested in comments but this is not very efficient since you need first to build a list of all paths and count the length.
If you're using Swipl you could try a fail-driven loop to calculate all possible paths and use nb_getval/2 and nb_setval/2 in order to count:
count(X,Y):-
nb_setval(counter, 0),
path(X,Y,_),
nb_getval(counter, Value),
New_value is Value+1,
nb_setval(counter, New_value),
fail;
nb_getval(counter, Value),
write(Value).
Example:
?- count(1,7).
6
true.

comparing 2 arrays in every position

So what Im trying to accomplish is write a (shorter) condition that makes sure each element is different from the other array. This is confusing but I hope this example clears it up.
array = [1, 2, 3]
new_array = array.shuffle
until array[0] != new_array[0] &&
array[1] != new_array[1] &&
array[2] != new_array[2]
new_array = array.shuffle
end
So what Im doing is making sure that every single element/index pair does not match in the other array.
# [1, 2, 3] => [3, 1, 2] yayyyy
# [1, 2, 3] => [3, 2, 1] not what I want because the 2 didnt move
Is there a better way to do what I want to do? Ive looked up the .any? and .none? but I cant seem to figure out how to implement them. Thanks!
I would do this:
array.zip(new_array).all? { |left, right| left != right }
Here are two approaches that do not involve repeated sampling until a valid sample is obtained:
Sample from the population of valid permutations
Construct the population from which you are sampling:
array = [1, 2, 3, 4]
population = array.permutation(array.size).reject do |a|
a.zip(array).any? { |e,f| e==f }
end
#=> [[2, 1, 4, 3], [2, 3, 4, 1], [2, 4, 1, 3], [3, 1, 4, 2], [3, 4, 1, 2],
# [3, 4, 2, 1], [4, 1, 2, 3], [4, 3, 1, 2], [4, 3, 2, 1]]
Then just choose one at random:
10.times { p population.sample }
# [4, 3, 1, 2]
# [3, 4, 1, 2]
# [3, 4, 1, 2]
# [4, 3, 1, 2]
# [2, 1, 4, 3]
# [2, 1, 4, 3]
# [4, 1, 2, 3]
# [2, 1, 4, 3]
# [4, 3, 1, 2]
# [3, 4, 1, 2]
Sequentially sample for each position in the array
def sample_no_match(array)
a = array.each_index.to_a.shuffle
last_ndx = a[-1]
a.dup.map do |i|
if a.size == 2 && a[-1] == last_ndx
select = a[-1]
else
select = (a-[i]).sample
end
a.delete(select)
array[select]
end
end
10.times.each { p sample_no_match(array) }
# [2, 4, 3, 1]
# [4, 3, 1, 2]
# [2, 1, 3, 4]
# [1, 3, 4, 2]
# [1, 3, 2, 4]
# [1, 3, 2, 4]
# [1, 4, 3, 2]
# [3, 4, 2, 1]
# [1, 3, 4, 2]
# [1, 3, 4, 2]
I have been unable to prove or disprove that the second method produces a random sample. We can, however, determine relative frequencies of outcomes:
n = 500_000
h = n.times.with_object(Hash.new(0)) { |_,h| h[sample_no_match(array)] += 1 }
h.keys.each { |k| h[k] = (h[k]/(n.to_f)).round(4) }
h #=> {[1, 2, 3, 4]=>0.0418, [2, 1, 3, 4]=>0.0414, [1, 4, 2, 3]=>0.0418,
# [3, 4, 2, 1]=>0.0417, [4, 3, 2, 1]=>0.0415, [3, 1, 4, 2]=>0.0419,
# [2, 3, 1, 4]=>0.0420, [4, 2, 3, 1]=>0.0417, [3, 2, 1, 4]=>0.0413,
# [4, 2, 1, 3]=>0.0417, [2, 1, 4, 3]=>0.0419, [1, 3, 2, 4]=>0.0415,
# [1, 2, 4, 3]=>0.0418, [1, 3, 4, 2]=>0.0417, [2, 4, 1, 3]=>0.0414,
# [3, 4, 1, 2]=>0.0412, [1, 4, 3, 2]=>0.0423, [4, 1, 3, 2]=>0.0411,
# [3, 2, 4, 1]=>0.0411, [2, 4, 3, 1]=>0.0418, [3, 1, 2, 4]=>0.0419,
# [4, 3, 1, 2]=>0.0412, [4, 1, 2, 3]=>0.0421, [2, 3, 4, 1]=>0.0421}
avg = (h.values.reduce(:+)/h.size.to_f).round(4)
#=> 0.0417
mn, mx = h.values.minmax
#=> [0.0411, 0.0423]
([avg-mn,mx-avg].max/avg).round(6)
#=> 0.014388
which means that the maximum deviation from the average was only 1.4% percent of the average.
This suggests that the second method is a reasonable way of producing pseudo-random samples.
Initially, the first line of this method was:
a = array.each_index.to_a
By looking at the frequency distribution for outcomes, however, it was clear that that method did not produce a pseudo-random sample; hence, the need to shuffle a.
Here's one possibility:
until array.zip(new_array).reject{ |x, y| x == y }.size == array.size
new_array = array.shuffle
end
Note, though, that it will break for arrays like [1] or [1, 1, 1, 2, 3], where the number of instances of 1 exceeds half the size of the array. Recommend Array#uniq or similar, along with checking for arrays of sizes 0 or 1, depending on how trustworthy your input is!

Average of several Ruby arrays

I have three Ruby arrays:
[1, 2, 3, 4]
[2, 3, 4, 5]
[3, 4, 5, 6]
How can I take the average of all three numbers in position 0, then position 1, etc. and store them in a new array called 'Average'?
a = [1, 2, 3, 4]
b = [2, 3, 4, 5]
c = [3, 4, 5, 6]
a.zip(b,c)
# [[1, 2, 3], [2, 3, 4], [3, 4, 5], [4, 5, 6]]
.map {|array| array.reduce(:+) / array.size }
# => [ 2,3,4,5]
Try this:
arr = ([1, 2, 3, 4] + [3, 4, 5, 6] + [2, 3, 4, 5])
arr.inject(0.0) { |sum, el| sum + el } / arr.size
The concatenation could be done in several ways, depends on how you store your arrays.
As a syntactic sugar, you could do it like this too:
arr.inject(:+).to_f / arr.size

Divide List to pieces of needed length

I was trying to write predicate divide(L,Len,Slist) which will be true when Slist can unify with a List of length Len allocated from List L. for example
divide([1,2,3,4,5,6,7],3,Slist).
Should give such answers
Slist=[1,2,3];
Slist=[2,3,4];
Slist=[3,4,5];
Slist=[4,5,6];
Slist=[5,6,7];
But i couldn't find a better way then length(X,Len), sublist(L,X). but it does work too slow.
How should look divide predicate?
Alternatively you could use DCG as mentionned by #false in this great answer:
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
divide(List, Length, Result) :-
length(Result, Length),
phrase((seq(_), seq(Result), seq(_)), List).
sublist/2 doesn't seems to work as expected:
?- [library(dialect/sicstus/lists)].
% library(dialect/sicstus/lists) compiled into sicstus_lists 0,00 sec, 14 clauses
true.
?- L=[1,2,3,4,5,6], length(T, 3),sublist(T,L).
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 3] ;
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 4] ;
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 5] ;
....
You could use append/3 instead:
?- L=[1,2,3,4,5,6], length(T, 3), append(_, Q, L), append(T, _, Q).
L = [1, 2, 3, 4, 5, 6],
T = [1, 2, 3],
Q = [1, 2, 3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = [2, 3, 4],
Q = [2, 3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = [3, 4, 5],
Q = [3, 4, 5, 6] ;
L = [1, 2, 3, 4, 5, 6],
T = Q, Q = [4, 5, 6] ;
false.
I don't think it's very fast, just essential...

Resources