summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/approx,derivative.lisp25
-rw-r--r--src/approx,maceps.lisp12
-rw-r--r--src/approx,package.lisp7
-rw-r--r--src/approx_derivative.c38
-rw-r--r--src/lin.c19
-rw-r--r--src/lizfcm.asd33
-rw-r--r--src/maceps.c28
-rw-r--r--src/main.c7
-rw-r--r--src/main.lisp60
-rw-r--r--src/tests,approx.lisp48
-rw-r--r--src/tests,maceps.lisp27
-rw-r--r--src/tests,suite.lisp10
-rw-r--r--src/tests,table.lisp31
-rw-r--r--src/tests,vector.lisp42
-rw-r--r--src/utils,package.lisp5
-rw-r--r--src/utils,table.lisp11
-rw-r--r--src/utils,within-range.lisp5
-rw-r--r--src/vector,distance.lisp6
-rw-r--r--src/vector,least-squares-reg.lisp2
-rw-r--r--src/vector,least-squares.lisp14
-rw-r--r--src/vector,norm.lisp14
-rw-r--r--src/vector,package.lisp8
-rw-r--r--src/vector.c90
23 files changed, 182 insertions, 360 deletions
diff --git a/src/approx,derivative.lisp b/src/approx,derivative.lisp
deleted file mode 100644
index 631a5c0..0000000
--- a/src/approx,derivative.lisp
+++ /dev/null
@@ -1,25 +0,0 @@
-(in-package :lizfcm.approx)
-
-(defun central-derivative-at (f x &optional (delta 0.01))
- (let* ((x2 (+ x delta))
- (x1 (- x delta))
- (y2 (apply f (list x2)))
- (y1 (apply f (list x1))))
- (/ (- y2 y1)
- (- x2 x1))))
-
-(defun forward-derivative-at (f x &optional (delta 0.01))
- (let* ((x2 (+ x delta))
- (x1 x)
- (y2 (apply f (list x2)))
- (y1 (apply f (list x1))))
- (/ (- y2 y1)
- (- x2 x1))))
-
-(defun backward-derivative-at (f x &optional (delta 0.01))
- (let* ((x2 x)
- (x1 (- x delta))
- (y2 (apply f (list x2)))
- (y1 (apply f (list x1))))
- (/ (- y2 y1)
- (- x2 x1))))
diff --git a/src/approx,maceps.lisp b/src/approx,maceps.lisp
deleted file mode 100644
index e2738e4..0000000
--- a/src/approx,maceps.lisp
+++ /dev/null
@@ -1,12 +0,0 @@
-(in-package :lizfcm.approx)
-
-(defun compute-maceps (f a init)
- (let ((h init)
- (err init))
- (loop collect (list a h err)
- do
- (setf h (/ h 2)
- err (abs (- (funcall f (+ a h))
- (funcall f a))))
- while (> err 0))))
-
diff --git a/src/approx,package.lisp b/src/approx,package.lisp
deleted file mode 100644
index a0eac80..0000000
--- a/src/approx,package.lisp
+++ /dev/null
@@ -1,7 +0,0 @@
-(in-package :cl-user)
-(defpackage lizfcm.approx
- (:use :cl)
- (:export :central-derivative-at
- :forward-derivative-at
- :backward-derivative-at
- :compute-maceps))
diff --git a/src/approx_derivative.c b/src/approx_derivative.c
new file mode 100644
index 0000000..b33a208
--- /dev/null
+++ b/src/approx_derivative.c
@@ -0,0 +1,38 @@
+#include "lizfcm.h"
+#include <assert.h>
+
+double central_derivative_at(double (*f)(double), double a, double h) {
+ assert(h > 0);
+
+ double x2 = a + h;
+ double x1 = a - h;
+
+ double y2 = (*f)(x2);
+ double y1 = (*f)(x1);
+
+ return (y2 - y1) / (x2 - x1);
+}
+
+double forward_derivative_at(double (*f)(double), double a, double h) {
+ assert(h > 0);
+
+ double x2 = a + h;
+ double x1 = a;
+
+ double y2 = (*f)(x2);
+ double y1 = (*f)(x1);
+
+ return (y2 - y1) / (x2 - x1);
+}
+
+double backward_derivative_at(double (*f)(double), double a, double h) {
+ assert(h > 0);
+
+ double x2 = a;
+ double x1 = a - h;
+
+ double y2 = (*f)(x2);
+ double y1 = (*f)(x1);
+
+ return (y2 - y1) / (x2 - x1);
+}
diff --git a/src/lin.c b/src/lin.c
new file mode 100644
index 0000000..2df6f28
--- /dev/null
+++ b/src/lin.c
@@ -0,0 +1,19 @@
+#include "lizfcm.h"
+#include <assert.h>
+
+Line *least_squares_lin_reg(Array_double *x, Array_double *y) {
+ assert(x->size == y->size);
+
+ uint64_t n = x->size;
+ double sum_x = sum_v(x);
+ double sum_y = sum_v(y);
+ double sum_xy = dot_v(x, y);
+ double sum_xx = dot_v(x, x);
+ double denom = ((n * sum_xx) - (sum_x * sum_x));
+
+ Line *line = malloc(sizeof(Line));
+ line->m = ((sum_xy * n) - (sum_x * sum_y)) / denom;
+ line->a = ((sum_y * sum_xx) - (sum_x * sum_xy)) / denom;
+
+ return line;
+}
diff --git a/src/lizfcm.asd b/src/lizfcm.asd
deleted file mode 100644
index 0096257..0000000
--- a/src/lizfcm.asd
+++ /dev/null
@@ -1,33 +0,0 @@
-(asdf:defsystem "lizfcm"
- :version "0.1.0"
- :author "Elizabeth Hunt"
- :license "MIT"
- :components
- ((:file "utils,within-range" :depends-on ("utils,package"))
- (:file "utils,table" :depends-on ("utils,package"))
- (:file "utils,package")
- (:file "approx,maceps" :depends-on ("approx,package"))
- (:file "approx,derivative" :depends-on ("approx,package"))
- (:file "approx,package")
- (:file "vector,least-squares")
- (:file "vector,distance" :depends-on ("vector,norm" "vector,package"))
- (:file "vector,norm" :depends-on ("vector,package"))
- (:file "vector,package")))
-
-
-(asdf:defsystem "lizfcm/tests"
- :author "Elizabeth Hunt"
- :license "MIT"
- :depends-on
- (:fiveam
- :lizfcm)
- :components
- ((:file "tests,table" :depends-on ("tests,suite"))
- (:file "tests,maceps" :depends-on ("tests,suite"))
- (:file "tests,approx" :depends-on ("tests,suite"))
- (:file "tests,vector" :depends-on ("tests,suite"))
- (:file "tests,suite"))
- :perform
- (asdf:test-op (o c) (uiop:symbol-call
- :fiveam :run!
- (uiop:find-symbol* :lizfcm-test-suite :lizfcm/tests))))
diff --git a/src/maceps.c b/src/maceps.c
new file mode 100644
index 0000000..23bc9db
--- /dev/null
+++ b/src/maceps.c
@@ -0,0 +1,28 @@
+#include "lizfcm.h"
+#include <math.h>
+
+float smaceps() {
+ float one = 1.0;
+ float machine_epsilon = 1.0;
+ float one_approx = one + machine_epsilon;
+
+ while (fabsf(one_approx - one) > 0) {
+ machine_epsilon /= 2;
+ one_approx = one + machine_epsilon;
+ }
+
+ return machine_epsilon;
+}
+
+double dmaceps() {
+ double one = 1.0;
+ double machine_epsilon = 1.0;
+ double one_approx = one + machine_epsilon;
+
+ while (fabs(one_approx - one) > 0) {
+ machine_epsilon /= 2;
+ one_approx = one + machine_epsilon;
+ }
+
+ return machine_epsilon;
+}
diff --git a/src/main.c b/src/main.c
new file mode 100644
index 0000000..6bb704a
--- /dev/null
+++ b/src/main.c
@@ -0,0 +1,7 @@
+#include "lizfcm.h"
+#include <stdio.h>
+
+int main() {
+ printf("hello, from lizfcm!\n");
+ return 0;
+}
diff --git a/src/main.lisp b/src/main.lisp
deleted file mode 100644
index 7a8b455..0000000
--- a/src/main.lisp
+++ /dev/null
@@ -1,60 +0,0 @@
-(load "lizfcm.asd")
-(ql:quickload :lizfcm)
-
-;; this is a collection showcasing the library developed for math4610, required
-;; from the Shared Library definition
-
-(defun smaceps ()
- (cadar (last (lizfcm.approx:compute-maceps
- (lambda (x) x) 1.0 1.0))))
-
-(defun dmaceps ()
- (cadar (last (lizfcm.approx:compute-maceps
- (lambda (x) x) 1.0d0 1.0d0))))
-
-(defun l2-norm (v)
- (let ((2-norm (lizfcm.vector:p-norm 2)))
- (funcall 2-norm v)))
-
-(defun l1-norm (v)
- (let ((1-norm (lizfcm.vector:p-norm 1)))
- (funcall 1-norm v)))
-
-(defun linf-norm (v)
- (lizfcm.vector:max-norm v))
-
-(defun l2-distance (v1 v2)
- (let ((2-norm (lizfcm.vector:p-norm 2)))
- (lizfcm.vector:distance v1 v2 2-norm)))
-
-(defun l1-distance (v1 v2)
- (let ((1-norm (lizfcm.vector:p-norm 1)))
- (lizfcm.vector:distance v1 v2 1-norm)))
-
-(defun linf-distance (v1 v2)
- (lizfcm.vector:distance v1 v2 'lizfcm.vector:max-norm))
-
-(defun f (x)
- (/ (- x 1) (+ x 1)))
-
-(defun fprime (x)
- (/ 2 (expt (+ x 1) 2)))
-
-(defmacro showcase (s-expr)
- `(format t "~a = ~a~%" ,(format nil "~a" s-expr) ,s-expr))
-
-(defun main ()
- (showcase (smaceps))
- (showcase (dmaceps))
- (showcase (l2-norm '(1 2)))
- (showcase (l1-norm '(1 2)))
- (showcase (linf-norm '(1 2)))
- (showcase (l1-distance '(1 2) '(-3 4)))
- (showcase (l2-distance '(1 2) '(-3 4)))
- (showcase (linf-distance '(1 2) '(-3 4)))
- (showcase (lizfcm.vector:least-squares-reg '(1 2 3 4 5 6 7)
- '(0.5 3 2 3.5 5 6 7.5)))
- (showcase (lizfcm.approx:forward-derivative-at 'f 1 0.00001))
- (showcase (lizfcm.approx:central-derivative-at 'f 1 0.00001))
- (showcase (lizfcm.approx:backward-derivative-at 'f 1 0.00001)))
-
diff --git a/src/tests,approx.lisp b/src/tests,approx.lisp
deleted file mode 100644
index 678ff8c..0000000
--- a/src/tests,approx.lisp
+++ /dev/null
@@ -1,48 +0,0 @@
-(defpackage lizfcm/tests.approx
- (:use :cl
- :fiveam
- :lizfcm.approx
- :lizfcm.utils
- :lizfcm/tests)
- (:export :approx-suite))
-(in-package :lizfcm/tests.approx)
-
-(def-suite approx-suite
- :in lizfcm-test-suite)
-(in-suite approx-suite)
-
-(test central-derivative-at
- :description "derivative at is within bounds"
- (let ((f (lambda (x) (* x x)))
- (x 2)
- (accepted-delta 0.02)
- (f-prime-at-x 4)
- (delta 0.01))
- (is (within-range-p
- (central-derivative-at f x delta)
- f-prime-at-x
- accepted-delta))))
-
-(test fwd-derivative-at
- :description "forward derivative at is within bounds"
- (let ((f (lambda (x) (* x x)))
- (x 2)
- (accepted-delta 0.02)
- (f-prime-at-x 4)
- (delta 0.01))
- (is (within-range-p
- (forward-derivative-at f x delta)
- f-prime-at-x
- accepted-delta))))
-
-(test bwd-derivative-at
- :description "backward derivative at is within bounds"
- (let ((f (lambda (x) (* x x)))
- (x 2)
- (accepted-delta 0.02)
- (f-prime-at-x 4)
- (delta 0.01))
- (is (within-range-p
- (backward-derivative-at f x delta)
- f-prime-at-x
- accepted-delta))))
diff --git a/src/tests,maceps.lisp b/src/tests,maceps.lisp
deleted file mode 100644
index cd5ced9..0000000
--- a/src/tests,maceps.lisp
+++ /dev/null
@@ -1,27 +0,0 @@
-(defpackage lizfcm/tests.maceps
- (:use :cl
- :fiveam
- :lizfcm.approx
- :lizfcm.utils
- :lizfcm/tests)
- (:export :approx-suite))
-(in-package :lizfcm/tests.maceps)
-
-(def-suite maceps-suite
- :in lizfcm-test-suite)
-(in-suite maceps-suite)
-
-(test maceps
- :description "double precision provides precision about (mac eps of single precision) squared"
- (let* ((maceps-computation-double (compute-maceps (lambda (x) x)
- 1.0d0
- 1.0d0))
- (maceps-computation-single (compute-maceps (lambda (x) x)
- 1.0
- 1.0))
- (last-double-h (cadar (last maceps-computation-double)))
- (last-single-h (cadar (last maceps-computation-single))))
- (is (within-range-p
- (- last-double-h (* last-single-h last-single-h))
- 0
- last-single-h))))
diff --git a/src/tests,suite.lisp b/src/tests,suite.lisp
deleted file mode 100644
index e23cfaf..0000000
--- a/src/tests,suite.lisp
+++ /dev/null
@@ -1,10 +0,0 @@
-(in-package :cl-user)
-(defpackage lizfcm/tests
- (:use :cl
- :fiveam)
- (:export :run!
- :lizfcm-test-suite))
-(in-package :lizfcm/tests)
-
-(def-suite lizfcm-test-suite
- :description "The ultimate parent test suite")
diff --git a/src/tests,table.lisp b/src/tests,table.lisp
deleted file mode 100644
index 33d4e86..0000000
--- a/src/tests,table.lisp
+++ /dev/null
@@ -1,31 +0,0 @@
-(defpackage lizfcm/tests.table
- (:use :cl
- :fiveam
- :lizfcm.utils
- :lizfcm/tests)
- (:export :approx-suite))
-(in-package :lizfcm/tests.table)
-
-(def-suite table-suite
- :in lizfcm-test-suite)
-(in-suite table-suite)
-
-(defun fib (n)
- (cond ((< n 2) n)
- (t (+ (fib (- n 1)) (fib (- n 2))))))
-
-(test table-of-fib-vals
- :description "table generates correctly"
- (let* ((headers '("n" "fib(n)"))
- (n-values '((1) (2) (3) (4)))
- (expected `(("n" "fib(n)")
- (1 ,(fib 1))
- (2 ,(fib 2))
- (3 ,(fib 3))
- (4 ,(fib 4))))
- (tabled (lizfcm.utils:table (:headers headers
- :domain-order (n)
- :domain-values n-values)
- (fib n))))
- (is (equal expected tabled))))
-
diff --git a/src/tests,vector.lisp b/src/tests,vector.lisp
deleted file mode 100644
index 6edb1ac..0000000
--- a/src/tests,vector.lisp
+++ /dev/null
@@ -1,42 +0,0 @@
-(defpackage lizfcm/tests.vector
- (:use :cl
- :fiveam
- :lizfcm.vector
- :lizfcm.utils
- :lizfcm/tests)
- (:export :vector-suite))
-(in-package :lizfcm/tests.vector)
-
-(def-suite vector-suite
- :in lizfcm-test-suite)
-(in-suite vector-suite)
-
-(test p-norm
- :description "computes p-norm"
- (let ((v '(1 1))
- (length (sqrt 2))
- (2-norm (p-norm 2)))
- (is (within-range-p (funcall 2-norm v)
- length
- 0.00001))))
-
-(test vector-distance
- :description "computes distance via norm"
- (let ((v1 '(0 0))
- (v2 '(1 1))
- (dist (sqrt 2)))
- (is (within-range-p (distance v1 v2 (p-norm 2))
- dist
- 0.00001))))
-
-(test least-squares
- :description "least squares is correct enough"
- (let ((x '(0 1 2 3 4))
- (y '(1 2 3 4 5)))
- (destructuring-bind (m b) (lizfcm.vector:least-squares-reg x y)
- (is (within-range-p m 1 0.00001))
- (is (within-range-p b 1 0.00001))))
- (let ((x '(1 2 3 4 5 6 7))
- (y '(0.5 3 2 3.5 5 6 7.5)))
- (destructuring-bind (m b) (lizfcm.vector:least-squares-reg x y)
- (is (within-range-p m 1 0.3))))) ;; just a guestimate for best fit
diff --git a/src/utils,package.lisp b/src/utils,package.lisp
deleted file mode 100644
index bdd5589..0000000
--- a/src/utils,package.lisp
+++ /dev/null
@@ -1,5 +0,0 @@
-(in-package :cl-user)
-(defpackage lizfcm.utils
- (:use :cl)
- (:export :within-range-p
- :table))
diff --git a/src/utils,table.lisp b/src/utils,table.lisp
deleted file mode 100644
index e96f37b..0000000
--- a/src/utils,table.lisp
+++ /dev/null
@@ -1,11 +0,0 @@
-(in-package :lizfcm.utils)
-
-(defmacro table ((&key headers domain-order domain-values) &body body)
- `(cons
- ,headers
- (mapcar (lambda (tuple)
- (destructuring-bind ,domain-order tuple
- (append tuple
- (list
- ,@body))))
- ,domain-values)))
diff --git a/src/utils,within-range.lisp b/src/utils,within-range.lisp
deleted file mode 100644
index 9a0b762..0000000
--- a/src/utils,within-range.lisp
+++ /dev/null
@@ -1,5 +0,0 @@
-(in-package :lizfcm.utils)
-
-(defun within-range-p (x true-value delta)
- (and (< x (+ true-value delta))
- (> x (- true-value delta))))
diff --git a/src/vector,distance.lisp b/src/vector,distance.lisp
deleted file mode 100644
index 74631ce..0000000
--- a/src/vector,distance.lisp
+++ /dev/null
@@ -1,6 +0,0 @@
-(in-package :lizfcm.vector)
-
-(defun distance (v1 v2 norm)
- (let* ((d (mapcar #'- v1 v2))
- (length (funcall norm d)))
- length))
diff --git a/src/vector,least-squares-reg.lisp b/src/vector,least-squares-reg.lisp
deleted file mode 100644
index 1c7272c..0000000
--- a/src/vector,least-squares-reg.lisp
+++ /dev/null
@@ -1,2 +0,0 @@
-(in-package :lizfcm.vector)
-
diff --git a/src/vector,least-squares.lisp b/src/vector,least-squares.lisp
deleted file mode 100644
index 687af32..0000000
--- a/src/vector,least-squares.lisp
+++ /dev/null
@@ -1,14 +0,0 @@
-(in-package :lizfcm.vector)
-
-(defun least-squares-reg (x y)
- (let* ((n (length x))
- (sum-y (reduce #'+ y))
- (sum-x (reduce #'+ x))
- (sum-xy (reduce #'+ (mapcar #'* x y)))
- (sum-xsquared (reduce #'+ (mapcar #'* x x)))
- (b (/ (- (* sum-y sum-xsquared) (* sum-x sum-xy))
- (- (* n sum-xsquared) (* sum-x sum-x))))
- (a (/ (- (* n sum-xy) (* sum-x sum-y))
- (- (* n sum-xsquared) (* sum-x sum-x)))))
- (list a b)))
-
diff --git a/src/vector,norm.lisp b/src/vector,norm.lisp
deleted file mode 100644
index aa51bce..0000000
--- a/src/vector,norm.lisp
+++ /dev/null
@@ -1,14 +0,0 @@
-(in-package :lizfcm.vector)
-
-(defun p-norm (p)
- (lambda (v)
- (expt
- (reduce #'+
- (mapcar (lambda (x)
- (abs
- (expt x p)))
- v))
- (/ 1 p))))
-
-(defun max-norm (v)
- (reduce #'max v))
diff --git a/src/vector,package.lisp b/src/vector,package.lisp
deleted file mode 100644
index f491908..0000000
--- a/src/vector,package.lisp
+++ /dev/null
@@ -1,8 +0,0 @@
-(in-package :cl-user)
-(defpackage lizfcm.vector
- (:use :cl)
- (:export
- :p-norm
- :max-norm
- :distance
- :least-squares-reg))
diff --git a/src/vector.c b/src/vector.c
new file mode 100644
index 0000000..61692e1
--- /dev/null
+++ b/src/vector.c
@@ -0,0 +1,90 @@
+#include "lizfcm.h"
+#include <assert.h>
+#include <float.h>
+#include <math.h>
+#include <stdio.h>
+
+double l2_norm(Array_double *v) {
+ double norm = 0;
+ for (size_t i = 0; i < v->size; ++i)
+ norm += v->data[i] * v->data[i];
+ return sqrt(norm);
+}
+
+double l1_norm(Array_double *v) {
+ double sum = 0;
+ for (size_t i = 0; i < v->size; ++i)
+ sum += fabs(v->data[i]);
+ return sum;
+}
+
+double linf_norm(Array_double *v) {
+ double max = -DBL_MAX;
+ for (size_t i = 0; i < v->size; ++i)
+ max = c_max(v->data[i], max);
+ return max;
+}
+
+Array_double *minus_v(Array_double *v1, Array_double *v2) {
+ assert(v1->size == v2->size);
+
+ Array_double *sub = InitArrayWithSize(double, v1->size, 0);
+ for (size_t i = 0; i < v1->size; i++)
+ sub->data[i] = v1->data[i] - v2->data[i];
+ return sub;
+}
+
+double sum_v(Array_double *v) {
+ double sum = 0;
+ for (size_t i = 0; i < v->size; i++)
+ sum += v->data[i];
+ return sum;
+}
+
+Array_double *add_v(Array_double *v1, Array_double *v2) {
+ assert(v1->size == v2->size);
+
+ Array_double *sum = InitArrayWithSize(double, v1->size, 0);
+ for (size_t i = 0; i < v1->size; i++)
+ sum->data[i] = v1->data[i] + v2->data[i];
+ return sum;
+}
+
+double dot_v(Array_double *v1, Array_double *v2) {
+ assert(v1->size == v2->size);
+
+ double dot = 0;
+ for (size_t i = 0; i < v1->size; i++)
+ dot += v1->data[i] * v2->data[i];
+ return dot;
+}
+
+double l2_distance(Array_double *v1, Array_double *v2) {
+ Array_double *minus = minus_v(v1, v2);
+ double dist = l2_norm(minus);
+ free(minus);
+ return dist;
+}
+
+double l1_distance(Array_double *v1, Array_double *v2) {
+ Array_double *minus = minus_v(v1, v2);
+ double dist = l1_norm(minus);
+ free(minus);
+ return dist;
+}
+
+double linf_distance(Array_double *v1, Array_double *v2) {
+ Array_double *minus = minus_v(v1, v2);
+ double dist = linf_norm(minus);
+ free(minus);
+ return dist;
+}
+
+void format_vector_into(Array_double *v, char *s) {
+ sprintf(s, "");
+ if (v->size == 0)
+ sprintf(s, "empty");
+
+ for (size_t i = 0; i < v->size; ++i)
+ sprintf(s, "%s %f,", s, v->data[i]);
+}
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-12-08 01:32:00 +0000