DPLL algorithm procedure - algorithm

I am trying to understand DPLL procedure before actually coding it.
For example, I have these clauses:
C1 : {c, !d, !b}
C2 : {d, a}
C3: {b, !d, !a}
C4: {d, c, b, a}
C5: {c, !d, !b}
C6: {d, c, b}
C7: {c}
Now I take the decision variable as d = 0, b = 0. The clause looks like this now.
C1: {c, 1, 1}
C2: {a}
C3: {1, !a}
C4: {c, a}
C5: {c, 1, 1}
C6: {c}
C7: {c}
How do unit propagation and pure literal rule play a part here?
Also, in C3 : {1, !a} - when I take a = 1, then this becomes {1, 0}. What should be the final value for this clause? Should it be {1}?
And if any clause has value {!b}, that is a negation of a literal, after applying the decision variable, then how to proceed?

That step wouldn't have happened that way, because there were unit clauses in the input which would have been resolved first.
{ c } (the clause) is a unit and its literal c is positive, therefore c (the variable) is forced to be 1, then we have
C2 : {d, a}
C3: {b, !d, !a}
as active clauses, because true clauses are ignored.
Now b is a pure literal (it wasn't always, but it became one since some clauses are not active anymore), but practical SAT solvers usually don't check for that except during pre-processing since it can't be checked efficiently.
And finally you would set d or a or both it doesn't matter.

Related

How to multiply Column vector by Row vector in Mathematica?

I want to multiply every value in a column vector by the same vector but transposed to row. The output should be a multiplication table matrix. Like the third example in this picture.
I tried multiplying a column vector by its transposed form but Mathematica only gives me this which is not a Matrix.
Bryan,
You need to use Dot, not Times. See docs.
m = {{a}, {b}, {c}}
m.Transpose[m]
{{a^2, a b, a c}, {a b, b^2, b c}, {a c, b c, c^2}}
You might inappropriately define row vectors and column vectors. Try this:
rowvec={{a,b,c}};
colvec={{d},{e},{f}};
Then the command dot will give both inner product and outer product correctly.
rowvec.colvec
output: {{a d + b e + c f}}
colvec.rowvec
output: {{a d, b d, c d}, {a e, b e, c e}, {a f, b f, c f}}

Mathematica: FindFit for NIntegrate of ParametricNDSolve

I`ve seen several answers for quite similar topics with usage of ?NumericQ explained and still can not quite understand what is wrong with my implementation and could my example be evaluated at all the way I want it.
I have solution of differential equation in form of ParametricNDSolve (I believe that exact form of equation is irrelevant):
sol = ParametricNDSolve[{n'[t] == g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2, n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
After that I am trying to construct a function for FindFit or similar procedure, Nintegrating over function n[a,b,c,g,f,y,t] I have got above with some multiplier (I have chosen Log[z] as multiplier for simplicity)
Func[z_, a_, b_, c_, g_, f_] :=
NIntegrate[
Log[z]*(n[a, b, c, g, f, y][t] /. sol), {t, 0, 10}, {y, 0, Log[z]}]
So I have NIntegrate over my function n[params,t] derived from ParametricNDSolve with multiplier introducing new variable (z) wich also present in the limits of integration (in the same form as in multiplier for simplicity of example)
I am able to evaluate the values of my function Func at any point (z) with given values of parameters (a,b,c,g,f): Func(0,1,2,3,4,5) could be evaluated.
But for some reasons I cannot use FindFit like that:
FindFit[data, Func[z, a, b, c, g, f], {a, b, c, g, f}, z]
The error is: NIntegrate::nlim: y = Log[z] is not a valid limit of integration.
I`ve tried a lot of different combinations of ?NumericQ usage and all seems to lead nowhere. Any help would be appreciated!
Thanks in advance and sorry for pure english in the problem explanation.
Here is a way to define your function:
sol = n /.
ParametricNDSolve[{n'[t] ==
g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2,
n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
Func[z_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ, g_?NumericQ,
f_?NumericQ] :=
NIntegrate[Log[z]*sol[a, b, c, g, f, y][t],
{t, 0, 10}, {y, 0, Log[z]}]
test: Func[2, .45, .5, .13, .12, .2] -> 0.106107
I'm not optimistic you will get good results from FindFit with a function with so many parameters and which is so computationally expensive.

Time efficient Partial Inverted Index building

I need to build a partial Inverted Index. Something like:
l = {{x, {h, a, b, c}}, {y, {c, d, e}}}
iI[l]
(*
-> {{a, {x}}, {b, {x}}, {c, {x, y}}, {d, {y}}, {e, {y}}, {h, {x}}}
*)
I think it is pretty clear what it does. In the input list, the {x, y ...} are unique, while the {a, b, c, ..} are not. The output ought to be ordered by #[[1]].
Right now, I am doing this:
iI[list_List] := {#, list[[Position[list, #][[All, 1]]]][[All, 1]]} & /#
(Union#Flatten#Last#Transpose#list)
But it looks too convoluted for such an easy task, seems too slow, and I should be able to cope with Legion.
A test drive to compare your results:
words = DictionaryLookup[];
abWords = DictionaryLookup["ab" ~~ ___];
l = {#, RandomChoice[abWords, RandomInteger[{1, 30}]]} & /# words[[1 ;; 3000]];
First#Timing#iI[l]
(*
-> 5.312
*)
So, any ideas for an speedup?
Seems a classic task for Reap-Sow (improvement in the final version due to #Heike):
iI[list_] := Sort[Reap[Sow ### list, _, List][[2]]]
Then,
iI[l]
{{a, {x}}, {b, {x}}, {c, {x, y}}, {d, {y}}, {e, {y}}, {h, {x}}}
and
In[22]:=
words=DictionaryLookup[];
abWords=DictionaryLookup["ab"~~___];
l={#,RandomChoice[abWords,RandomInteger[{1,30}]]}&/#words[[1;;3000]];
First#Timing#iI[l]
Out[25]= 0.047
EDIT
Here is an alternative version with a similar (slightly worse) performance:
iIAlt[list_] :=
Sort#Transpose[{#[[All, 1, 2]], #[[All, All, 1]]}] &#
GatherBy[Flatten[Thread /# list, 1], Last];
It is interesting that Reap - Sow here gives an even slightly faster solution than the one based on structural operations.
EDIT 2
Just for an illustration - for those who prefer rule-based solutions, here is one based on a combination of Dispatch and ReplaceList:
iIAlt1[list_] :=
With[{disp = Dispatch#Flatten[Thread[Rule[#2, #]] & ### list]},
Map[{#, ReplaceList[#, disp]} &, Union ## list[[All, 2]]]]
It is about 2-3 times slower than the other two, though.

Pattern matching Inequality

I'd like to extract arguments from instances of Inequality. Following doesn't work, any idea why and how to fix it?
Inequality[1, Less, x, Less, 2] /. Inequality[a_, _, c_, _, e_] -> {a, c, e}
Inequality[1,Less,x,Less,2] /. HoldPattern[Inequality[a_,_,b_,_,c_]] -> {a, b, c}
Out: {1, x, 2}
Also, you can do this:
Inequality[1, Less, x, Less, 2] /.
Literal # Inequality[ a_ , _ , c_ , _ , e_ ] -> {a, c, e}
ADL
Why don't you use standard access to subexpression?
expr = Inequality[1, Less, x, Less, 2];
{a,c,e} = {expr[[1]], expr[[3]], expr[[5]]};

Multiple assignment between lists in Mathematica 7

Suppose there are two lists a = {a1, a2, a3} and b = {b1, b2, b3}, and I want to write an assignment statement to make a1=b1,a2=b2,a3=b3 which only refers to a and b:
Thread[a = b]
But it only makes a={b1,b2,b3}. Using := (SetDelayed) instead of = doesn't work either.
Any solution? Thanks.
I think the Thread only works on "explicit" lists; the variables need to be expanded before being operated on.
After some experimentation, this works for me:
a = {a1, a2, a3};
b = {b1, b2, b3};
Thread[Set[Evaluate#a, Evaluate#b]];
{a1, a2, a3}
You could also write Thread[Evaluate#a = Evaluate#b]; just depends whichever you find more readable.
What's wrong with
MapThread[Set,{{a1,a2,a3},{b1,b2,b3}}]
?
Here's another solution:
a = {a1, a2, a3};
b = {b1, b2, b3};
each[{x_, y_}, Transpose[{a, b}],
x = y]
Which uses my handy each function:
SetAttributes[each, HoldAll]; (* each[pattern, list, body] *)
each[pat_, lst_, bod_] := (* converts pattern to body for *)
Scan[Replace[#, pat:>bod]&, Evaluate#lst] (* each element of list. *)
Similarly, you can do this:
MapThread[(#1 = #2)&, {a, b}]
Well, if they are really called a1, a2, etc, you could do this:
Assign[x_, y_] := Module[{s1, s2, n, sn},
s1 = SymbolName[Unevaluated[x]];
s2 = SymbolName[Unevaluated[y]];
For[n = 1, n <= Length[x] && n <= Length[y], n++,
sn = ToString[n];
Evaluate[Symbol[s1 <> sn]] = Evaluate[Symbol[s2 <> sn]]
]
]
SetAttributes[Assign, HoldAll]
And then
Clear[b1, b2, b3];
Clear[a1, a2, a3];
a = {a1, a2, a3}
b = {b1, b2, b3}
Assign[a, b]
a
Gives the results for a, b and a again as:
{a1, a2, a3}
{b1, b2, b3}
{b1, b2, b3}
As expected.
In general you can create expressions like these from proper use of SymbolName and Symbol, but be careful with your evaluation. If I had written SymbolName[x] (without the Unevaluated) then it would've interpreted that as SymbolName[{a1, a2, a3}], which is clearly not desirable. Not using Evaluate on Symbol[s1 <> sn] will have Mathematica complain that you're trying to reassign the Symbol function.

Resources