Related
I'm trying to simulate a lottery and have a little problem with my functions. Here's what I'm trying to do:
run window1()
window1() --> destroy_window1() --> window2()
window2() --> destroy window2 or retry() --> window1()
The error occurs when I reach destroy_window1(), where i get the following message: "NameError: name 'e1' is not defined". How can I solve this problem?
I've read that you should pre-define the variables outside the functions. So, I tried to just put e1 = 1 etc., but then i get the message: "AttributeError: 'int' object has no attribute 'get'". Since it's an entry, I don't know how to pre-define it.
from tkinter import*
import random
Part1 = list(range(1,51))
Part2 = list(range(1,11))
Numbers = [0]*7
for n in range (5):
Number = random.choice(Part1)
Position = Part1.index(Number)
del Part1[Position]
Numbers[n] = Number
for i in range (2):
Number = random.choice(Part2)
Position = Part2.index(Number)
del Part2[Position]
Numbers[5+i] = Number
print (Numbers)
def destroy_window1():
global Guess
Guess = [e1.get(), e2.get(), e3.get(), e4.get(), e5.get(), e6.get(), e7.get()]
master1.destroy()
window2()
def retry():
master2.destroy()
window1()
def window1():
master1 = Tk()
master1.title('Lottery')
Label(master1, text="Guess numbers:").grid(row=0)
e1 = Entry(master1, width=2)
e2 = Entry(master1, width=2)
e3 = Entry(master1, width=2)
e4 = Entry(master1, width=2)
e5 = Entry(master1, width=2)
e6 = Entry(master1, width=2)
e7 = Entry(master1, width=2)
e1.grid(row=0, column=1, padx=5)
e2.grid(row=0, column=2, padx=5)
e3.grid(row=0, column=3, padx=5)
e4.grid(row=0, column=4, padx=5)
e5.grid(row=0, column=5, padx=5)
e6.grid(row=0, column=7, padx=5)
e7.grid(row=0, column=8, padx=5)
master1.grid_columnconfigure(6, minsize=20) # Creates an empty column (nr. 6) with width 20
Button(master1, text='OK', command=destroy_window1).grid(row=3, column=3, sticky=W, pady=5)
master1.mainloop()
def window2():
master2 = Tk()
master2.title('Check results')
Label(master2, text="Drawn numbers:").grid(row=0, column=0, sticky=W)
Label(master2, text="Your numbers:").grid(row=1, column=0, sticky=W)
for n in range (7):
Label(master2, text=Numbers[n]).grid(row=0, column=n+1, sticky=W, padx=5)
if str(Numbers[n]) == Guess[n]:
Label(master2, text=Guess[n], bg="green").grid(row=1, column=n+1, sticky=W, padx=5)
else:
Label(master2, text=Guess[n], bg="red").grid(row=1, column=n+1, sticky=W, padx=5)
Button(master2, text='Quit', command=master2.destroy).grid(row=3, column=3, sticky=W, pady=5)
Button(master2, text='Retry', command=retry).grid(row=3, column=4, sticky=W, pady=5)
master2.mainloop ()
window1()
I can't vote up yet, thanks in advance!
The error occurs when I reach destroy_window1(), where i get the following message: "NameError: name 'e1' is not defined". How can I solve this problem?
The problem is that the destroy_window1() function doesn't know about the e1 variable, because e1 is defined within the window1() function (and its not global).
A simple fix is to put all the e variables into a list and pass that list as an argument to the destroy_window1() function. Make the list with a simple for loop, this not only solves your problem, but it also makes your code cleaner, easier to read, and easier to change it's functionality in future.
Like so:
def destroy_window1(e_list):
global Guess
Guess = []
for e_item in e_list:
Guess.append(e_item.get())
master1.destroy()
window2()
def window1():
master1 = Tk()
master1.title('Lottery')
Label(master1, text="Guess numbers:").grid(row=0)
e_list = []
for i in range(7):
temp_e = e1 = Entry(master1, width=2)
temp_e.grid(row=0, column=i, padx=5)
e_list.append(temp_e)
master1.grid_columnconfigure(6, minsize=20) # Creates an empty column (nr. 6) with width 20
Button(master1, text='OK', command=lambda :destroy_window1(e_list)).grid(row=3, column=3, sticky=W, pady=5)
master1.mainloop()
Part of this solution involves a lambda function. This is because (as you may have noticed) the command option normally can't take arguments for the functions. The use of a lambda functions makes this possible. (Read up on Lambda Functions Here)
I have 2 json.rows files with multiple nested data. I tried the below code to convert it into a dataframe and it worked for the first file.
tl <- function(e) { if (is.null(e)) return(NULL); ret <- typeof(e); if (ret == 'list' && !is.null(names(e))) ret <- list(type='namedlist') else ret <- list(type=ret,len=length(e)); ret; };
mkcsv <- function(v) paste0(collapse=',',v);
keyListToStr <- function(keyList) paste0(collapse='','/',sapply(keyList,function(key) if (is.null(key)) '*' else paste0(collapse=',',key)));
extractLevelColumns <- function(
nodes, ## current level node selection
..., ## additional arguments to data.frame()
keyList=list(), ## current key path under main list
sep=NULL, ## optional string separator on which to join multi-element vectors; if NULL, will leave as separate columns
mkname=function(keyList,maxLen) paste0(collapse='.',if (is.null(sep) && maxLen == 1L) keyList[-length(keyList)] else keyList) ## name builder from current keyList and character vector max length across node level; default to dot-separated keys, and remove last index component for scalars
) {
cat(sprintf('extractLevelColumns(): %s\n',keyListToStr(keyList)));
if (length(nodes) == 0L) return(list()); ## handle corner case of empty main list
tlList <- lapply(nodes,tl);
typeList <- do.call(c,lapply(tlList,`[[`,'type'));
if (length(unique(typeList)) != 1L) stop(sprintf('error: inconsistent types (%s) at %s.',mkcsv(typeList),keyListToStr(keyList)));
type <- typeList[1L];
if (type == 'namedlist') { ## hash; recurse
allKeys <- unique(do.call(c,lapply(nodes,names)));
ret <- do.call(c,lapply(allKeys,function(key) extractLevelColumns(lapply(nodes,`[[`,key),...,keyList=c(keyList,key),sep=sep,mkname=mkname)));
} else if (type == 'list') { ## array; recurse
lenList <- do.call(c,lapply(tlList,`[[`,'len'));
maxLen <- max(lenList,na.rm=T);
allIndexes <- seq_len(maxLen);
ret <- do.call(c,lapply(allIndexes,function(index) extractLevelColumns(lapply(nodes,function(node) if (length(node) < index) NULL else node[[index]]),...,keyList=c(keyList,index),sep=sep,mkname=mkname))); ## must be careful to translate out-of-bounds to NULL; happens automatically with string keys, but not with integer indexes
} else if (type%in%c('raw','logical','integer','double','complex','character')) { ## atomic leaf node; build column
lenList <- do.call(c,lapply(tlList,`[[`,'len'));
maxLen <- max(lenList,na.rm=T);
if (is.null(sep)) {
ret <- lapply(seq_len(maxLen),function(i) setNames(data.frame(sapply(nodes,function(node) if (length(node) < i) NA else node[[i]]),...),mkname(c(keyList,i),maxLen)));
} else {
## keep original type if maxLen is 1, IOW don't stringify
ret <- list(setNames(data.frame(sapply(nodes,function(node) if (length(node) == 0L) NA else if (maxLen == 1L) node else paste(collapse=sep,node)),...),mkname(keyList,maxLen)));
}; ## end if
} else stop(sprintf('error: unsupported type %s at %s.',type,keyListToStr(keyList)));
if (is.null(ret)) ret <- list(); ## handle corner case of exclusively empty sublists
ret;
}; ## end extractLevelColumns()
## simple interface function
flattenList <- function(mainList,...) do.call(cbind,extractLevelColumns(mainList,...));
but when i tried using the above function for my second file, I kept getting an error which said
Error in extractLevelColumns(lapply(nodes, `[[`, key), ..., keyList = c(keyList, :
error: inconsistent types (character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,character,cha
Here are a few sample images of the rows in my json file. The columns are very inconsistent.
https://i.stack.imgur.com/ZKgKk.png
https://i.stack.imgur.com/f3kNS.png
I know it's an old question but I recently faced a similar error while working with a nested list. Your error is because the function doesn't support the type inconsistencies between parallel nodes. So, one or more of your nodes have non-character type elements - either NULL or a list.
If it's NULL, you can convert the NULL to "NA" and it should work fine. If it's a list, unfortunately I couldn't make it work without throwing away information. I removed the node with type list and it worked.
I am currently writing a script that downloads a bunch of .csv's from a FTP server, and then puts each .csv in a MySQL database as its own table.
I download the .csv's from the FTP using RCurl and place all of the .csv's in my working directory. To create tables out of each .csv, I am using the sqlSave function from the RODBC package, where the table name is the same name as the .csv. This works fine whenever a .csv name is less than 18 characters, but when it is greater it fails. And by "fails", I mean R crashes. To track down the bug, I called debug on sqlSave.
I found that there are at least two functions that sqlSave calls that cause R to crash. The first is RODBC:::odbcTableExists, which is a non-visible function. Here is the code for the function:
RODBC:::odbcTableExists
function (channel, tablename, abort = TRUE, forQuery = TRUE,
allowDot = attr(channel, "interpretDot"))
{
if (!odbcValidChannel(channel))
stop("first argument is not an open RODBC channel")
if (length(tablename) != 1)
stop(sQuote(tablename), " should be a name")
tablename <- as.character(tablename)
switch(attr(channel, "case"), nochange = {
}, toupper = tablename <- toupper(tablename), tolower = tablename <- tolower(tablename))
isExcel <- odbcGetInfo(channel)[1L] == "EXCEL"
hasDot <- grepl(".", tablename, fixed = TRUE)
if (allowDot && hasDot) {
parts <- strsplit(tablename, ".", fixed = TRUE)[[1]]
if (length(parts) > 2)
ans <- FALSE
else {
res <- if (attr(channel, "isMySQL"))
sqlTables(channel, catalog = parts[1], tableName = parts[2])
else sqlTables(channel, schema = parts[1], tableName = parts[2])
ans <- is.data.frame(res) && nrow(res) > 0
}
}
else if (!isExcel) {
res <- sqlTables(channel, tableName = tablename)
ans <- is.data.frame(res) && nrow(res) > 0
}
else {
res <- sqlTables(channel)
tables <- stables <- if (is.data.frame(res))
res[, 3]
else ""
if (isExcel) {
tables <- sub("^'(.*)'$", "\\1", tables)
tables <- unique(c(tables, sub("\\$$", "", tables)))
}
ans <- tablename %in% tables
}
if (abort && !ans)
stop(sQuote(tablename), ": table not found on channel")
enc <- attr(channel, "encoding")
if (nchar(enc))
tablename <- iconv(tablename, to = enc)
if (ans && isExcel) {
dbname <- if (tablename %in% stables)
tablename
else paste(tablename, "$", sep = "")
if (forQuery)
paste("[", dbname, "]", sep = "")
else dbname
}
else if (ans) {
if (forQuery && !hasDot)
quoteTabNames(channel, tablename)
else tablename
}
else character(0L)
}
This fails here when the table name over 18 characters in length:
res <- sqlTables(channel, tableName = tablename)
I have fixed it by changing this to:
res <- sqlTables(channel, tablename)
I then reassign the function with the same name (odbcTableExists) in the namespace with this code change using assignInNamepace.
RODBC:::odbcTableExists no longer causes an issue. However, R still crashes when sqlwrite is called from within sqlSave(). I called debug on sqlwrite, and I found that RODBC:::odbcColumns (another non-visible function) causes that to crash when tablenames are too long. Unfortunately, I am not sure how to change RODBC:::odbcColumns to avoid the bug like I did before.
I am using R 2.15.1, and the platform is :x86_64-pc-ming32/x64 (64-bit). I should also note that I am trying to run this on a work computer, but if I run the exact same code on my personal computer, R does not crash (no bug). The work computer runs windows 7 professional, and my home computer runs windows 7 home premium with R 2.14.1.
I love this hack (I too have Windows 7 Professional at R 2.15.1 at work), and it does not crash anymore, but it causes another problem after I replaced that line and used assignInNamespace; also for some reason I had to replace odbcValidChannel with RODBC:::odbcValidChannel and quoteTabNames with RODBC:::quoteTabNames
But when I used sqlSave, I got the following error:
Error in odbcUpdate(channel, query, mydata, coldata[m, ], test = test, :
no parameters, so nothing to update
I don't even use odbcUpdate anywhere in the code, and the RODBC::: sqlSave does not have the odbcUpdate call inside.
Any thoughts?
thank you,
-Alex
I like to use a progress bar while running slow for loops. This could be done easily with several helpers, but I do like the tkProgressBar from tcltk package.
A small example:
pb <- tkProgressBar(title = "Working hard:", min = 0, max = length(urls), width = 300)
for (i in 1:300) {
# DO SOMETHING
Sys.sleep(0.5)
setTkProgressBar(pb, i, label=paste( round(i/length(urls)*100, 0), "% ready!"))
}
close(pb)
And I would like to set up a small function to store in my .Rprofile named to forp (as: for loop with progressbar), to call just like for but with auto added progress bar - but unfortunately have no idea how to implement and grab the expr part of the loop function. I had some experiments with do.call but without success :(
Imaginary working example (which acts like a for loop but creates a TkProgressBar and auto updates it in each iteration):
forp (i in 1:10) {
#do something
}
UPDATE: I think the core of the question is how to write a function which not only has parameters in the parentheses after the function (like: foo(bar)), but also can handle expr specified after the closing parentheses, like: foo(bar) expr.
BOUNTY OFFER: would go to any answer that could modify my suggested function to work like the syntax of basic for loops. E.g. instead of
> forp(1:1000, {
+ a<-i
+ })
> a
[1] 1000
it could be called like:
> forp(1:1000) {
+ a<-i
+ }
> a
[1] 1000
Just to clarify the task again: how could we grab the { expression } part of a function call? I am afraid that this is not possible, but will leave on the bounty for a few days for the pros :)
Given the other answers supplied, I suspect that it is impossible tough to do in exactly the way you specify.
However, I believe there is a way of getting very close, if you use the plyr package creatively. The trick is to use l_ply which takes a list as input and creates no output.
The only real differences between this solution and your specification is that in a for loop you can directly modify variables in the same environment. Using l_ply you need to send a function, so you will have to be more careful if you want to modify stuff in the parent environment.
Try the following:
library(plyr)
forp <- function(i, .fun){
l_ply(i, .fun, .progress="tk")
}
a <- 0
forp(1:100, function(i){
Sys.sleep(0.01)
a<<-a+i
})
print(a)
[1] 5050
This creates a progress bar and modifies the value of a in the global environment.
EDIT.
For the avoidance of doubt: The argument .fun will always be a function with a single argument, e.g. .fun=function(i){...}.
For example:
for(i in 1:10){expr} is equivalent to forp(1:10, function(i){expr})
In other words:
i is the looping parameter of the loop
.fun is a function with a single argument i
My solution is very similar to Andrie's except it uses base R, and I second his comments on the need to wrap what you want to do in a function and the subsequent need to use <<- to modify stuff in a higher environment.
Here's a function that does nothing, and does it slowly:
myfun <- function(x, text) {
Sys.sleep(0.2)
cat("running ",x, " with text of '", text, "'\n", sep="")
x
}
Here's my forp function. Note that regardless of what we're actually looping over, it instead loops over the sequence 1:n instead and get the right term of what we actually want within the loop. plyr does this automatically.
library(tcltk)
forp <- function(x, FUN, ...) {
n <- length(x)
pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
out <- vector("list", n)
for (i in seq_len(n)) {
out[[i]] <- FUN(x[i], ...)
setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
}
close(pb)
invisible(out)
}
And here's how both for and forp might be used, if all we want to do is call myfun:
x <- LETTERS[1:5]
for(xi in x) myfun(xi, "hi")
forp(x, myfun, text="hi")
And here's how they might be used if we want to modify something along the way.
out <- "result:"
for(xi in x) {
out <- paste(out, myfun(xi, "hi"))
}
out <- "result:"
forp(x, function(xi) {
out <<- paste(out, myfun(xi, "hi"))
})
For both versions the result is
> out
[1] "result: A B C D E"
EDIT: After seeing your (daroczig's) solution, I have another idea that might not be quite so unwieldy, which is to evaluate the expression in the parent frame. This makes it easier to allow for values other than i (now specified with the index argument), though as of right now I don't think it handles a function as the expression, though just to drop in instead a for loop that shouldn't matter.
forp2 <- function(index, x, expr) {
expr <- substitute(expr)
n <- length(x)
pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
for (i in seq_len(n)) {
assign(index, x[i], envir=parent.frame())
eval(expr, envir=parent.frame())
setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
}
close(pb)
}
The code to run my example from above would be
out <- "result:"
forp2("xi", LETTERS[1:5], {
out <- paste(out, myfun(xi, "hi"))
})
and the result is the same.
ANOTHER EDIT, based on the additional information in your bounty offer:
The syntax forX(1:1000) %doX$ { expression } is possible; that's what the foreach package does. I'm too lazy right now to build it off of your solution, but building off mine, it could look like this:
`%doX%` <- function(index, expr) {
x <- index[[1]]
index <- names(index)
expr <- substitute(expr)
n <- length(x)
pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
for (i in seq_len(n)) {
assign(index, x[i], envir=parent.frame())
eval(expr, envir=parent.frame())
setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
}
close(pb)
invisible(out)
}
forX <- function(...) {
a <- list(...)
if(length(a)!=1) {
stop("index must have only one element")
}
a
}
Then the use syntax is this, and the result is the same as above.
out <- "result:"
forX(xi=LETTERS[1:5]) %doX% {
out <- paste(out, myfun(xi, "hi"))
}
out
If you use the plyr family of commands instead of a for loop (generally a good idea if possible), you get as an added bonus a whole system of progress bars.
R.utils also has some progress bars built into it, and there exist instructions for using them in for loops.
R's syntax doesn't let you do exactly what you want, ie:
forp (i in 1:10) {
#do something
}
But what you can do is create some kind of iterator object and loop using while():
while(nextStep(m)){sleep.milli(20)}
Now you have the problem of what m is and how you make nextStep(m) have side effects on m in order to make it return FALSE at the end of your loop. I've written simple iterators that do this, as well as MCMC iterators that let you define and test for a burnin and thinning period within your loop.
Recently at the R User conference I saw someone define a 'do' function that then worked as an operator, something like:
do(100) %*% foo()
but I'm not sure that was the exact syntax and I'm not sure how to implement it or who it was put that up... Perhaps someone else can remember!
What you're hoping for, I think would be something that looks like
body(for)<- as.call(c(as.name('{'),expression([your_updatebar], body(for))))
And yep, the problem is that "for" is not a function, or at least not one whose "body" is accessible. You could, I suppose, create a "forp" function that takes as arguments 1) a string to be turned into the loop counter, e.g., " ( i in seq(1,101,5) )" , and 2) the body of your intended loop, e.g., y[i]<- foo[i]^2 ; points(foo[i],y[i], and then jump thru some getcallparse magic to execute the actual for loop.
Then , in pseudocode (not close to actual R code, but I think you see what should happen)
forp<-function(indexer,loopbody) {
pseudoparse( c("for (", indexer, ") {" ,loopbody,"}")
}
The problem is that the for-loop in R is treated special. A normal function is not allowed to look like that. Some small tweaks can make it loop pretty close though. And as #Aaron mentioned, the foreach package's %dopar% paradigm seems like the best fit. Here's my version of how it could work:
`%doprogress%` <- function(forExpr, bodyExpr) {
forExpr <- substitute(forExpr)
bodyExpr <- substitute(bodyExpr)
idxName <- names(forExpr)[[2]]
vals <- eval(forExpr[[2]])
e <- new.env(parent=parent.frame())
pb <- tkProgressBar(title = "Working hard:", min = 0, max = length(vals), width = 300)
for (i in seq_along(vals)) {
e[[idxName]] <- vals[[i]]
eval(bodyExpr, e)
setTkProgressBar(pb, i, label=paste( round(i/length(vals)*100, 0), "% ready!"))
}
}
# Example usage:
foreach(x = runif(10)) %doprogress% {
# do something
if (x < 0.5) cat("small\n") else cat("big")
}
As you can see, you have to type x = 1:10 instead of x in 1:10, and the infix operator %<whatever>% is needed to get hold of the looping construct and the loop body. I currently don't do any error checking (to avoid muddling the code). You should check the name of the function ("foreach"), the number of arguments to it (1) and that you actually get a valid loop variable ("x") and not an empty string.
I propose hereby two solutions that use the standard for syntax, both are using the great package progress from Gábor Csárdi and Rich FitzJohn
1) we can override temporarily or locally the for function to wrap around base::for and support progress bars.
2) we can define the unused for<-, and wrap around base::for using syntax pb -> for(it in seq) {exp} where pb is progress bar built with progress::progress_bar$new().
Both solutions behave as standard for calls :
The values changed at the previous iteration are available
on error the modified variables will have the value they had just before the error
I packaged my solution and will demo them below then will go through the code
Usage
#devtools::install_github("moodymudskipper/pbfor")
library(pbfor)
Using pb_for()
By default pb_for() will override the for function for one run only.
pb_for()
for (i in 1:10) {
# DO SOMETHING
Sys.sleep(0.5)
}
Using parameters from progress::progress_bar$new() :
pb_for(format = "Working hard: [:bar] :percent :elapsed",
callback = function(x) message("Were'd done!"))
for (i in 1:10) {
# DO SOMETHING
Sys.sleep(0.5)
}
Using for<-
The only restriction compared to a standard for call is that the first argument must exist and can't be NULL.
i <- NA
progress_bar$new() -> for (i in 1:10) {
# DO SOMETHING
Sys.sleep(0.5)
}
We can define a custom progress bar, and maybe define it conveniently in an initialisation script or in one's R profile.
pb <- progress_bar$new(format = "Working hard: [:bar] :percent :elapsed",
callback = function(x) ("Were'd done!"))
pb -> for (i in 1:10) {
# DO SOMETHING
Sys.sleep(0.5)
}
For nested progress bars we can use the following trick :
pbi <- progress_bar$new(format = "i: [:bar] :percent\n\n")
pbj <- progress_bar$new(format = "j: [:bar] :percent ")
i <- NA
j <- NA
pbi -> for (i in 1:10) {
pbj -> for (j in 1:10) {
# DO SOMETHING
Sys.sleep(0.1)
}
}
note that due to operator precedence the only way to call for<- and benefit from the syntax of for calls is to use the left to right arrow ´->´.
how they work
pb_for()
pb_for() creates a for function object in its parent environment, then the new for :
sets up a progress bar
modifies the loop content
adds a `*pb*`$tick() at the end of the loop content expression
feeds it back to base::`for` in a clean environment
assigns on exit all modified or created variables to the parent environment.
removes itself if once is TRUE (the default)
It's generally sensitive to override an operator, but it cleans after itself and won't affect the global environment if used in a function so I think it's safe enough to use.
for<-
This approach :
doesn't override for
allows the use of progress bar templates
has an arguably more intuitive api
It has a few drawbacks however:
its first argument must exist, which is the case for all assignment functions (fun<-).
it does some memory magic to find the name of its first argument as it's not easily done with assignment functions, this might have a performance cost, and I'm not 100% sure about the robustness
we need the package pryr
What it does :
find the name of the first argument, using a helper function
clone the progress bar input
edit it to account for the number of iterations of the loop (the length of the second argument of for<-
After this it's similar to what is described for pb_for() in the section above.
The code
pb_for()
pb_for <-
function(
# all args of progress::progress_bar$new() except `total` which needs to be
# infered from the 2nd argument of the `for` call, and `stream` which is
# deprecated
format = "[:bar] :percent",
width = options("width")[[1]] - 2,
complete = "=",
incomplete = "-",
current =">",
callback = invisible, # doc doesn't give default but this seems to work ok
clear = TRUE,
show_after = .2,
force = FALSE,
# The only arg not forwarded to progress::progress_bar$new()
# By default `for` will self detruct after being called
once = TRUE) {
# create the function that will replace `for`
f <- function(it, seq, expr){
# to avoid notes at CMD check
`*pb*` <- IT <- SEQ <- EXPR <- NULL
# forward all arguments to progress::progress_bar$new() and add
# a `total` argument computed from `seq` argument
pb <- progress::progress_bar$new(
format = format, width = width, complete = complete,
incomplete = incomplete, current = current,
callback = callback,
clear = clear, show_after = show_after, force = force,
total = length(seq))
# using on.exit allows us to self destruct `for` if relevant even if
# the call fails.
# It also allows us to send to the local environment the changed/created
# variables in their last state, even if the call fails (like standard for)
on.exit({
vars <- setdiff(ls(env), c("*pb*"))
list2env(mget(vars,envir = env), envir = parent.frame())
if(once) rm(`for`,envir = parent.frame())
})
# we build a regular `for` loop call with an updated loop code including
# progress bar.
# it is executed in a dedicated environment and the progress bar is given
# a name unlikely to conflict
env <- new.env(parent = parent.frame())
env$`*pb*` <- pb
eval(substitute(
env = list(IT = substitute(it), SEQ = substitute(seq), EXPR = substitute(expr)),
base::`for`(IT, SEQ,{
EXPR
`*pb*`$tick()
})), envir = env)
}
# override `for` in the parent frame
assign("for", value = f,envir = parent.frame())
}
for<- (and fetch_name())
`for<-` <-
function(it, seq, expr, value){
# to avoid notes at CMD check
`*pb*` <- IT <- SEQ <- EXPR <- NULL
# the symbol fed to `it` is unknown, R uses `*tmp*` for assignment functions
# so we go get it by inspecting the memory addresses
it_chr <- fetch_name(it)
it_sym <-as.symbol(it_chr)
# complete the progress bar with the `total` parameter
# we need to clone it because progress bars are environments and updated
# by reference
pb <- value$clone()
pb$.__enclos_env__$private$total <- length(seq)
# when the script ends, even with a bug, the values that have been changed
# are written to the parent frame
on.exit({
vars <- setdiff(ls(env), c("*pb*"))
list2env(mget(vars, env),envir = parent.frame())
})
# computations are operated in a separate environment so we don't pollute it
# with it, seq, expr, value, we need the progress bar so we name it `*pb*`
# unlikely to conflict by accident
env <- new.env(parent = parent.frame())
env$`*pb*` <- pb
eval(substitute(
env = list(IT = it_sym, SEQ = substitute(seq), EXPR = substitute(expr)),
base::`for`(IT, SEQ,{
EXPR
`*pb*`$tick()
})), envir = env)
# because of the `fun<-` syntax we need to return the modified first argument
invisible(get(it_chr,envir = env))
}
helpers:
fetch_name <- function(x,env = parent.frame(2)) {
all_addresses <- sapply(ls(env), address2, env)
all_addresses <- all_addresses[names(all_addresses) != "*tmp*"]
all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)
x_address <- tracemem(x)
untracemem(x)
x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))
ind <- match(x_address_short, all_addresses_short)
x_name <- names(all_addresses)[ind]
x_name
}
address2 <- getFromNamespace("address2", "pryr")
Thanks for everyone for your kind answers! As none of those fit my wacky needs, I started to steal some pieces of the given answers and made up a quite customized version:
forp <- function(iis, .fun) {
.fun <- paste(deparse(substitute(.fun)), collapse='\n')
.fun <- gsub(' <- ', ' <<- ', .fun, fixed=TRUE)
.fun <- paste(.fun, 'index.current <- 1 + index.current; setTkProgressBar(pb, index.current, label=paste( round(index.current/index.max*100, 0), "% ready!"))', sep='\n')
ifelse(is.numeric(iis), index.max <- max(iis), index.max <- length(iis))
index.current <- 1
pb <- tkProgressBar(title = "Working hard:", min = 0, max = index.max, width = 300)
for (i in iis) eval(parse(text=paste(.fun)))
close(pb)
}
This is quite lengthy for a simple function like this, but depends only on base (anf of course: tcltk) and has some nice features:
can be used on expressions, not just functions,
you do not have to use <<- in your expressions to update global environment, <- are replaced to <<- in the given expr. Well,this might be annoying for someone.
can be used with non-numeric indexes (see below). That is why the code become so long :)
Usage is similar to for except for you do not have to specify the i in part and you have to use i as index in the loop. Other drawback is that I did not find a way to grab the {...} part specified after a function, so this must be included in the parameters.
Example #1: Basic use
> forp(1:1000, {
+ a<-i
+ })
> a
[1] 1000
Try it to see the neat progress bar on your computer! :)
Example #2: Looping through some characters
> m <- 0
> forp (names(mtcars), {
+ m <- m + mean(mtcars[,i])
+ })
> m
[1] 435.69
Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The problem/comic in question: http://xkcd.com/287/
I'm not sure this is the best way to do it, but here's what I've come up with so far. I'm using CFML, but it should be readable by anyone.
<cffunction name="testCombo" returntype="boolean">
<cfargument name="currentCombo" type="string" required="true" />
<cfargument name="currentTotal" type="numeric" required="true" />
<cfargument name="apps" type="array" required="true" />
<cfset var a = 0 />
<cfset var found = false />
<cfloop from="1" to="#arrayLen(arguments.apps)#" index="a">
<cfset arguments.currentCombo = listAppend(arguments.currentCombo, arguments.apps[a].name) />
<cfset arguments.currentTotal = arguments.currentTotal + arguments.apps[a].cost />
<cfif arguments.currentTotal eq 15.05>
<!--- print current combo --->
<cfoutput><strong>#arguments.currentCombo# = 15.05</strong></cfoutput><br />
<cfreturn true />
<cfelseif arguments.currentTotal gt 15.05>
<cfoutput>#arguments.currentCombo# > 15.05 (aborting)</cfoutput><br />
<cfreturn false />
<cfelse>
<!--- less than 15.05 --->
<cfoutput>#arguments.currentCombo# < 15.05 (traversing)</cfoutput><br />
<cfset found = testCombo(arguments.currentCombo, arguments.currentTotal, arguments.apps) />
</cfif>
</cfloop>
</cffunction>
<cfset mf = {name="Mixed Fruit", cost=2.15} />
<cfset ff = {name="French Fries", cost=2.75} />
<cfset ss = {name="side salad", cost=3.35} />
<cfset hw = {name="hot wings", cost=3.55} />
<cfset ms = {name="moz sticks", cost=4.20} />
<cfset sp = {name="sampler plate", cost=5.80} />
<cfset apps = [ mf, ff, ss, hw, ms, sp ] />
<cfloop from="1" to="6" index="b">
<cfoutput>#testCombo(apps[b].name, apps[b].cost, apps)#</cfoutput>
</cfloop>
The above code tells me that the only combination that adds up to $15.05 is 7 orders of Mixed Fruit, and it takes 232 executions of my testCombo function to complete.
Is there a better algorithm to come to the correct solution? Did I come to the correct solution?
It gives all the permutations of the solutions, but I think I'm beating everyone else for code size.
item(X) :- member(X,[215, 275, 335, 355, 420, 580]).
solution([X|Y], Z) :- item(X), plus(S, X, Z), Z >= 0, solution(Y, S).
solution([], 0).
Solution with swiprolog:
?- solution(X, 1505).
X = [215, 215, 215, 215, 215, 215, 215] ;
X = [215, 355, 355, 580] ;
X = [215, 355, 580, 355] ;
X = [215, 580, 355, 355] ;
X = [355, 215, 355, 580] ;
X = [355, 215, 580, 355] ;
X = [355, 355, 215, 580] ;
X = [355, 355, 580, 215] ;
X = [355, 580, 215, 355] ;
X = [355, 580, 355, 215] ;
X = [580, 215, 355, 355] ;
X = [580, 355, 215, 355] ;
X = [580, 355, 355, 215] ;
No
The point about an NP-complete problem is not that it's tricky on a small data set, but that the amount of work to solve it grows at a rate greater than polynomial, i.e. there is no O(n^x) algorithm.
If the time complexity is O(n!), as in (I believe) the two problems mentioned above, that is in NP.
Isn't it more elegant with recursion (in Perl)?
#!/usr/bin/perl
use strict;
use warnings;
my #weights = (2.15, 2.75, 3.35, 3.55, 4.20, 5.80);
my $total = 0;
my #order = ();
iterate($total, #order);
sub iterate
{
my ($total, #order) = #_;
foreach my $w (#weights)
{
if ($total+$w == 15.05)
{
print join (', ', (#order, $w)), "\n";
}
if ($total+$w < 15.05)
{
iterate($total+$w, (#order, $w));
}
}
}
Output
marco#unimatrix-01:~$ ./xkcd-knapsack.pl
2.15, 2.15, 2.15, 2.15, 2.15, 2.15, 2.15
2.15, 3.55, 3.55, 5.8
2.15, 3.55, 5.8, 3.55
2.15, 5.8, 3.55, 3.55
3.55, 2.15, 3.55, 5.8
3.55, 2.15, 5.8, 3.55
3.55, 3.55, 2.15, 5.8
3.55, 5.8, 2.15, 3.55
5.8, 2.15, 3.55, 3.55
5.8, 3.55, 2.15, 3.55
Even though knapsack is NP Complete, it is a very special problem: the usual dynamic program for it is in fact excellent (http://en.wikipedia.org/wiki/Knapsack_problem)
And if you do the correct analysis, it turns out that it is O(nW), n being the # of items, and W being the target number. The problem is when you have to DP over a large W, that's when we get the NP behaviour. But for the most part, knapsack is reasonably well behaved and you can solve really large instances of it with no problems. As far as NP complete problems go, knapsack is one of the easiest.
Here is the solution using constraint.py
>>> from constraint import *
>>> problem = Problem()
>>> menu = {'mixed-fruit': 2.15,
... 'french-fries': 2.75,
... 'side-salad': 3.35,
... 'hot-wings': 3.55,
... 'mozarella-sticks': 4.20,
... 'sampler-plate': 5.80}
>>> for appetizer in menu:
... problem.addVariable( appetizer, [ menu[appetizer] * i for i in range( 8 )] )
>>> problem.addConstraint(ExactSumConstraint(15.05))
>>> problem.getSolutions()
[{'side-salad': 0.0, 'french-fries': 0.0, 'sampler-plate': 5.7999999999999998, 'mixed-fruit': 2.1499999999999999, 'mozarella-sticks': 0.0, 'hot-wings': 7.0999999999999996},
{'side-salad': 0.0, 'french-fries': 0.0, 'sampler-plate': 0.0, 'mixed-fruit': 15.049999999999999, 'mozarella-sticks': 0.0, 'hot-wings': 0.0}]
So the solution is to order a sampler plate, a mixed fruit, and 2 orders of hot wings, or order 7 mixed-fruits.
Here's a solution with F#:
#light
type Appetizer = { name : string; cost : int }
let menu = [
{name="fruit"; cost=215}
{name="fries"; cost=275}
{name="salad"; cost=335}
{name="wings"; cost=355}
{name="moz sticks"; cost=420}
{name="sampler"; cost=580}
]
// Choose: list<Appetizer> -> list<Appetizer> -> int -> list<list<Appetizer>>
let rec Choose allowedMenu pickedSoFar remainingMoney =
if remainingMoney = 0 then
// solved it, return this solution
[ pickedSoFar ]
else
// there's more to spend
[match allowedMenu with
| [] -> yield! [] // no more items to choose, no solutions this branch
| item :: rest ->
if item.cost <= remainingMoney then
// if first allowed is within budget, pick it and recurse
yield! Choose allowedMenu (item :: pickedSoFar) (remainingMoney - item.cost)
// regardless, also skip ever picking more of that first item and recurse
yield! Choose rest pickedSoFar remainingMoney]
let solutions = Choose menu [] 1505
printfn "%d solutions:" solutions.Length
solutions |> List.iter (fun solution ->
solution |> List.iter (fun item -> printf "%s, " item.name)
printfn ""
)
(*
2 solutions:
fruit, fruit, fruit, fruit, fruit, fruit, fruit,
sampler, wings, wings, fruit,
*)
Read up on the Knapsack Problem.
You've got all the correct combinations now, but you're still checking many more than you need to (as evidenced by the many permutations your result shows). Also, you're omitting the last item that hits the 15.05 mark.
I have a PHP version that does 209 iterations of the recursive call (it does 2012 if I get all permutations). You can reduce your count if right before the end of your loop, you pull out the item you just checked.
I don't know CF syntax, but it will be something like this:
<cfelse>
<!--- less than 15.50 --->
<!--<cfoutput>#arguments.currentCombo# < 15.05 (traversing)</cfoutput><br />-->
<cfset found = testCombo(CC, CT, arguments.apps) />
------- remove the item from the apps array that was just checked here ------
</cfif>
</cfloop>
EDIT: For reference, here's my PHP version:
<?
function rc($total, $string, $m) {
global $c;
$m2 = $m;
$c++;
foreach($m as $i=>$p) {
if ($total-$p == 0) {
print "$string $i\n";
return;
}
if ($total-$p > 0) {
rc($total-$p, $string . " " . $i, $m2);
}
unset($m2[$i]);
}
}
$c = 0;
$m = array("mf"=>215, "ff"=>275, "ss"=>335, "hw"=>355, "ms"=>420, "sp"=>580);
rc(1505, "", $m);
print $c;
?>
Output
mf mf mf mf mf mf mf
mf hw hw sp
209
EDIT 2:
Since explaining why you can remove the elements will take a little more than I could fit in a comment, I'm adding it here.
Basically, each recursion will find all combinations that include the currently search element (e.g., the first step will find everything including at least one mixed fruit). The easiest way to understand it is to trace the execution, but since that will take a lot of space, I'll do it as if the target was 6.45.
MF (2.15)
MF (4.30)
MF (6.45) *
FF (7.05) X
SS (7.65) X
...
[MF removed for depth 2]
FF (4.90)
[checking MF now would be redundant since we checked MF/MF/FF previously]
FF (7.65) X
...
[FF removed for depth 2]
SS (5.50)
...
[MF removed for depth 1]
At this point, we've checked every combination that includes any mixed fruit, so there's no need to check for mixed fruit again. You can use the same logic to prune the array at each of the deeper recursions as well.
Tracing through it like this actually suggested another slight time saver -- knowing the prices are sorted from low to high means that we don't need to keep checking items once we go over the target.
I would make one suggestion about the design of the algorithm itself (which is how I interpreted the intent of your original question). Here is a fragment of the solution I wrote:
....
private void findAndReportSolutions(
int target, // goal to be achieved
int balance, // amount of goal remaining
int index // menu item to try next
) {
++calls;
if (balance == 0) {
reportSolution(target);
return; // no addition to perfect order is possible
}
if (index == items.length) {
++falls;
return; // ran out of menu items without finding solution
}
final int price = items[index].price;
if (balance < price) {
return; // all remaining items cost too much
}
int maxCount = balance / price; // max uses for this item
for (int n = maxCount; 0 <= n; --n) { // loop for this item, recur for others
++loops;
counts[index] = n;
findAndReportSolutions(
target, balance - n * price, index + 1
);
}
}
public void reportSolutionsFor(int target) {
counts = new int[items.length];
calls = loops = falls = 0;
findAndReportSolutions(target, target, 0);
ps.printf("%d calls, %d loops, %d falls%n", calls, loops, falls);
}
public static void main(String[] args) {
MenuItem[] items = {
new MenuItem("mixed fruit", 215),
new MenuItem("french fries", 275),
new MenuItem("side salad", 335),
new MenuItem("hot wings", 355),
new MenuItem("mozzarella sticks", 420),
new MenuItem("sampler plate", 580),
};
Solver solver = new Solver(items);
solver.reportSolutionsFor(1505);
}
...
(Note that the constructor does sort the menu items by increasing price, to enable the constant-time early termination when the remaining balance is smaller than any remaining menu item.)
The output for a sample run is:
7 mixed fruit (1505) = 1505
1 mixed fruit (215) + 2 hot wings (710) + 1 sampler plate (580) = 1505
348 calls, 347 loops, 79 falls
The design suggestion I want to highlight is that in the above code, each nested (recursive) call of findAndReportSolution(...) deals with the quantity of exactly one menu item, identified by the index argument. In other words, the recursive nesting parallels the behavior of an in-line set of nested loops; the outermost counts possible uses of the first menu item, the next in counts the uses of the second menu item, etc. (Except, of course, the use of recursion liberates the code from dependence on a specific number of menu items!)
I suggest that this makes it easier to design the code, and easier to understand what each invocation is doing (accounting for all possible uses of a specific item, delegating the remainder of the menu to subordinate calls). It also avoids the combinatorial explosion of producing all arrangements of a multiple-item solution (as in the second line of the above output, which only occurs once, instead of repeatedly with different orderings of the items).
I try to maximize the "obviousness" of the code, rather than trying to minimize the number of calls of some specific method. For example, the above design lets a delegated call determine if a solution has been reached, rather than wrapping that check around the point of the call, which would reduce the number of calls at the expense of cluttering up the code.
Hmm, you know what's weird. The solution is seven of the first item on the menu.
Since this was obviously meant to be solved by paper and pencil in a short time frame, why not divide the order total by the price of each item to see if by some chance they ordered multiples of one item?
For example,
15.05/2.15 = 7 mixed fruits
15.05/2.75 = 5.5 french fries.
And then move on to simple combinations...
15 / (2.15 + 2.75) = 3.06122449 mixed fruits with french fries.
In other words, assume that the solution is supposed to be simple and solvable by a human without access to a computer. Then test if the simplest, most obvious (and therefore hidden in plain sight) solution(s) work(s).
I swear I'm pulling this at the local coney this weekend when I order $4.77 worth of appetizers (including tax) at 4:30 AM after the club closes.
In python.
I had some problems with "global vars" so I put the function as method of an object. It is recursive and it calls itself 29 times for the question in the comic, stopping at the first successful match
class Solver(object):
def __init__(self):
self.solved = False
self.total = 0
def solve(s, p, pl, curList = []):
poss = [i for i in sorted(pl, reverse = True) if i <= p]
if len(poss) == 0 or s.solved:
s.total += 1
return curList
if abs(poss[0]-p) < 0.00001:
s.solved = True # Solved it!!!
s.total += 1
return curList + [poss[0]]
ml,md = [], 10**8
for j in [s.solve(p-i, pl, [i]) for i in poss]:
if abs(sum(j)-p)<md: ml,md = j, abs(sum(j)-p)
s.total += 1
return ml + curList
priceList = [5.8, 4.2, 3.55, 3.35, 2.75, 2.15]
appetizers = ['Sampler Plate', 'Mozzarella Sticks', \
'Hot wings', 'Side salad', 'French Fries', 'Mixed Fruit']
menu = zip(priceList, appetizers)
sol = Solver()
q = sol.solve(15.05, priceList)
print 'Total time it runned: ', sol.total
print '-'*30
order = [(m, q.count(m[0])) for m in menu if m[0] in q]
for o in order:
print '%d x %s \t\t\t (%.2f)' % (o[1],o[0][1],o[0][0])
print '-'*30
ts = 'Total: %.2f' % sum(q)
print ' '*(30-len(ts)-1),ts
Output:
Total time it runned: 29
------------------------------
1 x Sampler Plate (5.80)
2 x Hot wings (3.55)
1 x Mixed Fruit (2.15)
------------------------------
Total: 15.05
Actually, I've refactored my algorithm some more. There were several correct combinations I was missing, and it was due to the fact that I was returning as soon as the cost went over 15.05 -- I wasn't bothering to check other (cheaper) items that I could add. Here's my new algorithm:
<cffunction name="testCombo" returntype="numeric">
<cfargument name="currentCombo" type="string" required="true" />
<cfargument name="currentTotal" type="numeric" required="true" />
<cfargument name="apps" type="array" required="true" />
<cfset var a = 0 />
<cfset var found = false />
<cfset var CC = "" />
<cfset var CT = 0 />
<cfset tries = tries + 1 />
<cfloop from="1" to="#arrayLen(arguments.apps)#" index="a">
<cfset combos = combos + 1 />
<cfset CC = listAppend(arguments.currentCombo, arguments.apps[a].name) />
<cfset CT = arguments.currentTotal + arguments.apps[a].cost />
<cfif CT eq 15.05>
<!--- print current combo --->
<cfoutput><strong>#CC# = 15.05</strong></cfoutput><br />
<cfreturn true />
<cfelseif CT gt 15.05>
<!--<cfoutput>#arguments.currentCombo# > 15.05 (aborting)</cfoutput><br />-->
<cfelse>
<!--- less than 15.50 --->
<!--<cfoutput>#arguments.currentCombo# < 15.05 (traversing)</cfoutput><br />-->
<cfset found = testCombo(CC, CT, arguments.apps) />
</cfif>
</cfloop>
<cfreturn found />
</cffunction>
<cfset mf = {name="Mixed Fruit", cost=2.15} />
<cfset ff = {name="French Fries", cost=2.75} />
<cfset ss = {name="side salad", cost=3.35} />
<cfset hw = {name="hot wings", cost=3.55} />
<cfset ms = {name="moz sticks", cost=4.20} />
<cfset sp = {name="sampler plate", cost=5.80} />
<cfset apps = [ mf, ff, ss, hw, ms, sp ] />
<cfset tries = 0 />
<cfset combos = 0 />
<cfoutput>
<cfloop from="1" to="6" index="b">
#testCombo(apps[b].name, apps[b].cost, apps)#
</cfloop>
<br />
tries: #tries#<br />
combos: #combos#
</cfoutput>
Output:
Mixed Fruit,Mixed Fruit,Mixed Fruit,Mixed Fruit,Mixed Fruit,Mixed Fruit,Mixed Fruit = 15.05
Mixed Fruit,hot wings,hot wings,sampler plate = 15.05
Mixed Fruit,hot wings,sampler plate,hot wings = 15.05
Mixed Fruit,sampler plate,hot wings,hot wings = 15.05
false false false hot wings,Mixed Fruit,hot wings,sampler plate = 15.05
hot wings,Mixed Fruit,sampler plate,hot wings = 15.05
hot wings,hot wings,Mixed Fruit,sampler plate = 15.05
hot wings,sampler plate,Mixed Fruit,hot wings = 15.05
false false sampler plate,Mixed Fruit,hot wings,hot wings = 15.05
sampler plate,hot wings,Mixed Fruit,hot wings = 15.05
false
tries: 2014
combos: 12067
I think this may have all of the correct combinations, but my question still stands: Is there a better algorithm?
Learning from #rcar's answer, and another refactoring later, I've got the following.
As with so many things I code, I've refactored from CFML to CFScript, but the code is basically the same.
I added in his suggestion of a dynamic start point in the array (instead of passing the array by value and changing its value for future recursions), which brought me to the same stats he gets (209 recursions, 571 combination price checks (loop iterations)), and then improved on that by assuming that the array will be sorted by cost -- because it is -- and breaking as soon as we go over the target price. With the break, we're down to 209 recursions and 376 loop iterations.
What other improvements could be made to the algorithm?
function testCombo(minIndex, currentCombo, currentTotal){
var a = 0;
var CC = "";
var CT = 0;
var found = false;
tries += 1;
for (a=arguments.minIndex; a <= arrayLen(apps); a++){
combos += 1;
CC = listAppend(arguments.currentCombo, apps[a].name);
CT = arguments.currentTotal + apps[a].cost;
if (CT eq 15.05){
//print current combo
WriteOutput("<strong>#CC# = 15.05</strong><br />");
return(true);
}else if (CT gt 15.05){
//since we know the array is sorted by cost (asc),
//and we've already gone over the price limit,
//we can ignore anything else in the array
break;
}else{
//less than 15.50, try adding something else
found = testCombo(a, CC, CT);
}
}
return(found);
}
mf = {name="mixed fruit", cost=2.15};
ff = {name="french fries", cost=2.75};
ss = {name="side salad", cost=3.35};
hw = {name="hot wings", cost=3.55};
ms = {name="mozarella sticks", cost=4.20};
sp = {name="sampler plate", cost=5.80};
apps = [ mf, ff, ss, hw, ms, sp ];
tries = 0;
combos = 0;
testCombo(1, "", 0);
WriteOutput("<br />tries: #tries#<br />combos: #combos#");
Here's concurrent implementation in Clojure. To calculate (items-with-price 15.05) takes about 14 combination-generation recursions, and about 10 possibility-checks. Took me about 6 minutes to calculate (items-with-price 100) on my Intel Q9300.
This only gives the first found answer, or nil if there is none, as that's all the problem calls for. Why do more work that you've been told to do ;) ?
;; np-complete.clj
;; A Clojure solution to XKCD #287 "NP-Complete"
;; By Sam Fredrickson
;;
;; The function "items-with-price" returns a sequence of items whose sum price
;; is equal to the given price, or nil.
(defstruct item :name :price)
(def *items* #{(struct item "Mixed Fruit" 2.15)
(struct item "French Fries" 2.75)
(struct item "Side Salad" 3.35)
(struct item "Hot Wings" 3.55)
(struct item "Mozzarella Sticks" 4.20)
(struct item "Sampler Plate" 5.80)})
(defn items-with-price [price]
(let [check-count (atom 0)
recur-count (atom 0)
result (atom nil)
checker (agent nil)
; gets the total price of a seq of items.
items-price (fn [items] (apply + (map #(:price %) items)))
; checks if the price of the seq of items matches the sought price.
; if so, it changes the result atom. if the result atom is already
; non-nil, nothing is done.
check-items (fn [unused items]
(swap! check-count inc)
(if (and (nil? #result)
(= (items-price items) price))
(reset! result items)))
; lazily generates a list of combinations of the given seq s.
; haven't tested well...
combinations (fn combinations [cur s]
(swap! recur-count inc)
(if (or (empty? s)
(> (items-price cur) price))
'()
(cons cur
(lazy-cat (combinations (cons (first s) cur) s)
(combinations (cons (first s) cur) (rest s))
(combinations cur (rest s))))))]
; loops through the combinations of items, checking each one in a thread
; pool until there are no more combinations or the result atom is non-nil.
(loop [items-comb (combinations '() (seq *items*))]
(if (and (nil? #result)
(not-empty items-comb))
(do (send checker check-items (first items-comb))
(recur (rest items-comb)))))
(await checker)
(println "No. of recursions:" #recur-count)
(println "No. of checks:" #check-count)
#result))
If you want an optimized algorithm, it's best to try the prices in descending order. That lets you use up as much of the remaining amount first and then see how the rest can be filled in.
Also, you can use math to figure out the maximum quantity of each food item to start each time so you don't try combinations that would go over the $15.05 goal.
This algorithm only needs to try 88 combinations to get a complete answer and that looks like the lowest that's been posted so far:
public class NPComplete {
private static final int[] FOOD = { 580, 420, 355, 335, 275, 215 };
private static int tries;
public static void main(String[] ignore) {
tries = 0;
addFood(1505, "", 0);
System.out.println("Combinations tried: " + tries);
}
private static void addFood(int goal, String result, int index) {
// If no more food to add, see if this is a solution
if (index >= FOOD.length) {
tries++;
if (goal == 0)
System.out.println(tries + " tries: " + result.substring(3));
return;
}
// Try all possible quantities of this food
// If this is the last food item, only try the max quantity
int qty = goal / FOOD[index];
do {
addFood(goal - qty * FOOD[index],
result + " + " + qty + " * " + FOOD[index], index + 1);
} while (index < FOOD.length - 1 && --qty >= 0);
}
}
Here's the output showing the two solutions:
9 tries: 1 * 580 + 0 * 420 + 2 * 355 + 0 * 335 + 0 * 275 + 1 * 215
88 tries: 0 * 580 + 0 * 420 + 0 * 355 + 0 * 335 + 0 * 275 + 7 * 215
Combinations tried: 88