Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
So for my HW, using these structs:
(define-struct Plus (tl tr))
(define-struct Neg (t))
(define-struct Times (tl tr))
I have to solve for the following:
height : num-tree -> num which counts the number of nodes in the longest branch of the tree.
and
unparse : num-tree -> string to construct the Racket expression matching the given tree.
An example for each are the following:
(height (make-Plus (make-Neg (make-Times 3 4)) (make-Neg 6)))
=> 4
and
(unparse (make-Plus (make-Neg (make-Times 3 4)) (make-Neg 6)))
=> "(+ (- (* 3 4)) (- 6))"
My questions for the height problem is how can I check which is the longest side of a given tree? When I have a struct with two arguments (lets say Times), how can I check, which one has the longer branch? A previous problem had us solve the size of the tree but the thing is, it is really easy to solve for the size of a tree since you just do +1 to all of the conditions until you reach the base case. The height is different because you do not want to count both the nodes of the left and the right of the tree, but only count the one that has the biggest height.
For unparse, we also had to do a problem that has us evaluate the number tree. However, I do not know how to tackle this since you cannot really use the evaluate function that I made in order to solve this problem.
Any suggestions to tackle this problem?
For procedure height, you simply need to use max if the structure has 2 fields:
(define (height tree)
(cond
((Plus? tree) (add1 (max (height (Plus-tl tree)) (height (Plus-tr tree)))))
((Times? tree) (add1 (max (height (Times-tl tree)) (height (Times-tr tree)))))
((Neg? tree) (add1 (height (Neg-t tree))))
(else 1)))
For unparse it's just a matter of concatenating strings, no evaluation needed:
(define (unparse tree)
(cond
((Plus? tree) (format "(+ ~a ~a)" (unparse (Plus-tl tree)) (unparse (Plus-tr tree))))
((Times? tree) (format "(* ~a ~a)" (unparse (Times-tl tree)) (unparse (Times-tr tree))))
((Neg? tree) (format "(- ~a)" (unparse (Neg-t tree))))
(else (format "~a" tree))))
Testing:
(define x (make-Plus (make-Neg (make-Times 3 4)) (make-Neg 6)))
(height x)
=> 4
(unparse x)
=> "(+ (- (* 3 4)) (- 6))"
Related
I want to calculate the sum of digits of a number in Scheme. It should work like this:
>(sum-of-digits 123)
6
My idea is to transform the number 123 to string "123" and then transform it to a list '(1 2 3) and then use (apply + '(1 2 3)) to get 6.
but it's unfortunately not working like I imagined.
>(string->list(number->string 123))
'(#\1 #\2 #\3)
Apparently '(#\1 #\2 #\3) is not same as '(1 2 3)... because I'm using language racket under DrRacket, so I can not use the function like char->digit.
Can anyone help me fix this?
An alternative method would be to loop over the digits by using modulo. I'm not as used to scheme syntax, but thanks to #bearzk translating my Lisp here's a function that works for non-negative integers (and with a little work could encompass decimals and negative values):
(define (sum-of-digits x)
(if (= x 0) 0
(+ (modulo x 10)
(sum-of-digits (/ (- x (modulo x 10)) 10)))))
Something like this can do your digits thing arithmetically rather than string style:
(define (digits n)
(if (zero? n)
'()
(cons (remainder n 10) (digits2 (quotient n 10))))
Anyway, idk if its what you're doing but this question makes me think Project Euler. And if so, you're going to appreciate both of these functions in future problems.
Above is the hard part, this is the rest:
(foldr + (digits 12345) 0)
OR
(apply + (digits 1234))
EDIT - I got rid of intLength above, but in case you still want it.
(define (intLength x)
(define (intLengthP x c)
(if (zero? x)
c
(intLengthP (quotient x 10) (+ c 1))
)
)
(intLengthP x 0))
Those #\1, #\2 things are characters. I hate to RTFM you, but the Racket docs are really good here. If you highlight string->list in DrRacket and hit F1, you should get a browser window with a bunch of useful information.
So as not to keep you in the dark; I think I'd probably use the "string" function as the missing step in your solution:
(map string (list #\a #\b))
... produces
(list "a" "b")
A better idea would be to actually find the digits and sum them. 34%10 gives 4 and 3%10 gives 3. Sum is 3+4.
Here's an algorithm in F# (I'm sorry, I don't know Scheme):
let rec sumOfDigits n =
if n<10 then n
else (n%10) + sumOfDigits (n/10)
This works, it builds on your initial string->list solution, just does a conversion on the list of characters
(apply + (map (lambda (d) (- (char->integer d) (char->integer #\0)))
(string->list (number->string 123))))
The conversion function could factored out to make it a little more clear:
(define (digit->integer d)
(- (char->integer d) (char->integer #\0)))
(apply + (map digit->integer (string->list (number->string 123))))
(define (sum-of-digits num)
(if (< num 10)
num
(+ (remainder num 10) (sum-of-digits (/ (- num (remainder num 10)) 10)))))
recursive process.. terminates at n < 10 where sum-of-digits returns the input num itself.
As background I'm trying to make a NLP application in Racket and I arrived at the part where I have to stem the words (I also obtained their frequency).
I am using the (planet dyoo/porter-stemmer) package in order to stem, and as an example we can write:
(map (λ(x) (list (stem (first x)) (second x)))
'(("cryed" 1)
("racketeer" 2)
("crying" 3)
("playing" 4)
("racketing" 5)
("plays" 6)
("Racket" 7)))
Which produces: '(("cry" 1) ("racket" 2) ("cry" 3) ("plai" 4) ("racket" 5) ("plai" 6) ("racket" 7))
Now my goal is to sum up the frequency for each term, aka to arrive at: '(("cry" 4) ("racket" 14) ("plai" 10))
I came up with a way to do it, but I don't like my solution:
(define (frequency string)
(map (λ(x) (list (first x) (length x)))
(group-by (λ(x) x) (string-split string))))
(define (recalculate lst)
(frequency
(string-join
(flatten
(map (λ(x) (make-list (second x) (first x))) lst)))))
Basically I retype each word as many times as it's frequency, then make a single string containing all words and finally compute the frequency again. Is there a simpler(faster) way to achieve this?
I should perhaps add that the order doesn't matter ("plai" can come up before "cry" and so on). Also I'm looking for a simpler solution because I'm gonna have to use larger datasets and I want to make this faster (I'd also be glad even if the frequency function can be made more faster).
You could create an add-count procedure that takes a list of counts and a new count as arguments, and adds the count to the list if there are no similarly tagged counts already in the list, or combines the new count with an existing count.
#lang racket
(define (get-tag c) (first c))
(define (get-val c) (second c))
(define (add-count cs c)
(let* ((k (get-tag c))
(v (get-val c))
(old-count (assoc k cs)))
(if old-count
(cons (list k (+ v (get-val old-count)))
(remove old-count cs))
(cons c cs))))
Here get-tag and get-val are just convenience procedures to access the tag and value stored in a count. The assoc procedure is used to extract a copy of the first count in cs matching the new count c to be added. This count is stored in old-count, the value of which is used to create a new count which is added to the list after removing old-count from the original list cs.
With the add-count procedure defined, a procedure reduce-counts could be defined that goes through all of the counts and accumulates them to an empty list by using add-count. The resulting list will have the counts combined.
(define (reduce-counts cs (acc '()))
(if (null? cs)
acc
(reduce-counts (rest cs) (add-count acc (first cs)))))
Here is a test run:
reduce-counts.rkt> (define test-counts '(("cry" 1) ("racket" 2) ("cry" 3) ("play" 4) ("racket" 5) ("play" 6) ("racket" 7)))
reduce-counts.rkt> (reduce-counts test-counts)
'(("racket" 14) ("play" 10) ("cry" 4))
As an alternative approach you could use filter to collect counts with similar tags in a list, and combine those into a new count after summing the values. The combined counts can be collected in an accumulator before filtering the input to remove the tags which were just combined. This process can be repeated recursively until all counts have been combined, removed, and collected.
;;; An alternate solution
(define (combine-like-counts cs)
(list (get-tag (first cs))
(foldl (lambda (c x) (+ x (get-val c))) 0 cs)))
(define (reduce-counts cs (acc '()))
(if (null? cs)
acc
(let* ((k (get-tag (first cs)))
(k-tag? (lambda (c) (equal? k (get-tag c))))
(like (filter k-tag? cs))
(remaining (filter (negate k-tag?) cs)))
(reduce-counts remaining
(cons (combine-like-counts like) acc)))))
Here the combine-like-counts procedure assumes that all counts in the input list share the same tag, so a new count is formed by taking the tag and the sum of all values into a list.
The new reduce-counts procedure returns whatever has been placed in the accumulator when the input is the empty list, otherwise the tag of the first count is saved and used to create the k-tag? predicate, which is then used with filter to create a list of matching counts and a list of the remaining counts with all matching counts removed. The list of matching counts is combined into a single count with combine-like-counts and added to the accumulator, which is passed along with remaining recursively to reduce-counts.
This works as before, although the ordering has changed:
reduce-counts.rkt> (define test-counts '(("cry" 1) ("racket" 2) ("cry" 3) ("play" 4) ("racket" 5) ("play" 6) ("racket" 7)))
reduce-counts.rkt> (reduce-counts test-counts)
'(("play" 10) ("racket" 14) ("cry" 4))
I would suspect that these two implementations would have different performance characteristics depending on the particulars of their input data. My hunch is that the second would fare better for large input that contained large quantities of each tag, but the real answer would come from testing on some representative data samples.
If you are really concerned about performance for large amounts of data, you might consider converting the data to a hash table and using some of the built-in dictionary procedures to arrive at a similar solution.
This is a followup to my previous post here
I've a 2D geometry created using the following code, ref.
(defun graph ( pts sls tls )
( (lambda ( l )
(foreach x l (text (cdr x) (itoa (car x)) 0.0 1))
(mapcar
'(lambda ( a b / p q r )
(setq p (cdr (assoc a l))
q (cdr (assoc b l))
r (angle p q)
)
(entmake (list '(0 . "LINE") (cons 10 p) (cons 11 q) '(62 . 8)))
(text
(mapcar '(lambda ( x y ) (/ (+ x y) 2.0)) p q)
(roundupto (distance p q) 12.4)
(if (and (< (* pi 0.5) r) (<= r (* pi 1.5))) (+ r pi) r)
2
)
)
sls tls
)
)
(mapcar 'cons (vl-sort (append sls tls) '<) pts)
)
)
(defun text ( p s a c )
(entmake
(list
'(0 . "TEXT")
(cons 10 p)
(cons 11 p)
(cons 50 a)
(cons 01 s)
(cons 62 c)
'(40 . 2)
'(72 . 1)
'(73 . 2)
)
)
)
(defun roundupto ( x m / d r )
(setq d (getvar 'dimzin))
(setvar 'dimzin 8)
(setq r (rtos (* m (fix (+ 1 -1e-8 (/ x (float m))))) 2 8))
(setvar 'dimzin d)
r
)
Input:
(graph
'((75 25) (115 45) (90 60) (10 5) (45 0) (45 55) (0 25) (10 50) (115 25))
'(1 1 1 2 2 3 4 4 6 7 2)
'(2 4 5 3 6 6 5 7 7 8 9)
)
Output:
The actual dimensions don't match the value displayed in the text (in yellow) over the lines.
For instance, 62 is the value displayed and 54.0833 is the actual dimension. And I want to rescale the actual lengths to the values displayed, in yellow, over the lines.
I understand the coordinates displayed in the input provided above have to be varied. Probably, the first coordinate can be fixed and the subsequent coordinates can be shifted.
Any suggestions on how to do this will be really helpful.
EDIT: The solution provided here in an answer to my previous post Scaling lengths in an AutoCAD diagram scales only the dimension displayed in yellow using the output obtained from roundupto function. The purpose behind posting this question is to ask for suggestions for scaling the actual lengths and not just the dimensions displayed in yellow.
EDIT2: Adding additional details
If one directly loads the input file in AutoCAD, the yellow text displayed in the following image is the actual dimensions
And I want to convert the dimensions to the corresponding yellow labels displayed in the following image:
Note: The labels displayed in the second image in EDIT2 were altered externally using an AutoLISP code to merely show how the actual lengths of the corresponding lines have to be scaled. In the first image displayed in EDIT2, the edge labels exactly match the lengths of the corresponding lines.
Is there a constant error factor on all values or does it differ on each one?
I mean if you calculate 60/54.0833 you get roughly 1.13. If you do this on the other lengths you get what?
If there is a constant "zoom factor" you could multiply your vertices with that and afterwards change the labeling (the yellow numbers).
I admit, I do not know AutoCAD especially well, so I just can give hints, no solutions in code unless you would talk me through your code syntax.
I would suspect some rounding or division errors to be the reason for the value discrepancies. Can you check on that? For example is a b / p q r an integer or a float result? How does roundupto work? which precision has pi? Can you truncate or normalize your values to all be the same precision (like "to three digits behind the comma", for example)?
What are the meanings of the parameters slsand tls? pts I could identify as "list of points" from the input you posted.
Game rules
Consider a simple 2-player game played as follows: An even number of coins is laid out in a row. Taking turns, each player removes the coin on one of the ends of the row. The object is to have the highest value in coins when all coins have been taken.
Player one finds the sum of all of the even-numbered coins, and all the odd-numbered coins. If the sum of the odd numbered coins is higher, player one takes the leftmost coin; otherwise he takes the rightmost.
Player two has a choice, with an odd number of coins. So he tries taking a coin from both ends, to see which option would leave player 1 worse off.
The problem
I basically want to implement multitheading to this program. I am still very new to Clojure, and I couldn't really find any good material online, regarding multithreading, that could be applied to my program.
The code
(ns game.core
(:gen-class))
(defn vector-from-string [s]
(drop 1 (map read-string (clojure.string/split (clojure.string/trim-newline s) #" "))))
(defn string-from-file [f]
(slurp f))
(defn sum-of-evens [v]
(def evens (vector))
(loop [v v, index 1]
(when (seq v)
(if (even? index)
(def evens (conj evens (first v))))
(recur (rest v) (inc index))))
(reduce + evens))
(defn sum-of-odds [v]
(def odds (vector))
(loop [v v, index 1]
(when (seq v)
(if (odd? index)
(def odds (conj odds (first v))))
(recur (rest v) (inc index))))
(reduce + odds))
(defn player-two [v p1score p2score]
(if (not (empty? v))
(if (> (max (sum-of-odds (drop 1 v)) (sum-of-evens (drop 1 v))) (max (sum-of-odds (drop-last v)) (sum-of-evens (drop-last v))))
(player-one (drop-last v) p1score (+ p2score(last v)))
(player-one (drop 1 v) p1score (+ p2score (first v))))
(println "p1score" p1score "p2score" p2score)))
(defn player-one [v p1score p2score]
(if (not (empty? v))
(if (> (sum-of-odds v) (sum-of-evens v))
(player-two (drop 1 v) (+ p1score (first v)) p2score)
(player-two (drop-last v) (+ p1score (last v)) p2score))
(println "p1score" p1score "p2score" p2score)))
(defn -main [& args]
(let [v (vector-from-string (string-from-file "numbers.txt")) ]
(player-one v 0 0)))
So -main runs the player-one function first, and player-one calls player-two, and they both continue on until the end of the program. I would like to somehow implement multithreading to speed up the executing of this game with a higher amount of starting coins.
Your code is currently very unidiomatic.
A few remarks that hopefully help you getting into the right direction:
A def inside a defn (or def) is (almost) always wrong. You're thinking in terms of variable assignment and mutable variables here. This is not how Clojure works. Use variables in your recur instead, if you absolutely must, use a local atom (also almost always wrong, but less often wrong than def inside defn).
Your loops are unnecessarily complicated. You want to sum over the elements at even or odd indices? Use a combination of reduce, take-nth and rest:
(take-nth 2 [1 2 3])
;=> (1 3)
(take-nth 2 (rest [1 2 3 4]))
;=> (2 4)
The whole things looks like you're compiling this over and over again and then run the JVM with it. Am I right? The preferred way is to work at the REPL. How to access it, depends on which editing environment you use. There are many beginner-friendly REPLs out there. Gorilla REPL is one example.
Once you got your code and development workflow in better shape, you may want to explore functions like pmap and future for easy access to multi-threading. More advanced stuff involves a library called core.async, but that's probably not the ideal route for the beginner. You can also fall back to Java interop to create your threads. Again something that, while not really hard to do, requires a bit of experience with Clojure.
Hope that helps, even it is not a direct answer to your question.
First let's look at some issues in your example that will need to be addressed before parallelizing this code.
sum-of-evens is using def inside a function, which is almost always a mistake. This might seem to have the effect you want, but it's not the right way to achieve it. defs are typically used for namespace-level (at the same level as your function defns) values. We can refactor sum-of-evens to not rely on unintentionally side-effecty behavior via def:
(defn sum-of-evens [v]
(loop [v v
index 1
evens []]
(if (seq v)
(recur (rest v)
(inc index)
(if (even? index) ;; add a binding to loop, not a def
(conj evens (first v))
evens)) ;; pass unchanged value when necessary
(reduce + evens))))
But we can further simplify this function with keep-indexed:
(defn sum-of-evens [coll]
(->> coll
(keep-indexed (fn [i v] (when (even? (inc i))
v)))
(apply +)))
And when we do the same for sum-of-odds, we can see the functions are nearly identical except for the condition they use: odd? vs. even?. We can make another function that takes a predicate function:
(defn sum-by-index-pred [f coll]
(->> coll
(keep-indexed (fn [i v] (when (f i) v)))
(apply +)))
;; using partial application and function composition
(def sum-of-evens (partial sum-by-index-pred (comp even? inc)))
(def sum-of-odds (partial sum-by-index-pred (comp odd? inc)))
Looking at the implementation of player-one and player-two, they seem to be mutually recursive. I don't see how you could parallelize this to make it any faster because each turn is dependent on the previous turn's outcome; there's nothing to parallelize.
I'd suggest refactoring this so that your game rules and state are computed in one place, rather than mutually recursive functions.
(loop [scores (array-map :player-1 0 :player-2 0)
turns (cycle (keys scores))
vs (shuffle (range 100))]
(if (seq vs)
(let [higher-odds? (> (sum-of-odds vs) (sum-of-evens vs))
scores (if higher-odds?
(update scores (first turns) + (first vs))
(update scores (first turns) + (last vs)))
remain (if higher-odds?
(rest vs)
(butlast vs))]
(recur scores (rest turns) remain))
(prn scores)))
;; {:player-1 2624, :player-2 2326}
I'm not sure if this preserves your original game logic but it should be close, and it does generalize it for more than two players. Try adding :player-3 0 to the starting scores.
I'm pretty familiar with Racket, and many in the Scheme and Lisp family, but I have no idea what is up with this error, or what is causing it:
network-biases: contract violation;
given value instantiates a different structure type with the same name
expected: network?
given: (network ...) <-- I omitted this because its useless.
Heres the function where the error is (I have a gist of the rest):
(define (update-mini-batch net mini-batch eta)
(define nabla-b (map (lambda (b)
(apply grid (shape b))) (network-biases net)))
(define nabla-w (map (lambda (w)
(apply grid (shape w))) (network-weights net)))
(define-values (nabla-b-new nabla-w-new)
(foldl (lambda (lst bw)
(define x (first lst))
(define y (second lst))
(define-values (nabla-b nabla-w) bw)
(define-values (delta-nabla-b delta-nabla-w) (backprop net x y))
(define nabla-b-new (+/ nabla-b delta-nabla-b))
(define nabla-w-new (+/ nabla-w delta-nabla-w))
(values nabla-b-new nabla-w-new)) (values nabla-b nabla-w) mini-batch))
(struct-copy network net
[biases (map (lambda (b nb)
(- b (* nb (/ eta (length mini-batch)))))
(network-biases net) nabla-b-new)]
[weights (map (lambda (w nw)
(- w (* nw (/ eta (length mini-batch)))))
(network-weights net) nabla-w-new)]))
I couldn't get an MCVE that actually threw an error, so I don't have one to give.
The distilled basics of what I'm trying to do in the above function is this:
Calculate new values for a structure's properties, and create a new structure with those new properties.
- Thanks!!
Structures in Racket are generative. This means that each time
(struct network (num-layers sizes biases weights) #:transparent)
is run, a new type of structure is created. These are all named network.
The error message you see is usually due to evaluating the structure definition twice (and it is a bit confusing since the two types have the same name).
I can't see anywhere in your code that could lead to (struct network ...) being run twice. Are you using DrRacket or an alternative environment that doesn't reset namespace?
If I open "nn.rkt" and run it, will I see the error?