Using AutoLISP (to be used for AutoCAD 2015), I am working on a script that calculates the total length of all rectangles that are placed on a certain layer.
(Concrete purpose: I have a layer with multiple rectangles representing the wooden beams intended to carry a wooden floor. I want to calculate how many metres of beams I will have to buy for this floor.)
What I have, so far, is a script that calculates the sum of the length of all lines on the layer. This works fine so far. It returns both the overall length of the (circumference) lines of all rectangles on the layer, and the number of rectangles found.
(defun C:PLINELEN (/ ent sset obj len sum layer a)
(setvar "ERRNO" 0)
(while
(and (not (setq ent (car (entsel "Select object on layer: "))))
(/= (getvar "ERRNO") 52)
)
)
(cond ((and ent
(setq sset
(ssget
"X"
(list '(0 . "LWPOLYLINE")
(cons 8 (setq layer (cdr (assoc 8 (entget ent)))))
)
)
)
)
(setq a 0
sum 0
)
(repeat (sslength sset)
(setq obj (vlax-ename->vla-object (ssname sset a))
len (vlax-curve-getDistAtParam
obj
(- (vlax-curve-getEndParam obj)
(vlax-curve-getStartParam obj)
)
)
sum (+ sum len)
)
(setq a (1+ a))
)
(princ (strcat "\nTotal length of "
(itoa a)
(if (= a 1)
" pline on layer "
" plines on layer "
)
layer
": "
(rtos sum)
)
)
)
(T (princ "\nNo plines found"))
)
(princ)
)
What is missing yet is functionality to leave aside all the short sides of the rectangles, and sum up only the long sides.
For my understanding, the simplest solution would be: add functionality to determine the sum of the length of all short sides of the rectangles found on the layer, and then subtract it from "sum")
In pseudocode:
(iterate through all rectangles on the layer
(measure all four sides of the rectangle)
(compare the four measurements and store [one of the] shortest into variable x)
(sumOfShortSides = sumOfShortSides + x)
)
I am most of the way there, but I need a pointers to improve my existing code to drop the short sides. Other solutions are also welcome.
How do I sum up the long sides of all rectangles in a layer?
Instead of using rectangles, why not create a dynamic block with a stretch action that sets the length. This way, you could just iterate all blocks on the required layer with the correct name and query for the dynamic length property.
Yes, this is a possibly huge change in your drafting procedure but it would provide you with what you need.
Related
I am working with groups in AutoCAD and, due to copy pasting them from different drawings, they ungroup.
In the possibility of me forgetting to regroup them, I want to create a code that, when I think I am finished with the drawing, can check if a list of blocks (every group has a block) is not inside a group.
As such, the idea is that it would run from a selection of blocks (ex: block1, block3, block7) and check if those particular blocks are grouped. If not, it would tell me which block is ungrouped.
As the tags suggest, either vba or autolisp is fine. I am fairly novice at this, any help would be fairly appreciated.
edit: knowing how I could get a block group name in vba would be great
Background
A block definition may have many block references: the block definition is analogous to the blueprints for a building, with each block reference analogous to the construction of the building itself.
As such, given only a list of block names, each block name may correspond to multiple block references, with some contained within groups, and others not.
Methods
You can therefore approach this task from two angles:
Iterate over all Groups defined within the drawing (either using the ActiveX Groups Collection, or the ACAD_GROUP dictionary contained within the Named Object Dictionary), and obtain the set of distinct block names corresponding to blocks contained within at least one Group.
OR
Iterate over all Block References within the drawing and test whether the block reference has a link to a GROUP entity via an {ACAD_REACTORS} entry in the DXF data. Compile a list of block names corresponding to blocks which are either contained within at least one group, or not contained within any group.
Given such a list, you can then easily test whether any of your block names are not present in the list.
Sample Code
Below is a function that will iterate over all Groups defined within the ACAD_GROUP dictionary of the Named Object Dictionary, and will return a list of the names of block references contained within one or more groups:
(defun blocknamesfromgroups ( / blk dic enx grp rtn )
(if (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
(while (setq grp (dictnext dic (not grp)))
(foreach itm grp
(if (and (= 340 (car itm)) (= "INSERT" (cdr (assoc 0 (setq enx (entget (cdr itm)))))))
(if (not (member (setq blk (cdr (assoc 2 enx))) rtn))
(setq rtn (cons blk rtn))
)
)
)
)
)
(reverse rtn)
)
Alternatively, the below function will iterate over all primary block references in the active drawing and will report the names of block references not contained within a group:
(defun blocknamesnotgrouped ( / blk enx grp idx sel rtn )
(if (setq sel (ssget "_X" '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(setq idx (1- idx)
enx (entget (ssname sel idx))
blk (cdr (assoc 2 enx))
)
(if
(not
(or
(and
(setq enx (member '(102 . "{ACAD_REACTORS") enx))
(setq grp (cdr (assoc 330 enx)))
(= "GROUP" (cdr (assoc 0 (entget grp))))
)
(member blk rtn)
)
)
(setq rtn (cons blk rtn))
)
)
)
(reverse rtn)
)
I have several (many) objects in an AutoCAD drawing and each of them has the same attribute field in it's preferences. Now I would like to fill this attribute field with a number (object one - number 1, object two - number 2 and so on). Putting the numbers in manually is very time consuming, therefore I would like to ask you if there's an automated approach for this matter.
Thanks a lot in advance!
An Example
The following program is a very simple example which will prompt you for an attribute tag to be numbered and an integer from which to start the numbering, and will then continuously prompt you to select attributed block references to be numbered, incrementing the number by one for each valid selection:
(defun c:attnum ( / ent enx num tag )
(if (/= "" (setq tag (strcase (getstring "\nSpecify attribute tag <exit>: "))))
(progn
(setq num (cond ((getint "\nSpecify starting number <1>: ")) (1)))
(while
(not
(progn
(setvar 'errno 0)
(setq ent (car (entsel (strcat "\nSelect block number " (itoa num) " <exit>: "))))
(cond
( (= 7 (getvar 'errno))
(prompt "\nMissed, try again.")
)
( (null ent))
( (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
(prompt "\nThe selected object is not a block.")
)
( (/= 1 (cdr (assoc 66 enx)))
(prompt "\nThe selected block is not attributed.")
)
( (progn
(setq ent (entnext ent)
enx (entget ent)
)
(while
(and
(= "ATTRIB" (cdr (assoc 0 enx)))
(/= tag (strcase (cdr (assoc 2 enx))))
)
(setq ent (entnext ent)
enx (entget ent)
)
)
(/= "ATTRIB" (cdr (assoc 0 enx)))
)
(prompt (strcat "\nThe selected block does not contain the attribute \"" tag "\"."))
)
( (entmod (subst (cons 1 (itoa num)) (assoc 1 enx) enx))
(entupd ent)
(setq num (1+ num))
nil
)
( (prompt "\nUnable to edit attribute value."))
)
)
)
)
)
)
(princ)
)
How to Load & Run the Above
Open Windows Notepad.
Copy & paste the above code into Notepad.
Save the file with a filename of your choice, with the file extension .lsp (ensure that Save As Type is set to All Files (*.*)).
Open AutoCAD to a new or existing drawing.
Type APPLOAD at the AutoCAD command-line.
Browse & select the file saved above, and click Load to load the program.
Close the APPLOAD dialog.
Type ATTNUM at the AutoCAD command-line to run the program.
Similar instructions may be found as part of my tutorial on How to Run an AutoLISP Program.
If you wish for the program to be automatically loaded for every new or existing drawing opened in AutoCAD, refer to my tutorial on Loading Programs Automatically.
Other Existing Solutions
In addition to the above, you may also be interested in the following programs:
My Incremental Numbering Suite application will provide a far more extensive set of options to allow you to customise the numbering format, permitting a Prefix & Suffix, multiple incrementing sections, and alphanumerical incrementing.
You can number existing attributed block references using this application by typing 'R' or 'r' at the AutoCAD command-line during object placement to enter Replacement Mode.
My Incremental Array application will allow you to automatically increment the attribute values whilst arraying an attributed block reference (or other objects).
This lsp helps you add a prefix or suffix to any block attribute, but to all blocks at the same time, I had a similar case like yours so I combines above attnum.lsp with this Presuf.lsp.
First use attnum to set tag field to increasing numbers 1,2,3,4,etc. Then isolate the objects and run presuf, indicate whether is a suffix or prefix to add, indicate the desired value and then select all the objects.
(defun c:presuf ( / as el en i ss str typ )
(initget "Prefix Suffix")
(setq typ (cond ((getkword "\nAdd Prefix or Suffix? [Prefix/Suffix] <Prefix>: ")) ("Prefix")))
(setq str (getstring t (strcat typ " to Add: ")))
(if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i))))
(while (eq "ATTRIB" (cdr (assoc 0 (setq el (entget (setq en (entnext en)))))))
(setq as (cdr (assoc 1 el)))
(if (eq "Prefix" typ)
(if (not (wcmatch as (strcat str "*")))
(entmod (subst (cons 1 (strcat str as)) (assoc 1 el) el))
)
(if (not (wcmatch as (strcat "*" str)))
(entmod (subst (cons 1 (strcat as str)) (assoc 1 el) el))
)
)
)
)
)
(princ)
)
If I had the attribute tags, or block names I could take a stab at answering your question with a custom solution, however, I do believe you can find all you need here (BFind or Global Attribute Extractor & Editor).
I'm trying to do a function who implements a sum of n cubes:
1^3 + 2^3 + 3^3 + ... + n^3 = sum
My function should receive a sum and return a n or -1 if n doesn't exists.
Some examples:
(find-n 9) ; should return 2 because 1^3 + 2^3 = 9
(find-n 100) ; should return 4 because 1^3 + 2^3 + 3^3 + 4^3 = 100
(find-n 10) ; should return -1
After some work I made these two functions:
; aux function
(defn exp-3 [base] (apply *' (take 3 (repeat base))))
; main function
(defn find-n [m]
(loop [sum 0
actual-base 0]
(if (= sum m)
actual-base
(if (> sum m)
-1
(recur (+' sum (exp-3 (inc actual-base))) (inc actual-base))))))
These functions are working properly but is taking too long to evaluate operations with BigNumbers, as example:
(def sum 1025247423603083074023000250000N)
(time (find-n sum))
; => "Elapsed time: 42655.138544 msecs"
; => 45001000
I'm asking this question to raise some advices of how can I make this function faster.
This is all about algebra, and little to do with Clojure or programming. Since this site does not support mathematical typography, let's express it in Clojure.
Define
(defn sigma [coll] (reduce + coll))
and
(defn sigma-1-to-n [f n]
(sigma (map f (rest (range (inc n))))))
(or
(defn sigma-1-to-n [f n]
(->> n inc range rest (map f) sigma))
)
Then the question is, given n, to find i such that (= (sigma-1-to-n #(* % % %) i) n).
The key to doing this quickly is Faulhaber's formula for cubes. It tells us that the following are equal, for any natural number i:
(#(*' % %) (sigma-1-to-n identity i))
(sigma-1-to-n #(* % % %) i)
(#(*' % %) (/ (*' i (inc i)) 2))
So, to be the sum of cubes, the number
must be a perfect square
whose square root is the sum of the first so many numbers.
To find out whether a whole number is a perfect square, we take its approximate floating-point square root, and see whether squaring the nearest integer recovers our whole number:
(defn perfect-square-root [n]
(let [candidate (-> n double Math/sqrt Math/round)]
(when (= (*' candidate candidate) n)
candidate)))
This returns nil if the argument is not a perfect square.
Now that we have the square root, we have to determine whether it is the sum of a range of natural numbers: in ordinary algebra, is it (j (j + 1)) / 2, for some natural number j.
We can use a similar trick to answer this question directly.
j (j + 1) = (j + 1/2)^2 + 1/4
So the following function returns the number of successive numbers that add up to the argument, if there is one:
(defn perfect-sum-of [n]
(let [j (-> n (*' 2)
(- 1/4)
double
Math/sqrt
(- 0.5)
Math/round)]
(when (= (/ (*' j (inc j)) 2) n)
j)))
We can combine these to do what you want:
(defn find-n [big-i]
{:pre [(integer? big-i) ((complement neg?) big-i)]}
(let [sqrt (perfect-square-root big-i)]
(and sqrt (perfect-sum-of sqrt))))
(def sum 1025247423603083074023000250000N)
(time (find-n sum))
"Elapsed time: 0.043095 msecs"
=> 45001000
(Notice that the time is about twenty times faster than before, probably because HotSpot has got to work on find-n, which has been thoroughly exercised by the appended testing)
This is obviously a lot faster than the original.
Caveat
I was concerned that the above procedure might produce false negatives (it will never produce a false positive) on account of the finite precision of floating point. However, testing suggests that the procedure is unbreakable for the sort of number the question uses.
A Java double has 52 bits of precision, roughly 15.6 decimal places. The concern is that with numbers much bigger than this, the procedure may miss the exact integer solution, as the rounding can only be as accurate as the floating point number that it starts with.
However, the procedure solves the example of a 31 digit integer correctly. And testing with many (ten million!) similar numbers produces not one failure.
To test the solution, we generate a (lazy) sequence of [limit cube-sum] pairs:
(defn generator [limit cube-sum]
(iterate
(fn [[l cs]]
(let [l (inc l)
cs (+' cs (*' l l l))]
[limit cs]))
[limit cube-sum]))
For example,
(take 10 (generator 0 0))
=> ([0 0] [1 1] [2 9] [3 36] [4 100] [5 225] [6 441] [7 784] [8 1296] [9 2025])
Now we
start with the given example,
try the next ten million cases and
remove the ones that work.
So
(remove (fn [[l cs]] (= (find-n cs) l)) (take 10000000 (generator 45001000 1025247423603083074023000250000N)))
=> ()
They all work. No failures. Just to make sure our test is valid:
(remove (fn [[l cs]] (= (find-n cs) l)) (take 10 (generator 45001001 1025247423603083074023000250000N)))
=>
([45001001 1025247423603083074023000250000N]
[45001002 1025247514734170359564546262008N]
[45001003 1025247605865263720376770289035N]
[45001004 1025247696996363156459942337099N]
[45001005 1025247788127468667814332412224N]
[45001006 1025247879258580254440210520440N]
[45001007 1025247970389697916337846667783N]
[45001008 1025248061520821653507510860295N]
[45001009 1025248152651951465949473104024N]
[45001010 1025248243783087353664003405024N])
All ought to fail, and they do.
Just avoiding the apply (not really all that fast in CLJ) gives you a 4x speedup:
(defn exp-3 [base]
(*' base base base))
And another 10%:
(defn find-n [m]
(loop [sum 0
actual-base 0]
(if (>= sum m)
(if (= sum m) actual-base -1)
(let [nb (inc actual-base)]
(recur (+' sum (*' nb nb nb)) nb)))))
The following algorithmic-based approach relies on one simple formula which says that the sum of the cubes of the first N natural numbers is: (N*(N+1)/2)^2
(defn sum-of-cube
"(n*(n+1)/2)^2"
[n]
(let [n' (/ (*' n (inc n)) 2)]
(*' n' n')))
(defn find-nth-cube
[n]
((fn [start end prev]
(let [avg (bigint (/ (+' start end) 2))
cube (sum-of-cube avg)]
(cond (== cube n) avg
(== cube prev) -1
(> cube n) (recur start avg cube)
(< cube n) (recur avg end cube))))
1 n -1))
(time (find-nth-cube 1025247423603083074023000250000N))
"Elapsed time: 0.355177 msecs"
=> 45001000N
We want to find the number N such that the sum of 1..N cubes is some number X. To find if such a number exists, we can perform a binary search over some range for it by applying the above formula to see whether the result of the formula equals X. This approach works because the function at the top is increasing, and thus any value f(n) which is too large means that we must look for a lower number n, and any value f(n) which is too small means that we must look for a larger number n.
We choose a (larger than necessary, but easy and safe) range of 0 to X. We will know that the number exists if our formula applied to a given candidate number yields X. If it does not, we continue the binary search until either we find the number, or until we have tried the same number twice, which indicates that the number does not exist.
With an upper bound of logN, only takes 1 millisecond to compute 1E100 (1 googol), so it's very efficient for an algorithmic approach.
You may want to use some mathematical tricks.
(a-k)^3 + (a+k)^3 = 2a^3+(6k^2)a
So, a sum like:
(a-4)^3+(a-3)^3+(a-2)^3+(a-1)^3+a^3+(a+1)^3+(a+2)^3+(a+3)^3+(a+4)^3
= 9a^3+180a
(please confirm correctness of the calculation).
Using this equation, instead of incrementing by 1 every time, you can jump by 9 (or by any 2 k+1 you like). You can check for the exact number whenever you hit a bigger number than n.
Other way to improve is to have a table of ns and sums, by making a batch of computations once and use this table later in function find-n.
DrRacket user.
I'm struggling to understand how this program works.I wrote it myself and it does what it must but I can't understand how.
I define while loops as:
(define (while test body)
(if (test)
(begin
(body)
(while test body))
(void)))
Now I need to write a program that applies the given procedure to each element of a mutable list.
Here what I wrote:
(define (mlist-map-while f x)
(while (lambda() (not (null? x)))
(lambda ()
(set-mcar! x (f (mcar x)))
(set! x (mcdr x))))
(void))
So, defining
list1 (mlist 1 2 3)
and applying
(mlist-map-while (lambda (x) (+ x 1)) list1)
we get '(2 3 4).
The thing that I don't understand is how the first element of the list stays in it, because if it's done how I wrote here
(set! x (mcdr x))
the first procedure that sets -mcar! must be useless and be overlapped with the second. Like in this example:
(define list1 (mlist 1 2 3))
(set-mcar! list1 9)
(set-mcdr! list1 (mcdr list!))
and we lack the first element, but this program somehow leaves it in and gives the desired output. I would like to know how it works and whether there is another way of traversing the given list.
There is a big difference between set-cdr! abd set!. The first alters the pair's cdr pointer, while the latter alters the binding, thus what the name should point to.
In your mlist-map-while the variable x alters the car, then changes what x represents, to be the cdr of x. It never changes the cdr so your binding list1 always points to the first pair while x points to the first, then second, etc...
Thus it's more like this:
(define list1 (mlist 1 2 3))
(define list1-ref list1) ; variable pointing to the same value as list1
(set-mcar! list1-ref 9) ; set-car! changes the pair
(set! list1-ref (mcdr list)) ; set! updates what list1-ref points to
list1 ; ==> (9 2 3)
list-ref ; ==> (2 3)
You can iterate over a list in the same fashion without using set!, with recursion:
(define (fold function init lst)
(if (null? lst)
init
(fold function
(function (car lst) init)
(cdr lst))))
(fold + 0 '(1 2 3)
; ==> 6
(fold cons '() '(1 2 3))
; ==> (3 2 1)
Notice that here we recurse and change what lst is, to be the cdr. Every recursion has its own lst, which is not to be confused with the caller's own. It ends up doing the same as set! in your example, without mutation.
So; I'm a hobbyist who's trying to work through SICP (it's free!) and there is an example procedure in the first chapter that is meant to count the possible ways to make change with american coins; (change-maker 100) => 292. It's implemented something like:
(define (change-maker amount)
(define (coin-value n)
(cond ((= n 1) 1)
((= n 2) 5)
((= n 3) 10)
((= n 4) 25)
((= n 5) 50)))
(define (iter amount coin-type)
(cond ((= amount 0) 1)
((or (= coin-type 0) (< amount 0)) 0)
(else (+ (iter amount
(- coin-type 1))
(iter (- amount (coin-value coin-type))
coin-type)))))
(iter amount 5))
Anyway; this is a tree-recursive procedure, and the author "leaves as a challenge" finding an iterative procedure to solve the same problem (ie fixed space). I have not had luck figuring this out or finding an answer after getting frustrated. I'm wondering if it's a brain fart on my part, or if the author's screwing with me.
The simplest / most general way to eliminate recursion, in general, is to use an auxiliary stack -- instead of making the recursive calls, you push their arguments into the stack, and iterate. When you need the result of the recursive call in order to proceed, again in the general case, that's a tad more complicated because you're also going to have to be able to push a "continuation request" (that will come off the auxiliary stack when the results are known); however, in this case, since all you're doing with all the recursive call results is a summation, it's enough to keep an accumulator and, every time you get a number result instead of a need to do more call, add it to the accumulator.
However, this, per se, is not fixed space, since that stack will grow. So another helpful idea is: since this is a pure function (no side effects), any time you find yourself having computed the function's value for a certain set of arguments, you can memoize the arguments-result correspondence. This will limit the number of calls. Another conceptual approach that leads to much the same computations is dynamic programming [[aka DP]], though with DP you often work bottom-up "preparing results to be memoized", so to speak, rather than starting with a recursion and working to eliminate it.
Take bottom-up DP on this function, for example. You know you'll repeatedly end up with "how many ways to make change for amount X with just the smallest coin" (as you whittle things down to X with various coin combinations from the original amount), so you start computing those amount values with a simple iteration (f(X) = X/value if X is exactly divisible by the smallest-coin value value, else 0; here, value is 1, so f(X)=X for all X>0). Now you continue by computing a new function g(X), ways to make change for X with the two smallest coins: again a simple iteration for increasing X, with g(x) = f(X) + g(X - value) for the value of the second-smallest coin (it will be a simple iteration because by the time you're computing g(X) you've already computed and stored f(X) and all g(Y) for Y < X -- of course, g(X) = 0 for all X <= 0). And again for h(X), ways to make change for X with the three smallest coins -- h(X) = g(X) + g(X-value) as above -- and from now on you won't need f(X) any more, so you can reuse that space. All told, this would need space 2 * amount -- not "fixed space" yet, but, getting closer...
To make the final leap to "fixed space", ask yourself: do you need to keep around all values of two arrays at each step (the one you last computed and the one you're currently computing), or, only some of those values, by rearranging your looping a little bit...?
Here is my version of the function, using dynamic programming. A vector of size n+1 is initialized to 0, except that the 0'th item is initially 1. Then for each possible coin (the outer do loop), each vector element (the inner do loop) starting from the k'th, where k is the value of the coin, is incremented by the value at the current index minus k.
(define (counts xs n)
(let ((cs (make-vector (+ n 1) 0)))
(vector-set! cs 0 1)
(do ((xs xs (cdr xs)))
((null? xs) (vector-ref cs n))
(do ((x (car xs) (+ x 1))) ((< n x))
(vector-set! cs x (+ (vector-ref cs x)
(vector-ref cs (- x (car xs)))))))))
> (counts '(1 5 10 25 50) 100)
292
You can run this program at http://ideone.com/EiOVY.
So, in this thread, the original asker of the question comes up with a sound answer via modularization. I would suggest, however, that his code can easily be optimized if you notice that cc-pennies is entirely superfluous (and by extension, so is cc-nothing)
See, the problem with the way cc-pennies is written is that, because there's no lower denomination to go, all it will do by mimicking the structure of the higher denomination procedures is iterate down from (- amount 1) to 0, and it will do this every time you pass it an amount from the cc-nickels procedure. So, on the first pass, if you try 1 dollar, you will get an amount of 100, so (- amount 1) evaluates to 99, which means you'll undergo 99 superfluous cycles of the cc-pennies and cc-nothing cycle. Then, nickels will pass you 95 as amount, so you get 94 more wasted cycles, so on and so forth. And that's all before you even move up the tree to dimes, or quarters, or half-dollars.
By the time you get to cc-pennies, you already know you just want to up the accumulator by one, so I'd suggest this improvement:
(define (count-change-iter amount)
(cc-fifties amount 0))
(define (cc-fifties amount acc)
(cond ((= amount 0) (+ 1 acc))
((< amount 0) acc)
(else (cc-fifties (- amount 50)
(cc-quarters amount acc)))))
(define (cc-quarters amount acc)
(cond ((= amount 0) (+ 1 acc))
((< amount 0) acc)
(else (cc-quarters (- amount 25)
(cc-dimes amount acc)))))
(define (cc-dimes amount acc)
(cond ((= amount 0) (+ 1 acc))
((< amount 0) acc)
(else (cc-dimes (- amount 10)
(cc-nickels amount acc)))))
(define (cc-nickels amount acc)
(cond ((= amount 0) (+ 1 acc))
((< amount 0) acc)
(else (cc-nickels (- amount 5)
(cc-pennies amount acc)))))
(define (cc-pennies amount acc)
(+ acc 1))
Hope you found this useful.
The solution I came up with is to keep count of each type of coin you're using in a 'purse'
The main loop works like this; 'denom is the current denomination, 'changed is the total value of coins in the purse, 'given is the amount of change I need to make and 'clear-up-to takes all the coins smaller than a given denomination out of the purse.
#lang scheme
(define (sub changed denom)
(cond
((> denom largest-denom)
combinations)
((>= changed given)
(inc-combinations-if (= changed given))
(clear-up-to denom)
(jump-duplicates changed denom)) ;checks that clear-up-to had any effect.
(else
(add-to-purse denom)
(sub
(purse-value)
0
))))
(define (jump-duplicates changed denom)
(define (iter peek denom)
(cond
((> (+ denom 1) largest-denom)
combinations)
((= peek changed)
(begin
(clear-up-to (+ denom 1))
(iter (purse-value) (+ denom 1))))
(else
(sub peek (+ denom 1)))))
(iter (purse-value) denom))
After reading Alex Martelli's answer I came up with the purse idea but just got around to making it work
You can solve it iteratively with dynamic programming in pseudo-polynomial time.