I already tried to prove that fun bubble_main is ordered but no approach seems to work. Could someone here help me to prove the lemma is_ordered (bubble_main L) please.
I just delete all my previous lemmas because none seems to help Isabelle find a proof.
Here is my code/theory:
text{*check if the list is ordered ascendant*}
fun is_sorted :: "nat list ⇒ bool" where
"is_sorted (x1 # x2 # xs) = (x1 < x2 ∧ is_sorted (x2 # xs))" |
"is_sorted x = True"
fun bubble_once :: "nat list ⇒ nat list" where
"bubble_once (x1 # x2 # xs) = (if x1 < x2
then x1 # bubble_once (x2 # xs)
else x2 # bubble_once (x1 # xs))" |
"bubble_once xs = xs"
text{*calls fun bubble_once *}
fun bubble_all where
"bubble_all 0 L = L"|
"bubble_all (Suc n) L = burbuja_all n (bubble_once L)"
text{*main function *}
fun bubble_main where
"bubble_main L = bubble_main (length L) L"
text{*-----prove by induction-----*}
lemma "is_sorted (bubble_main L)"
apply (induction L)
apply auto
quickcheck
oops
First of all, I would repair your definitions. E.g., using your version
of is_sorted is too strict in the sense, that [0,0] is not sorted. This
is also detected by quick check.
fun is_sorted :: "nat list ⇒ bool" where
"is_sorted (x1 # x2 # xs) = (x1 <= x2 ∧ is_sorted (x2 # xs))" |
"is_sorted x = True"
bubble_all has to call itself recursively.
fun bubble_all where
"bubble_all 0 L = L"|
"bubble_all (Suc n) L = bubble_all n (bubble_once L)"
and bubble_main has to invoke bubble_all.
fun bubble_main where
"bubble_main L = bubble_all (length L) L"
Then there are several auxiliary lemmas required to prove the result.
Some I listed here, others are visible in the sorry's.
lemma length_bubble_once[simp]: "length (bubble_once L) = length L"
by (induct rule: bubble_once.induct, auto)
lemma is_sorted_last: assumes "⋀ x. x ∈ set xs ⟹ x ≤ y"
and "is_sorted xs"
shows "is_sorted (xs # [y])" sorry
And of course, the main algorithm is bubble_all, so you should prove
the property for bubble_all, not for bubble_main inductively.
Moreover, an induction over the length of the list (or the number of iterations)
is advantageous here, since the list is changed by bubble_all in the recursive call.
lemma bubble_all_sorted: "n ≥ length L ⟹ is_sorted (bubble_all n L)"
proof (induct n arbitrary: L)
case (0 L) thus ?case by auto
next
case (Suc n L)
show ?case
proof (cases "L = []")
case True
from Suc(1)[of L] True
show ?thesis by auto
next
case False
let ?BL = "bubble_once L"
from False have "length ?BL ≠ 0" by auto
hence "?BL ≠ []" by (cases "?BL", auto)
hence "?BL = butlast ?BL # [last ?BL]" by auto
then obtain xs x where BL: "?BL = xs # [x]" ..
from BL have x_large: "⋀ y. y ∈ set xs ⟹ y ≤ x" sorry
from Suc(2) have "length ?BL ≤ Suc n" by auto
with BL have "length xs ≤ n" by auto
from Suc(1)[OF this] have sorted: "is_sorted (bubble_all n xs)" .
from x_large have id: "bubble_all n (xs # [x]) = bubble_all n xs # [x]" sorry
show ?thesis unfolding bubble_all.simps BL id
proof (rule is_sorted_last[OF x_large sorted])
fix x
assume "x ∈ set (bubble_all n xs)"
thus "x ∈ set xs" sorry
qed
qed
qed
The final theorem is then easily achieved.
lemma "is_sorted (bubble_main L)"
using bubble_all_sorted by simp
I hope, this helps a bit to see the direction what is required.
Related
I want to do something like this
int n=0
for(int i=xs; i<xe; i++){
for(int j=ys; j<ye; j++){
n++
}
}
return n;
in Clojure way. Since all values are immutable, I think the value n should be passed as a parameter of a (possibly) recursive function. What is the best way to do so?
the closest to your code would be
(defn f [xs xe ys ye]
(let [n (atom 0)]
(doseq [_ (range xs xe)
_ (range ys ye)]
(swap! n inc))
#n))
user> (f 1 10 2 20)
;;=> 162
but the mutable atom approach is unidiomatic at all.
it could look like this, a bit more clojure way:
(defn f [xs xe ys ye]
(count (for [_ (range xs xe)
_ (range ys ye)]
nil)))
#'user/f
user> (f 1 10 2 20)
;;=> 162
it really depends on what you're trying to do. Counting n's is obviously done better by (* (- xe xs) (- ye ys)) , as #jas noticed, independent from what language you use )
what about recursive solution you mentioned, it could look like this:
(defn f [xs xe ys ye]
(loop [n 0 i xs j ys]
(cond (== j ye) n
(== i xe) (recur n xs (inc j))
:else (recur (inc n) (inc i) j))))
#'user/f
user> (f 1 10 2 20)
;;=> 162
Don't over-think the problem. When you really need mutable state, you can always use an atom:
(defn calc
[xs ys]
(let [result (atom 0)]
(doseq [x xs]
(doseq [y ys]
(swap! result + (* x y))))
#result))
(let [xs [1 2 3]
ys [2 5 7 9]]
(calc xs ys))
with result
(calc xs ys) => 138
You could also use a volatile. It is like a non-thread-safe atom. Note the use of vswap!:
(defn calc
[xs ys]
(let [result (volatile! 0)]
(doseq [x xs]
(doseq [y ys]
(vswap! result + (* x y))))
#result))
Performance
In a tight loop, using a volatile makes a difference. An example:
(ns tst.demo.core
(:use tupelo.core tupelo.test)
(:require [tupelo.profile :as prof]))
(def N 100)
(def vals (vec (range N)))
(prof/defnp summer-atom []
(let [result (atom 0)]
(doseq [i vals]
(doseq [j vals]
(doseq [k vals]
(swap! result + i j k))))
#result))
(prof/defnp summer-volatile []
(let [result (volatile! 0)]
(doseq [i vals]
(doseq [j vals]
(doseq [k vals]
(vswap! result + i j k))))
#result))
(dotest
(prof/timer-stats-reset)
(dotimes [i 10]
(spyx (summer-atom))
(spyx (summer-volatile)))
(prof/print-profile-stats))
with result:
--------------------------------------
Clojure 1.10.2-alpha1 Java 15
--------------------------------------
Testing tst.demo.core
(summer-atom) => 148500000
(summer-volatile) => 148500000
...
---------------------------------------------------------------------------------------------------
Profile Stats:
Samples TOTAL MEAN SIGMA ID
10 2.739 0.273879 0.023240 :tst.demo.core/summer-atom
10 0.383 0.038313 0.041246 :tst.demo.core/summer-volatile
---------------------------------------------------------------------------------------------------
So it makes about a 10x difference. Probably not worthwhile unless you are doing at least a million operations like here (100^3).
For similar low-level operations on data structures, please see transient! and friends.
Especially bookmark the Clojure CheatSheet from this list
I think here you can apply reduce function over for. What you do inside loop-processing-fn is up to you - it can be recursive as well.
(let [n-init 0 ;; your `n` variable
xs 10 xe 20 ys -5 ye 5 ;; loop(s) ranges
loop-processing-fn (fn [current-state [i j :as loop-data]]
(inc current-state) ;; anything here
) ;; processing function operating on state (n) and loop data
]
(reduce loop-processing-fn n-init (for [i (range xs xe)
j (range ys ye)]
[i j])))
;; => 100
Macros come to mind. I defined a macro for-state that I use like this:
(def xs 0)
(def xe 9)
(def ys 1)
(def ye 4)
(for-state
i xs (< i xe) (inc i) n 0
(for-state
j ys (< j ye) (inc j) n n
(inc n)))
;; => 27
Macros let you add new constructs that are hard to build using just functions. So if you have several nested loops of this kind, defining a macro like for-state could be an option:
(defmacro for-state [iter-var iter-init iter? iter-next
state-var state-init state-next]
`(loop [~iter-var ~iter-init
~state-var ~state-init]
(if ~iter?
(recur ~iter-next
~state-next)
~state-var)))
You can tweak it as you please. For example, you could group the macro arguments using vectors and do destructuring of those arguments to facilitate readability.
Given the 2x2 unitary matrix representation of an operation to apply to a single qubit, how do I figure out the rotation it corresponds to on the Bloch sphere?
For example, the Hadamard matrix is a 180 degree rotation around the X+Z axis. How do I get from [[1,1],[1,-1]]*sqrt(0.5) to (X+Z, 180 deg)?
Single-qubit operations are basically just unit quaternions, but with an extra phase factor. The similarity is because the Pauli matrices, times sqrt(-1), satisfy the i^2=j^2=k^2=ijk=-1 relation that defines quaternions.
As a result, the hard part of the conversion method is already taken care of by any "quaternion to axis angle" code. Just pull out the phased quaternion components, figure out the phase factor, then apply the quaternion-to-angle-axis method.
import math
import cmath
def toBlochAngleAxis(matrix):
"""
Breaksdown a matrix U into axis, angle, and phase_angle components satisfying
U = exp(i phase_angle) (I cos(angle/2) - axis sigma i sin(angle/2))
:param matrix: The 2x2 unitary matrix U
:return: The breakdown (axis(x, y, z), angle, phase_angle)
"""
[[a, b], [c, d]] = matrix
# --- Part 1: convert to a quaternion ---
# Phased components of quaternion.
wp = (a + d) / 2.0
xp = (b + c) / 2.0j
yp = (b - c) / 2.0
zp = (a - d) / 2.0j
# Arbitrarily use largest value to determine the global phase factor.
phase = max([wp, xp, yp, zp], key=abs)
phase /= abs(phase)
# Cancel global phase factor, recovering quaternion components.
w = complex(wp / phase).real
x = complex(xp / phase).real
y = complex(yp / phase).real
z = complex(zp / phase).real
# --- Part 2: convert from quaternion to angle-axis ---
# Floating point error may have pushed w outside of [-1, +1]. Fix that.
w = min(max(w, -1), +1)
# Recover angle.
angle = -2*math.acos(w)
# Normalize axis.
n = math.sqrt(x*x + y*y + z*z);
if n < 0.000001:
# There's an axis singularity near angle=0.
# Just default to no rotation around the Z axis in this case.
angle = 0
x = 0
y = 0
z = 1
n = 1
x /= n
y /= n
z /= n
# --- Part 3: (optional) canonicalize ---
# Prefer angle in [-pi, pi]
if angle <= -math.pi:
angle += 2*math.pi
phase *= -1
# Prefer axes that point positive-ward.
if x + y + z < 0:
x *= -1
y *= -1
z *= -1
angle *= -1
phase_angle = cmath.polar(phase)[1]
return (x, y, z), angle, phase_angle
Testing it out:
print(toBlochAngleAxis([[1, 0], [0, 1]])) # Identity
# ([0, 0, 1], 0, 0.0)
print(toBlochAngleAxis([[0, 1], [1, 0]])) # Pauli X, 180 deg around X
# ([1.0, -0.0, -0.0], 3.141592653589793, 1.5707963267948966)
print(toBlochAngleAxis([[0, -1j], [1j, 0]])) # Pauli Y, 180 deg around Y
# ([-0.0, 1.0, -0.0], 3.141592653589793, 1.5707963267948966)
print(toBlochAngleAxis([[1, 0], [0, -1]])) # Pauli Z, 180 deg around Z
# ([-0.0, -0.0, 1.0], 3.141592653589793, 1.5707963267948966)
s = math.sqrt(0.5)
print(toBlochAngleAxis([[s, s], [s, -s]])) # Hadamard, 180 deg around X+Z
# ([0.7071067811865476, -0.0, 0.7071067811865476], 3.141592653589793, 1.5707963267948966)
print(toBlochAngleAxis([[s, s*1j], [s*1j, s]])) # -90 deg X axis, no phase
# ((1.0, 0.0, 0.0), -1.5707963267948966, 0.0)
How to write arity-generic functions in Agda? Is it possible to write fully dependent and universe polymorphic arity-generic functions?
I'll take an n-ary composition function as an example.
The simplest version
open import Data.Vec.N-ary
comp : ∀ n {α β γ} {X : Set α} {Y : Set β} {Z : Set γ}
-> (Y -> Z) -> N-ary n X Y -> N-ary n X Z
comp 0 g y = {!!}
comp (suc n) g f = {!!}
Here is how N-ary is defined in the Data.Vec.N-ary module:
N-ary : ∀ {ℓ₁ ℓ₂} (n : ℕ) → Set ℓ₁ → Set ℓ₂ → Set (N-ary-level ℓ₁ ℓ₂ n)
N-ary zero A B = B
N-ary (suc n) A B = A → N-ary n A B
I.e. comp receives a number n, a function g : Y -> Z and a function f, which has the arity n and the resulting type Y.
In the comp 0 g y = {!!} case we have
Goal : Z
y : Y
g : Y -> Z
hence the hole can be easily filled by g y.
In the comp (suc n) g f = {!!} case, N-ary (suc n) X Y reduces to X -> N-ary n X Y and N-ary (suc n) X Z reduces to X -> N-ary n X Z. So we have
Goal : X -> N-ary n X Z
f : X -> N-ary n X Y
g : Y -> Z
C-c C-r reduces the hole to λ x -> {!!}, and now Goal : N-ary n X Z, which can be filled by comp n g (f x). So the whole definition is
comp : ∀ n {α β γ} {X : Set α} {Y : Set β} {Z : Set γ}
-> (Y -> Z) -> N-ary n X Y -> N-ary n X Z
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
I.e. comp receives n arguments of type X, applies f to them and then applies g to the result.
The simplest version with a dependent g
When g has type (y : Y) -> Z y
comp : ∀ n {α β γ} {X : Set α} {Y : Set β} {Z : Y -> Set γ}
-> ((y : Y) -> Z y) -> (f : N-ary n X Y) -> {!!}
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
what should be there in the hole? We can't use N-ary n X Z as before, because Z is a function now. If Z is a function, we need to apply it to something, that has type Y. But the only way to get something of type Y is to apply f to n arguments of type X. Which is just like our comp but only at the type level:
Comp : ∀ n {α β γ} {X : Set α} {Y : Set β}
-> (Y -> Set γ) -> N-ary n X Y -> Set (N-ary-level α γ n)
Comp 0 Z y = Z y
Comp (suc n) Z f = ∀ x -> Comp n Z (f x)
And comp then is
comp : ∀ n {α β γ} {X : Set α} {Y : Set β} {Z : Y -> Set γ}
-> ((y : Y) -> Z y) -> (f : N-ary n X Y) -> Comp n Z f
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
A version with arguments with different types
There is the "Arity-generic datatype-generic programming" paper, that describes, among other things, how to write arity-generic functions, that receive arguments of different types. The idea is to pass a vector of types as a parameter and fold it pretty much in the style of N-ary:
arrTy : {n : N} → Vec Set (suc n) → Set
arrTy {0} (A :: []) = A
arrTy {suc n} (A :: As) = A → arrTy As
However Agda is unable to infer that vector, even if we provide its length. Hence the paper also provides an operator for currying, which makes from a function, that explicitly receives a vector of types, a function, that receives n implicit arguments.
This approach works, but it doesn't scale to fully universe polymorphic functions. We can avoid all these problems by replacing the Vec datatype with the _^_ operator:
_^_ : ∀ {α} -> Set α -> ℕ -> Set α
A ^ 0 = Lift ⊤
A ^ suc n = A × A ^ n
A ^ n is isomorphic to Vec A n. Then our new N-ary is
_->ⁿ_ : ∀ {n} -> Set ^ n -> Set -> Set
_->ⁿ_ {0} _ B = B
_->ⁿ_ {suc _} (A , R) B = A -> R ->ⁿ B
All types lie in Set for simplicity. comp now is
comp : ∀ n {Xs : Set ^ n} {Y Z : Set}
-> (Y -> Z) -> (Xs ->ⁿ Y) -> Xs ->ⁿ Z
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
And a version with a dependent g:
Comp : ∀ n {Xs : Set ^ n} {Y : Set}
-> (Y -> Set) -> (Xs ->ⁿ Y) -> Set
Comp 0 Z y = Z y
Comp (suc n) Z f = ∀ x -> Comp n Z (f x)
comp : ∀ n {Xs : Set ^ n} {Y : Set} {Z : Y -> Set}
-> ((y : Y) -> Z y) -> (f : Xs ->ⁿ Y) -> Comp n Z f
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
Fully dependent and universe polymorphic comp
The key idea is to represent a vector of types as nested dependent pairs:
Sets : ∀ {n} -> (αs : Level ^ n) -> ∀ β -> Set (mono-^ (map lsuc) αs ⊔ⁿ lsuc β)
Sets {0} _ β = Set β
Sets {suc _} (α , αs) β = Σ (Set α) λ X -> X -> Sets αs β
The second case reads like "there is a type X such that all other types depend on an element of X". Our new N-ary is trivial:
Fold : ∀ {n} {αs : Level ^ n} {β} -> Sets αs β -> Set (αs ⊔ⁿ β)
Fold {0} Y = Y
Fold {suc _} (X , F) = (x : X) -> Fold (F x)
An example:
postulate
explicit-replicate : (A : Set) -> (n : ℕ) -> A -> Vec A n
test : Fold (Set , λ A -> ℕ , λ n -> A , λ _ -> Vec A n)
test = explicit-replicate
But what are the types of Z and g now?
comp : ∀ n {β γ} {αs : Level ^ n} {Xs : Sets αs β} {Z : {!!}}
-> {!!} -> (f : Fold Xs) -> Comp n Z f
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
Recall that f previously had type Xs ->ⁿ Y, but Y now is hidden in the end of these nested dependent pairs and can depend on an element of any X from Xs. Z previously had type Y -> Set γ, hence now we need to append Set γ to Xs, making all xs implicit:
_⋯>ⁿ_ : ∀ {n} {αs : Level ^ n} {β γ}
-> Sets αs β -> Set γ -> Set (αs ⊔ⁿ β ⊔ γ)
_⋯>ⁿ_ {0} Y Z = Y -> Z
_⋯>ⁿ_ {suc _} (_ , F) Z = ∀ {x} -> F x ⋯>ⁿ Z
OK, Z : Xs ⋯>ⁿ Set γ, what type has g? Previously it was (y : Y) -> Z y. Again we need to append something to nested dependent pairs, since Y is again hidden, only in a dependent way now:
Πⁿ : ∀ {n} {αs : Level ^ n} {β γ}
-> (Xs : Sets αs β) -> (Xs ⋯>ⁿ Set γ) -> Set (αs ⊔ⁿ β ⊔ γ)
Πⁿ {0} Y Z = (y : Y) -> Z y
Πⁿ {suc _} (_ , F) Z = ∀ {x} -> Πⁿ (F x) Z
And finally
Comp : ∀ n {αs : Level ^ n} {β γ} {Xs : Sets αs β}
-> (Xs ⋯>ⁿ Set γ) -> Fold Xs -> Set (αs ⊔ⁿ γ)
Comp 0 Z y = Z y
Comp (suc n) Z f = ∀ x -> Comp n Z (f x)
comp : ∀ n {β γ} {αs : Level ^ n} {Xs : Sets αs β} {Z : Xs ⋯>ⁿ Set γ}
-> Πⁿ Xs Z -> (f : Fold Xs) -> Comp n Z f
comp 0 g y = g y
comp (suc n) g f = λ x -> comp n g (f x)
A test:
length : ∀ {α} {A : Set α} {n} -> Vec A n -> ℕ
length {n = n} _ = n
explicit-replicate : (A : Set) -> (n : ℕ) -> A -> Vec A n
explicit-replicate _ _ x = replicate x
foo : (A : Set) -> ℕ -> A -> ℕ
foo = comp 3 length explicit-replicate
test : foo Bool 5 true ≡ 5
test = refl
Note the dependency in the arguments and the resulting type of explicit-replicate. Besides, Set lies in Set₁, while ℕ and A lie in Set — this illustrates universe polymorphism.
Remarks
AFAIK, there is no comprehensible theory for implicit arguments, so I don't know, how all this stuff will work, when the second function (i.e. f) receives implicit arguments. This test:
foo' : ∀ {α} {A : Set α} -> ℕ -> A -> ℕ
foo' = comp 2 length (λ n -> replicate {n = n})
test' : foo' 5 true ≡ 5
test' = refl
is passed at least.
comp can't handle functions, if the universe, where some type lies, depends on a value. For example
explicit-replicate' : ∀ α -> (A : Set α) -> (n : ℕ) -> A -> Vec A n
explicit-replicate' _ _ _ x = replicate x
... because this would result in an invalid use of Setω ...
error : ∀ α -> (A : Set α) -> ℕ -> A -> ℕ
error = comp 4 length explicit-replicate'
But it's common for Agda, e.g. you can't apply explicit id to itself:
idₑ : ∀ α -> (A : Set α) -> A -> A
idₑ _ _ x = x
-- ... because this would result in an invalid use of Setω ...
error = idₑ _ _ idₑ
The code.
Let f : {0, 1}ⁿ → {0, 1}ⁿ be a 4-to-1 function, such that there exist
distinct and non-zero a, b ∈ {0, 1}ⁿ such that for all x ∈ {0, 1}ⁿ:
f(x) = f(x ⊕ a) = f(x ⊕ b) = f(x ⊕ a ⊕ b).
Note that ⊕ is a bit-wise xor, and that for all y ∉ {x, x ⊕ a, x ⊕ b, x ⊕ a ⊕ b}, f(y) ≠ f(x). Find
a quantum algorithm that with high probability reports the set {a, b, a ⊕ b}.
Well, choosing x to be 0 gives f(0) = f(a) = f(b) = f(a xor b). And there are no other inputs that match f(0). So we're just looking for v satisfying v != 0, f(v) = f(0). So make a circuit that takes a v and inverts phase when it satisfies else does nothing otherwise. Then apply grover's algorithm. The running time would be O(sqrt(N)) to find the first value. Then you repeat with it conditioned out as well.
On the other hand, just classically sampling at random until you find a collision also has expected time O(sqrt(N)) so there's probably something even more clever you can do.
At the moment I'm trying to do a minimization (optimization) problem in R, where I have a vector X1 that I want to approximate through a weighted average of a matrix X2 and a vector of weights w. That means I want to minimize
wg <- function(w)
{
t(X1 - X2 %*% w) %*% (X1 - X2 %*% w)
}
the constraints on the weights are w[i]>= 0 and sum(w) = 1 .
At the moment I'm using the DEoptim package to do my optimization, but I feel like it can't deal well with corner solutions.
I'm replicating a method that was used in an economics paper and in that paper almost all of the weights turned out to be zero. I expected a similar result in my case ( I want to model Arizona through a weighted average of the other states), especially due to the heterogeneity in the economic situation.
At the moment I feel like it's more of a problem with the DEoptim package than with my methodology and I don't really trust the results. Which other package can I use, preferrably ones that are stronger in looking for corner solutions?
my DEoptim is set up as follows:
controlDE <- list(reltol=.0000000001,steptol=150, itermax = 5000,trace = 250)
#control parameters
outDEoptim <- DEoptim(fn = wg, lower = rep(0, N), upper = rep(1, N),
control = controlDE)
Any help would be much appreciated!
A stochastic solver such as DEoptim will by nature have difficulties finding optimal solutions on lower dimensional subsets such as the one defined by sum(w) = 1.
There is a first, not quite correct way of doing this by reducing the problem to (n-1) dimensions by setting w <- c(w, 1-sum(w)). The last component might get less than 0, but normally it won't. Now apply DEoptim or optim:
set.seed(1357); m <- 4; n <- 5
X2 <- round(matrix(runif(20), m, n), 2)
X1 <- X2 %*% c(0, 1, 0, 0, 0) # solution c(0,1,0,0,0)
wg <- function(w) { # length(w) == 4
w <- c(w, 1 - sum(w))
t(X1 - X2 %*% w) %*% (X1 - X2 %*% w) # sum((X1 - X2 %*% w)^2)
}
w0 <- rep(1/n, n-1) # initial point (1/n, ..., 1/n)
optim(w0, wg, lower = rep(0, n), upper = rep(1, n),
method = "L-BFGS-B", control = list(factr = 1e-8))
## $par
## [1] 0 1 0 0 # wmin = c(0,1,0,0,0)
Or you apply one of the solvers in R that can handle equality constraints, for example Rdonlp2 (on R-Forge), auglag in package alabama, or slsqp in package nloptr. But I feel this would be overshooting.