# Function "ktsolve" . This document is copyright 2010 by Carl Witthoft.
# Permission given to copy and modify as desired so long as the document 
# or derivative works are not sold or made part of a commercial product.  
# Please contact the author, carl@witthoft.com, for permission to 
# include in  a specified commercial package.
#
# Definitions:
# known -- list or vector of known values.  The elements must be named
# 	and the names must match variable names in yfunc.
# guess -- list or vector of initial guesses for the unknown values.  S ame rules as for 'known,' AND length(guess) 
# must be same as number  of y[j] equations in yfunc, to avoid over- or under-defined system.
# yfunc -- is a function of the form:
#	 yfunc<-function(x) {
#		y<-vector()
#		y[1]<-f1(x)
#		y[2]<-f2(x)
#		y[length(x)]<-fn(x)
#		y
#		}
# 	where y[j] are dummies which will be driven to zero,
# 	and x[j] is a dummy vector which will be filled in with 'guess'
# So, eqns in the form A=f(x) must be entered as  y[j] <- f(x)-A   
# Example:  d = a + sqrt(b) and a = sin(a/b) + g*exp(f*a)  become
#  y[1]<- a - d +sqrt(b)  and y[2]<- sin(a/b) +g*exp(f*a) -a , 
# and e.g.
# known <- list(a=3,d=5,g=.1)  are the fixed parameters and
# guess <- list(b=1,f=1) are the initializers for BBsolve() .
#
# Oh, and BTW the function name is an homage to my alltime favorite
# app:   TK!Solver
#
ktsolve<-function(yfunc,known,guess){
	require(BB)
# length(body(y)) is one greater than number of lines due to"{}"
# first, assign the 'known' values
for (i in 1:length(known)) {
	if(length(grep(names(known)[i], body(yfunc)[-1]))<1) warning("Input '", names(known)[i], '" not found in func')
# make a search string which distinguishes a variable from part of a string
	lookfor<-paste("\\b",names(known)[i],"\\b",sep="",collapse="")
	parse(text=gsub(lookfor,known[i],body(yfunc)[-1])) -> body(yfunc)[-1]
	}
# Now reconfigure yfunc's body to have x[n] for each 'guess' name
for (i in 1:length(guess)) {
	if(length(grep(names(guess)[i], body(yfunc)[-1]))<1) warning("Guess '", names(guess)[i],"' not found in func")
	subpat<-paste("x\\[",i,"\\]",sep="")
	lookfive<-paste("\\b",names(guess)[i],"\\b",sep="",collapse="")
	parse(text=gsub(lookfive, subpat, body(yfunc)[-1])) -> body(yfunc)[-1]
	}
# are yfunc and guess same length? (yfunc() fails if guess is shorter)
# Also, yfunc() fails if any undefined values, which is helpful
if(length(yfunc(unlist(guess)))<length(guess)) {
	warning("guess is ",length(guess)," long but function is ",length(yfunc(unlist(guess)))," long.")
	}
# call BBsolve with the values in 'guess' 
BBsolve(unlist(guess),yfunc)->bbsolution
#too lazy to make nice formatted table
cat('solution is:\n')
print(bbsolution$par)
cat('"known" inputs were:\n')
print(rbind(known))
outs<-list(bbsolution=bbsolution, yfunc=body(yfunc))
return(invisible(outs))
}