[SOLVED] lisp: CS 480 / 580 Assignment 4

#|;;;;;; Assignment 4; Write a two-layer backpropagation neural network.;; Due THURSDAY, October 20, at MIDNIGHT.;Note that the 580 students must implement one additional function (K-fold validation).I have decided to provide the list version of this code rather than the array version(the array version is tougher to write but harder to write bugs in).See the questions at the end of the file.Note that this is a STOCHASTIC system and so you need to run a number of times to assess whether thesystem is really working well -- sometimes it just gets lucky (or doesn't).What is"a number of times"?I'd say: 5-10 runs per experiment to get an idea, and 30 to reallybe able to make a claim.I'd also be interested in modifications you made to theproject to add interesting gizmos.In actuality this project isn't particularly difficult.It's really just a few lines of code.You should be able to get this in almost immediately.In class I mentioned that you can do backpropagation entirely withmatrix manipulation, and it's a LOT easier.Well, it is.Here arethe rules for doing backpropagation:"."(a dot)means matrix multiplyAs in:C = A . Bno dotmeans element-by-element multiply -- by whichwe mean if C = (A) (B) , then for each index i and jCij = Aij * Bijsigmoid[] sigmoid function applied to each elementtr[]transpose the matrix1 - subtract from 1- subtract two matrices+ add two maricesalpha (...) multiply by the scalar value alphac is the expected output vectori is the provided input vectorh, c, o, i, odelta, and hdelta are all COLUMN vectorsv is a matrix with (num hidden units) rows and (size of i) columns,initially set to random values between -(initialsize) and initialsizew is a matrix with (size of c) rows and (num hidden units) columns,initially set to random values between -(initialsize) and initialsizeThe forward pass rules are (in this order):h = sigmoid[v . i]o = sigmoid[w . h]The backpropagation rules are (in this order):odelta = (c - o) o (1 - o)hdelta = (h (1 - h) (tr[w] . odelta) )w = w + alpha (odelta . tr[h])v = v + alpha (hdelta . tr[i])Also for your enlightenment, the error metric ( 1/2 SUM_i (Ci - Oi)^2 )can be matrixified simply as:error =0.5 ( tr[c - o] . (c - o) )...of course error would be a 1x1 matrix -- you should be able to extractthe number out of that.:-)odelta and hdelta are temporary matrix variables to simplify theequations for you.You should be able to figure out whati, h, c, o, v, and w are.:-) BE CAREFUL not to mix upmatrix multiply with element-by-element multiply!Important hint: the matrix manipulation functions I have provided do NOThave error checking in them.If you multiply two matrices togetherwhich are mismatched size-wise, for example, the matrix multiplyfunction will truncate each matrix until they *are* matched size-wise.Thus you should check to make sure that your matrices are coming outright.One good hint is to make sure your W and V matrices don'tchange size after backpropagation!:-)You will need to implement the following functions:SIGMOIDNET-ERRORFORWARD-PROPAGATEBACK-PROPAGATENET-BUILDSIMPLE-GENERALIZATIONThe extra CS580 function isK-FOLD-VALIDATIONThe long functions are back-propagate and net-build.Hint: BACK-PROPAGATE will have to reimplement most of the FORWARD-PROPAGATEfunction, but it doesn't help much to call FORWARD-PROPAGATEfrom within BACK-PROPAGATE.After you have implemented these functions, you will test them out onsome data.I have chosen several problems:1. XOR and NAND (Well, actually EQUAL rather than XOR, but we'llpretend it's XOR -- they're isomorphic so it doesn't matter much).These are binary classification problems.2. Congressional Voting Records for 1984 -- to see if you candetermine who's a democrat and who's a republican.This is againa binary classification problem.3. Miles per gallon for various cars in the 1980s.This is aregression problem with a one-dimensional output.4. Wine classifications.This is a classification problem with threeclasses.I have chosen to encode those three classes ascorners of a three-dimensional hypercube (you'll see).I have built in a bias in my conversion function so you can forget aboutthat issue.For the NAND and XOR problems, you have to get the code working.This usually requiresseveral runs before it will converge to a perfect solution.Once you have gotten NAND and XOR working, try running the other problems andseeing how they generalize.You need to provide:1. Your working code2. Your 500-word report.ABOUT THE MATRICESHere's some info about my matrix-manipulation functions, to help youin debugging....A matrix as follows:2 3 76 2 45 2 9...takes the form:'( (2 3 7)(6 2 4)(5 2 9) )...so it's in row-major order.Traditionally, a matrix's elementsare accessed as Wij,where i is the ROW and j is the COLUMN.Also,rows and columns start with 1, not 0.I'll adhere to those standards.I'm implementing matrices as lists of lists.That includes vectors(1-dimensional matrices).So the row vector:3 4 5...takes the form:'( (3 4 5) )...and the column vector359...takes the form:'( (3)(5)(9) )All the matrix manipulation functions I've given are non-destructive.ABOUT *VERIFY*The matrix math code can be run with or without verification that thevarious matrices are the right size for the operations.Without checkingit's a little slower.By default the checks are on:*verify* is set to tYou can turn off the checks by setting *verify* to nil but only do so afteryou know for a fact that your network is operating properly.|#(defun shuffle (lis)"Shuffles a list.Non-destructive.O(length lis), sopretty efficient.Returns the shuffled version of the list."(let ((vec (apply #'vector lis)) bag (len (length lis)))(dotimes (x len)(let ((i (random (- len x))))(rotatef (svref vec i) (svref vec (- len x 1)))(push (svref vec (- len x 1)) bag)))bag)) ;; 65 s-expressions, by the way(defparameter *verify* t);;; hmmm, openmcl keeps signalling an error of a different kind;;; when I throw an error -- a bug in openmcl?dunno...(defun throw-error (str)(error (make-condition 'simple-error :format-control str)))(defun verify-equal (funcname &rest matrices);; we presume they're rectangular -- else we're REALLY in trouble!(when *verify*(unless (and (apply #'= (mapcar #'length matrices)) (apply #'= (mapcar #'length (mapcar #'first matrices))))(throw-error (format t "In ~s, matrix dimensions not equal: ~s" funcname (mapcar #'(lambda (mat) (list (length mat) 'by (length (first mat)))) matrices))))))(defun verify-multiplicable (matrix1 matrix2);; we presume they're rectangular -- else we're REALLY in trouble!(when *verify*(if (/= (length (first matrix1)) (length matrix2))(throw-error (format t "In multiply, matrix dimensions not valid: ~s" (list (list (length matrix1) 'by (length (first matrix1))) (list (length matrix2) 'by (length (first matrix2)))))))));; Basic Operations(defun map-m (function &rest matrices)"Maps function over elements in matrices, returning a new matrix"(apply #'verify-equal 'map-mmatrices)(apply #'mapcar #'(lambda (&rest vectors) ;; for each matrix...(apply #'mapcar #'(lambda (&rest elts) ;; for each vector...(apply function elts)) vectors)) matrices)) ;; pretty :-)(defun transpose (matrix)"Transposes a matrix"(apply #'mapcar #'list matrix));; cool, no?(defun make-matrix (i j func)"Builds a matrix with i rows and j columns,with each element initialized by calling (func)"(map-m func (make-list i :initial-element (make-list j :initial-element nil))))(defun make-random-matrix (i j val)"Builds a matrix with i rows and j columns,with each element initialized to a randomfloating-point number between -val and val"(make-matrix i j #'(lambda (x) (declare (ignore x));; quiets warnings about x not being used (- (random (* 2.0 val)) val))))(defun e (matrix i j)"Returns the element at row i and column j in matrix";; 1-based, not zero-based.This is because it's traditional;; for the top-left element in a matrix to be element (1,1),;; NOT (0,0).Sorry about that.:-)(elt (elt matrix (1- i)) (1- j)))(defun print-matrix (matrix)"Prints a matrix in a pleasing form, then returns matrix"(mapcar #'(lambda (vector) (format t "~%~{~8,4,,F~}" vector)) matrix) matrix);;; Matrix Multiplication(defun multiply2 (matrix1 matrix2)"Multiplies matrix1 by matrix2-- don't use this, use multiply instead"(verify-multiplicable matrix1 matrix2)(let ((tmatrix2 (transpose matrix2)))(mapcar #'(lambda (vector1)(mapcar #'(lambda (vector2)(apply #'+ (mapcar #'* vector1 vector2))) tmatrix2))matrix1)));; pretty :-)(defun multiply (matrix1 matrix2 &rest matrices)"Multiplies matrices together"(reduce #'multiply2 (cons matrix1 (cons matrix2 matrices))));;; Element-by-element operations(defun add (matrix1 matrix2 &rest matrices)"Adds matrices together, returning a new matrix"(apply #'verify-equal 'add matrix1 matrix2 matrices)(apply #'map-m #'+ matrix1 matrix2 matrices))(defun e-multiply (matrix1 matrix2 &rest matrices)"Multiplies corresponding elements in matrices together,returning a new matrix"(apply #'verify-equal 'e-multiply matrix1 matrix2 matrices)(apply #'map-m #'* matrix1 matrix2 matrices))(defun subtract (matrix1 matrix2 &rest matrices)"Subtracts matrices from the first matrix, returning a new matrix."(let ((all (cons matrix1 (cons matrix2 matrices))))(apply #'verify-equal 'subtract all)(apply #'map-m #'- all)))(defun scalar-add (scalar matrix)"Adds scalar to each element in matrix, returning a new matrix"(map-m #'(lambda (elt) (+ scalar elt)) matrix))(defun scalar-multiply (scalar matrix)"Multiplies each element in matrix by scalar, returning a new matrix"(map-m #'(lambda (elt) (* scalar elt)) matrix));;; This function could;;; be done trivially with (scalar-add scalar (scalar-multiply -1 matrix))(defun subtract-from-scalar (scalar matrix)"Subtracts each element in the matrix from scalar, returning a new matrix"(map-m #'(lambda (elt) (- scalar elt)) matrix));;; Functions you need to implement;; IMPLEMENT THIS FUNCTION(defun sigmoid (u)"Sigmoid function applied to the number u");; output and correct-output are both column-vectors;; IMPLEMENT THIS FUNCTION(defun net-error (output correct-output)"Returns (as a scalar value) the error between the output and correct vectors");; a single datum is of the form;; (--input-column-vector---- output-column-vector--);;;; Notice that this is different from the raw data provided in the problems below.;; You can convert the raw data to this column-vector form using CONVERT-DATA;; IMPLEMENT THIS FUNCTION(defun forward-propagate (datum v w)"Returns as a vector the output of the OUTPUT units when presentedthe datum as input.");; IMPLEMENT THIS FUNCTION(defun back-propagate (datum alpha v w)"Back-propagates a datum through the V and W matrices,returning a list consisting of new, modified V and W matrices.";; Consider using let*;; let* is like let, except that it lets you initialize local;; variables in the context of earlier local variables in the;; same let* statement.)(defun optionally-print (x option)"If option is t, then prints x, else doesn't print it.In any case, returns x";;; perhaps this might be a useful function for you(if option (print x) x))(defparameter *a-good-minimum-error* 1.0e-9);; data is of the form:;; (;;(--input-column-vector----output-column-vector--);;(--input-column-vector----output-column-vector--);;...;; );;;;;; Notice that this is different from the raw data provided in the problems below.;; You can convert the raw data to this column-vector form using CONVERT-DATA;;; IMPLEMENT THIS FUNCTION(defun net-build (data num-hidden-units alpha initial-bounds max-iterations modulo &optional print-all-errors)"Builds a neural network with num-hidden-units and the appropriate numberof input and output units based on the data.Each element should be a randomvalue between -(INITIAL-BOUNDS) and +(INITIAL-BOUNDS).Then performs the following loop MAX-ITERATIONS times, or until the error conditionis met (see below): 1. For each data element in a randomized version of the data, performbackpropagation. 2. Every modulo iterations,For every data element in the data, perform forward propagation andA.If print-all-errors is true, then print the error for each elementB.At any rate, always print the worst error and the mean errorC.If the worst error is better (lower) than A-GOOD-MINIMUM-ERROR,quit all loops and prepare to exit the function --the error condition was met.The function should return a list of two items: the final V matrixand the final W matrix of the learned network.");; For this function, you should pass in the data just like it's defined;; in the example problems below (that is, not in the "column vector" format;; used by NET-BUILD.Of course, if you need to call NET_BUILD from this function;; you can alway convert this data to column-vector format using CONVERT-DATA within;; the SIMPLE-GENERALIZATION function.;;;; Yes, this is ridiculously inconsistent.Deal with it.:-);;; IMPLEMENT THIS FUNCTION(defun simple-generalization (data num-hidden-units alpha initial-bounds max-iterations)"Given a set of data, trains a neural network on the first halfof the data, then tests generalization on the second half, returningthe average error among the samples in the second half.Don't print any errors,and use a modulo of MAX-ITERATIONS.");; For this function, you should pass in the data just like it's defined;; in the example problems below (that is, not in the "column vector" format;; used by NET-BUILD.Of course, if you need to call NET_BUILD from this function;; you can alway convert this data to column-vector format using CONVERT-DATA within;; the SIMPLE-GENERALIZATION function.;;;; Yes, this is ridiculously inconsistent.Deal with it.:-);;; IMPLEMENT THIS FUNCTION FOR CS 580(defun k-fold-validation (data k num-hidden-units alpha initial-bounds max-iterations)"Given a set of data, performs k-fold validation on this data forthe provided value of k, by training the network on (k-1)/k of the data,then testing generalization on the remaining 1/k of the data.This isdone k times for different 1/k chunks (and building k different networks).The average error among all tested samples is returned.Don't print any errors,and use a modulo of MAX-ITERATIONS.");;;; Some useful preprocessing functions(defun scale-list (lis)"Scales a list so the minimum value is 0.1 and the maximum value is 0.9.Don't use this function, it's just used by scale-data."(let ((min (reduce #'min lis))(max (reduce #'max lis)))(mapcar (lambda (elt) (+ 0.1 (* 0.8 (/ (- elt min) (- max min)))))lis)))(defun scale-data (lis)"Scales all the attributes in a list of samples of the form ((attributes) (outputs))"(transpose (list (transpose (mapcar #'scale-list (transpose (mapcar #'first lis)))) (transpose (mapcar #'scale-list (transpose (mapcar #'second lis)))))))(defun convert-data (raw-data)"Converts raw data into column-vector data of the form thatcan be fed into NET-LEARN.Also adds a bias unit of 0.5 to the input."(mapcar #'(lambda (datum)(mapcar #'(lambda (vec)(mapcar #'list vec))(list (cons 0.5 (first datum))(second datum))))raw-data))(defun average (lis)"Computes the average over a list of numbers.Returns 0 if the list length is 0."(if (= (length lis) 0)0(/ (reduce #'+ lis) (length lis))));;; here are the inputs and outputs of your three problems to test;;; the net function on.(defparameter *nand*'(((0.1 0.1) (0.9))((0.9 0.1) (0.9))((0.1 0.9) (0.9))((0.9 0.9) (0.1))))(defparameter *xor*'(((0.1 0.1) (0.1))((0.9 0.1) (0.9))((0.1 0.9) (0.9))((0.9 0.9) (0.1))));; I converted the attribute values as follows:;; Democrat -> 0.9, Republican -> 0.1;; y -> 0.9, n -> 0.1, no-vote -> 0.5;; The output is democrat or republican;; the input is the following votes:; 1. handicapped-infants: 2 (y,n); 2. water-project-cost-sharing: 2 (y,n); 3. adoption-of-the-budget-resolution: 2 (y,n); 4. physician-fee-freeze: 2 (y,n); 5. el-salvador-aid: 2 (y,n); 6. religious-groups-in-schools: 2 (y,n); 7. anti-satellite-test-ban: 2 (y,n); 8. aid-to-nicaraguan-contras: 2 (y,n); 9. mx-missile: 2 (y,n);10. immigration: 2 (y,n);11. synfuels-corporation-cutback: 2 (y,n);12. education-spending: 2 (y,n);13. superfund-right-to-sue: 2 (y,n);14. crime: 2 (y,n);15. duty-free-exports: 2 (y,n);16. export-administration-act-south-africa: 2 (y,n)

#|;;; some test code for you to try;;; you'll need to run this a couple of times before it globally converges.;;; When it *doesn't* converge what is usually happening?(net-build (convert-data *nand*) 3 1.0 5 20000 1000 t)(net-build (convert-data *xor*) 3 1.0 5 20000 1000 t);; how well does this converge on average?Can you modify it to do better?(net-build (convert-data *voting-records*) 10 1.0 2 5000 250 t);;; how well does this generalize usually?Can you modify it to typically generalize better?(simple-generalization *voting-records* ...);; pick appropriate values;;; how well does this generalize usually?Can you modify it to typically generalize better?(simple-generalization *mpg* ...) ;; pick appropriate values;;; how well does this generalize usually?Can you modify it to typically generalize better?(simple-generalization *wine* ...);; pick appropriate values|#