common lisp latitude and longitude to course - location

The basis of my current project is to write some code that can calculate a direct course between two points. There was no code I could find online for common lisp, so I had to translate what I had available. I think I did so correctly, but it still won't run. Any Help would be appreciated.
I hit a roadblock, any ideas? The following errors occurs:
;Compiler warnings for "nav.lisp" :
; In COURSE-CALC: Undefined function LAT1
; In COURSE-CALC: Undefined function LAT1
; In COURSE-CALC: Undefined function LAT2
What I don't understand is why the compiler thinks that the variables are functions.
here is what I have so far:
(defparameter *earth-radius* 6372.8)
(defparameter *e* (exp 1))
(defparameter *rad-conv* (/ pi 180))
(defun km->miles (km)
(* km .621371))
(defun miles->km (miles)
(* miles 1.60934))
(defun mph->mpm (mph)
(/ mph 60))
(defun kph->kpm (kph)
(/ kph 60))
(defun deg->rad (deg)
(* deg *rad-conv*))
(defun haversine (x)
(expt (sin (/ x 2)) 2))
(defun dist-rad (lat1 lng1 lat2 lng2)
(let* ((hlat (haversine (- lat2 lat1)))
(hlng (haversine (- lng2 lng1)))
(root (sqrt (+ hlat (* (cos lat1) (cos lat2) hlng)))))
(* 2 *earth-radius* (asin root))))
(defun dist-deg (lat1 lng1 lat2 lng2)
(dist-rad (deg->rad lat1)
(deg->rad lng1)
(deg->rad lat2)
(deg->rad lng2)))
;acos(sin(lat2)-sin(lat1)*cos(d)) / (sin(d)*cos(lat1))
(defun course-calc (lat1 lng1 lat2 lng2)
(acos(/(*(- (sin(lat2)) (sin(lat1))) (cos(dist-rad lat1 lng1 lat2 lng2))) (* (sin(dist-rad lat1 lng1 lat2 lng2)) (cos(lat1))))))
(defun course (lat1 lng1 lat2 lng2)
(if (< (sin (- lng1 lng2)) 0)
(course-calc lat1 lng1 lat2 lng2)
(-(* 2 pi)(course-calc lat1 lng1 lat2 lng2))))

You have too many parentheses in the definition of course-calc. The expression
(sin(lat2))
calls the function lat2, then sin on whatever lat2 returns. Your lat2, howerver, is not a function but a variable. What you want to say is
(sin lat2)
The same goes for (cos(lat1)) at the end of the line.

Related

Riemann integral formula to compute high-order function

SICP introduced Riemann integral formula in Chapter 1.3.1
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
Apply it to a particular case
#+name: case-1.3.1-integral.scm
#+BEGIN_SRC scheme :session sicp
(define pi 3.141592653589793)
(define (integral2 f a b dx)
(define (add-dx x) (+ x dx))
(* (sum (f b)
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(define (f b)
(lambda (x) (/ 1 (sqrt
(- (sin x)
(sin b))))))
(* (integral2 f 0 (/ pi 6) 0.00001)
(sqrt (/ 40
(* 3 9.8))))
#+END_SRC
#+RESULTS: case-1.3.1-integral.scm
: 0.0-1.777598336021436i
Got a perfect answer 1.777598336021436
Then translate it to elisp
Start from small:
#+name: case-1.3.1-integral.el
#+begin_src emacs-lisp :session sicp :lexical t
(defun integral (f a b dx)
(* (sum f
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(defun sum(term a next b)
(if (> a b)
0
(+ (funcall term a)
(sum term (funcall next a) next b))))
(integral #'cube 0 1 0.01)
#+end_src
#+RESULTS: case-1.3.1-integral.el
: 0.24998750000000042
It works and thus use it to solve the previous problem
#+begin_src emacs-lisp :session sicp :lexical t
(defvar pi 3.141592653589793)
(defun integral (f a b dx)
(* (sum f
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(defun f (b)
(lambda (x) (/ 1 (sqrt
(- (sin x)
(sin b))))))
(defun integral2 (f a b dx)
(* (sum (funcall f b)
(+ a (/ dx 2.0))
(lambda (x) (+ x dx))
b)
dx))
(integral2 #'f 0 (/ pi 6) 0.01)
#+end_src
But it return a meaningless result
ELISP> (integral2 #'f 0 (/ pi 6) 0.01)
-0.0e+NaN
What's the problem?
The answer you obtained when using Scheme is a complex number, the result of calling sqrt (are you sure the Scheme code was correct in the first place? you should double-check it):
0.0-1.777598336021436i
Unfortunately, Elisp doesn't support complex numbers, that's why we get a NaN in there. But that's not the real problem; you should investigate why are you getting complex results in the Scheme code, an integral should not return complex values!

Recursively differentiating basic expression

If I have an expression, such as x * x * x, stored in a data structure like: mult(var x, mult(var x, var x))
And I want to implement a function to recursively differentiate the equation (so to 3 * x * x or x*x + (x + x)*x etc, no simplification required), any suggestions how to being this?
You would find a matching differentiation rule and apply it. For example in this case we have the rule (where A and B stand for whole subexpressions)
diff(mult(A, B)) -> add(mult(diff(A),B), mult(A, diff(B)))
The left hand side of this rule matches the formula when we set
A = var x
B = mult(var x, var x)
So we can apply this rule to the formula and get
diff(mult(var x, mult(var x, var x))) ->
add(mult(diff(var x),mult(var x, var x)), mult(var x, diff(mult(var x, var x))))
Now do the same recursively for the remaining diff operations.
The other other rule you will need here is:
diff(var x) -> 1
Just a note to point out that language can make difference. Lisp is particularly good for this problem.
(defun d (f x)
(etypecase f
(number 0)
(symbol (if (eq f x) 1 0))
(list (df (first f) (rest f) x))))
(defun df (op args x)
(let ((a (first args))
(b (second args)))
(case op
((+ -) `(,op ,(d a x) ,(d b x)))
(* `(+ (* ,a ,(d b x)) (* ,(d a x) ,b)))
(/ `(/ (- (* ,(d a x) ,b) (* ,a ,(d b x))) (^ ,b 2)))
(^ `(* (* ,b (^ ,a ,(1- b))) ,(d a x)))
(sin `(* (cos ,a) ,(d a x)))
(cos `(* (- (sin ,a)) ,(d a x))))))
Lisp likes prefix notation. This is equivalent to an abstract syntax tree for expressions. Binary operations look like (op lhs rhs). So to differentiate (3 sin(x^2))^2,
> (d '(^ (* (sin (^ x 2)) 3) 2) 'x)
(* (* 2 (^ (* (SIN (^ X 2)) 3) 1))
(+ (* (SIN (^ X 2)) 0) (* (* (COS (^ X 2)) (* (* 2 (^ X 1)) 1)) 3)))
This is a correct answer, but clearly it's far from simple form. So the next step is to add an expression simplifier. With a very rudimentary one,
> (simplify (d '(^ (* (sin (^ x 2)) 3) 2) 'x))
(* (* 2 (* (SIN (^ X 2)) 3)) (* (* (COS (^ X 2)) (* 2 X)) 3))
With infix notation, this is 2(3 sin(x^2)) (3 cos(x^2) (2x)). Obviously more simplification is possible, but getting to "most simple" by any useful definition is a complicated topic.

Implementation of Simpson's Rule (SICP Exercise 1.29)

Following is my code for SICP exercise 1.29. The exercise asks us to implement
Simpson's Rule using higher order procedure sum. It's supposed to be more
accurate than the original integral procedure. But I don't know why it's not
the case in my code:
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some explanations of my code: As
h/3 * (y_{0} + 4*y_{1} + 2*y_{2} + 4*y_{3} + 2*y_{4} + ... + 2*y_{n-2} + 4*y_{n-1} + y_{n})
equals
h/3 * (y_{0}
+ 4 * (y_{1} + y_{3} + ... + y_{n-1})
+ 2 * (y_{2} + y_{4} + ... + y_{n-2})
+ y_{n})
I just use sum to compute y_{1} + y_{3} + ... + y_{n-1} and y_{2} +
y_{4} + ... + y_{n-2}.
Complete code here:
#lang racket
(define (cube x) (* x x x))
(define (sum term a next b)
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx))
(define (simpson-integral f a b n)
(define h (/ (- b a) n))
(define (next x) (+ x (* 2 h)))
(* (/ h 3) (+ (f a)
(* 4 (sum f (+ a h) next (- b h)))
(* 2 (sum f (+ a (* 2 h)) next (- b (* 2 h))))
(f b))))
Some tests(The exact value should be 0.25):
> (integral cube 0 1 0.01)
0.24998750000000042
> (integral cube 0 1 0.001)
0.249999875000001
> (simpson-integral cube 0 1.0 100)
0.23078806666666699
> (simpson-integral cube 0 1.0 1000)
0.24800798800666748
> (simpson-integral cube 0 1.0 10000)
0.2499999999999509
In your solution the x-values are computed as follows:
h = (b-a)/n
x1 = a+1
x3 = x1 +2*h
x5 = x3 +2*h
...
This means rounding errors slowly accumulate.
It happens when (b-a)/n is not representable as floating point.
If we instead compute xi as a+ (i*(b-a))/n you will get more accurate results.
This variant of your solution uses the above method to compute the xi.
(define (simpson-integral3 f a b n)
(define h (/ (- b a) n))
(define (next i) (+ i 2))
(define (f* i) (f (+ a (/ (* i (- b a)) n))))
(* (/ h 3)
(+ (f a)
(* 4 (sum f* 1 next n))
(* 2 (sum f* 2 next (- n 1)))
(f b))))
There's a problem in how you're constructing the terms, the way you're alternating between even terms (multiplied by 2) and odd terms (multiplied by 4) is not correct. I solved this problem by passing an additional parameter to sum to keep track of the current term's even-or-odd nature, there are other ways but this worked for me, and the accuracy got improved:
(define (sum term a next b i)
(if (> a b)
0
(+ (term a i)
(sum term (next a) next b (+ i 1)))))
(define (simpson-integral f a b n)
(let* ((h (/ (- b a) n))
(term (lambda (x i)
(if (even? i)
(* 2.0 (f x))
(* 4.0 (f x)))))
(next (lambda (x) (+ x h))))
(* (+ (f a)
(sum term a next b 1)
(f b))
(/ h 3.0))))
(simpson-integral cube 0 1 1000)
=> 0.2510004999999994

Why can't I make two make function calls in function body?

So I'm going through the first chapter of How To Design Programs 2nd Edition. I believe I made pretty good progress. But there's a "suggestion" to add another graphic to the grid. Every time I try I get an error. At this point, I'm stuck. Below is the code and the error.
Note: the ROCKET image is in the Chapter 1. I just copy and pasted it into the IDE.
Note: The "suggestion" is: How would change the program so that the rocket lands on a flat rock bed that is 10 pixels higher than the bottom of the scene? Don’t forget to change the scenery, too.
HTDP Chapter 1
Here's code that works.
(define BOARDWIDTH 200)
(define BOARDHEIGHT 200)
(define STARTPOSITION 50)
(define BOARDBKGR "blue")
(define GAMEBOARD (empty-scene BOARDWIDTH BOARDHEIGHT BOARDBKGR))
(define ROCKET .)
(define UFO (overlay (circle 10 "solid" "red")
(rectangle 40 4 "solid" "green")))
(define FLATBED (rectangle 60 10 "outline" "black"))
(define (SPACESHIP option)
(cond
[(= option 1) ROCKET]
[(= option 2) UFO]))
(define SHOWNSHIP (SPACESHIP 1))
(define V 20) ;Velocity
(define A 1) ;Acceleration
(define (distance t) ;t = Time
(- (* V t) (* 1/2 A (sqr t))))
(define SPACESHIP-BOTTOM (- BOARDHEIGHT (/ (image-height SHOWNSHIP) 2)))
(define (render-shownship x y)
(place-image SHOWNSHIP x y GAMEBOARD))
(define (create-rocket-scene.v7 t)
(cond
[(<= (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION (distance t))]
[(> (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION SPACESHIP-BOTTOM)]))
Here's the code that doesn't work:
(define BOARDWIDTH 200)
(define BOARDHEIGHT 200)
(define STARTPOSITION 50)
(define BOARDBKGR "blue")
(define GAMEBOARD (empty-scene BOARDWIDTH BOARDHEIGHT BOARDBKGR))
(define ROCKET .)
(define UFO (overlay (circle 10 "solid" "red")
(rectangle 40 4 "solid" "green")))
(define FLATBED (rectangle 60 10 "outline" "black"))
(define (SPACESHIP option)
(cond
[(= option 1) ROCKET]
[(= option 2) UFO]))
(define SHOWNSHIP (SPACESHIP 1))
(define V 20) ;Velocity
(define A 1) ;Acceleration
(define (distance t) ;t = Time
(- (* V t) (* 1/2 A (sqr t))))
(define SPACESHIP-BOTTOM (- BOARDHEIGHT (/ (image-height SHOWNSHIP) 2)))
(define (render-shownship x y)
(place-image SHOWNSHIP x y GAMEBOARD)
(place-image FLATBED STARTPOSITION 195 GAMEBOARD)) ;offender
(define (create-rocket-scene.v7 t)
(cond
[(<= (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION (distance t))]
[(> (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION SPACESHIP-BOTTOM)]))
And the error I get is:
define: expected only one expression for the function body, but found
1 extra part
place-image always takes 4 arguments - the image to be placed, x and y coordinates, and the scene (background) on which to place the image. The problem in your code is that the expression (place-image FLATBED STARTPOSITION 195) is providing only 3 inputs to place-image.
So, back up a little and consider: what does the first expression produce? (place-image SHOWNSHIP x y GAMEBOARD) produces a game board scene with a ship on it, correct? Now on top of that scene you further want to place the FLATBED. So instead of sequencing the place-image function calls, instead consider composing them - i.e. what do you think the missing piece is in (place-image FLATBED STARTPOSITION 195 ____)? upon what scene do you want to place the FLATBED? (Hint: we just answered that above). What expression produces that scene? (hint: you already have that expression).
If you understand the idea, you see that to place multiple images on a scene, you compose or nest the function calls (instead of sequencing them as you are attempting):
(place-image img1 x1 y1 (place-image img2 x2 y2 ...))

IDCT (inverse discrete cosine transformation) for Scheme impl. of jpeg decoder

Could someone explain me the inverse discrete cosine transform function and probably give me an implementation of it in Scheme/Racket which operates on 8x8 blocks? If you don't know scheme maybe you could help me out with some pseudo code.
The mathematical definition of Forward DCT (FDCT) and Inverse DCT (IDCT) is :
FDCT:
c(u,v) 7 7 2*x+1 2*y+1
F(u,v) = --------- * sum sum f(x,y) * cos (------- *u*PI)* cos (------ *v*PI)
4 x=0 y=0 16 16
u,v = 0,1,...,7
{ 1/2 when u=v=0
c(u,v) = {
{ 1 otherwise
IDCT:
1 7 7 2*x+1 2*y+1
f(x,y) = --- * sum sum c(u,v)*F(u,v)*cos (------- *u*PI)* cos (------ *v*PI)
4 u=0 v=0 16 16
x,y=0,1...7
This is just based on your definition of the dct above; I couldn't find any good example values for that formula, so this can't be considered tested.
(define pi 3.14) ; set this to however accurate you want
(define c
(lambda (u v)
(if (and (= u 0)
(= v 0))
1/2
1)))
(define fdct
(lambda (f u v)
(* (/ (c u v)
4)
(let x-loop ((x 0)
(x-sum 0))
(if (< x 7)
(x-loop (+ x 1)
(+ x-sum
(let y-loop ((y 0)
(y-sum 0))
(if (< y 7)
(y-loop (+ y 1)
(+ y-sum (* (f x y)
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi))
(cos (* (/ (+ (* 2 y)
1)
16)
v
pi)))))
y-sum))))
x-sum)))))
(define idct
(lambda (f x y)
(* 1/4
(let u-loop ((u 0)
(u-sum 0))
(if (< u 7)
(u-loop (+ u 1)
(+ u-sum
(let v-loop ((v 0)
(v-sum 0))
(if (< v 7)
(v-loop (+ v 1)
(+ v-sum
(* (c u v)
(f u v)
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi))
(cos (* (/ (+ (* 2 x)
1)
16)
u
pi)))))
v-sum))))
u-sum)))))

Resources