Code Select
(define (unselect lst sel)
(select lst (difference (sequence 0 (dec (length lst))) sel)))
> (unselect '(5 4 3 2 1) '(1 2))
(5 2 1)
- Welcome to newLISP Fan Club.
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
#31
newLISP in the real world / Re: anti-select elements of a list
December 22, 2018, 04:38:52 AM #32
newLISP in the real world / Re: anti-select elements of a list
December 21, 2018, 08:39:58 AMCode Select
(difference '(0 1 2 3 nil) '(1 2))
(0 3 nil)
or am I misunderstanding something?
#33
newLISP in the real world / Re: anti-select elements of a list
December 21, 2018, 08:23:22 AMCode Select
(define (unselect lst sel)
(clean (fn(x) (member x sel)) lst))
(unselect '( 0 1 2 3 nil) '(1 2))
(0 3 nil)
#34
newLISP and the O.S. / Re: Calling OBJC runtime from newlisp
August 27, 2018, 01:42:58 PMCode Select
(define (button-clicked id sel)
(println "button id:" id " function:" (get-string sel))
)
(define (test)
(set 'nsapp (-> "NSApplication" "sharedApplication"))
(-> nsapp "setActivationPolicy:" 1)
(set 'window (-> "NSWindow" "alloc"))
(set 'rect (make-rect 150 150 200 300))
(set 'mask 15 'backing 2 'defer 0)
(=> window "initWithContentRect:styleMask:backing:defer:" rect mask backing defer)
(set 'imp (callback 'button-clicked "void" "void*" "void*" ))
(@add-method (@class "NSButton") (@selector "button-clicked") imp "v@:")
(set 'button (-> "NSButton" "alloc"))
(=> button "initWithFrame:" (make-rect 100 150 80 40))
(-> button "setAction:" (@selector "button-clicked"))
(-> button "setTarget:" button)
(-> button "setBezelStyle:" 1)
(-> (-> window "contentView") "addSubview:" button)
(-> window "makeKeyAndOrderFront:" window)
(-> nsapp "activateIgnoringOtherApps:" 1)
(-> nsapp "run")
)
#35
newLISP and the O.S. / Re: Calling OBJC runtime from newlisp
August 22, 2018, 04:03:02 PMCode Select ;;@module Minimalistic Cocoa / Objective-C bridge
(import "/System/Library/Frameworks/Foundation.framework/Foundation")
(import "/System/Library/Frameworks/AppKit.framework/AppKit")
(set 'get-class (import "libobjc.dylib" "objc_getClass"))
(set 'get-sel (import "libobjc.dylib" "sel_getUid"))
(import "libobjc.dylib" "objc_msgSend")
;; principal function sending a message to an instance or class with a variable
;; number of arguments use when the arguments are NOT floating points or structs
(define (-> ptr sel)
(when (string? ptr) (set 'ptr (get-class ptr)))
(eval (flat (list 'objc_msgSend ptr (get-sel sel) (args))))
)
;; function sending a message to an instance or class using an invocation object,
;; use when the arguments contain floats and or structs. The address of the return
;; value is returned
(define (=> target selector)
(when (string? target)
(set 'target (get-class target)))
(set 'sel (get-sel selector))
(set 'method (-> target "methodSignatureForSelector:" sel))
(set 'invocation (-> "NSInvocation" "invocationWithMethodSignature:" method))
(-> invocation "setSelector:" sel)
(doargs (arg)
(-> invocation "setArgument:atIndex:" (address arg) (+ $idx 2)))
(-> invocation "invokeWithTarget:" target)
(set 'size (-> method "methodReturnLength"))
(set 'return (dup " 00" size))
(-> invocation "getReturnValue:" (address return))
(address return)
)To see an example see below code, which creates a window with a button on it.
Code Select
(struct 'Point "double" "double")
(struct 'Rect "Point" "Point")
(define (makerect x y w h)
(pack Rect (pack Point x y) (pack Point w h)) )
(define (test)
(set 'nsapp (-> "NSApplication" "sharedApplication"))
(-> nsapp "setActivationPolicy:" 1)
(set 'window (-> "NSWindow" "alloc"))
(set 'rect (makerect 150 150 200 300))
(set 'mask 15 'backing 2 'defer 0)
(=> window "initWithContentRect:styleMask:backing:defer:" rect mask backing defer)
(set 'button (-> "NSButton" "alloc"))
(=> button "initWithFrame:" (makerect 100 150 80 40))
(-> button "setBezelStyle:" 1)
(-> (-> window "contentView") "addSubview:" button)
(-> window "makeKeyAndOrderFront:" window)
(-> nsapp "activateIgnoringOtherApps:" 1)
(-> nsapp "run")
)
#36
newLISP in the real world / Re: Any new releases, planned future
August 17, 2018, 02:32:03 PMRegarding the IDE remarks from Lutz I've started with creating newlisp bindings for a platform independent native GUI library: libui
#37
So, what can you actually DO with newLISP? / Neural network in Newlisp
December 21, 2017, 04:21:02 PMI've converted the python program written by Michael Nielsen from his his excellent on-line book at
With this version you can play with stochastic gradient descent for a feedforward neural network.I've included load and convert functions for the MNIST dataset, which is kind of a standard to test learning algorithms against. Download it from
Let me know if you encounter any bugs (most probably!) and Lutz let me know if and how this can can be included as a module.
Ferry
Code Select
;; Mini-batch stochastic gradient descent learning algorithm for a feedforward neural network in newLISP. Based on a python program and book by Michael Nielsen, see http://neuralnetworksanddeeplearning.com/about.html and below for the MIT license.
;Usage (nn:sgd) with arbitrary number and sequence of named parameters .
; For instance (nn:sgd eta 1 network '(784 100 10) lmbda 1), other parameters will use default values, see below.
;; network contains the number of neurons in the respective layers of the network. For example, if the list was [2, 3, 1] then it would be a three-layer network, with the first layer containing 2 neurons, the second layer 3 neurons, and the third layer 1 neuron. For the included MNIST data and load functions the first (input) layer has to contain 784 neurons and the last (ouptput) layer 10. There can be 0-n number of (hiden) layers and neurons in between.
;; epochs The number of times the whole dataset is traversed
;; mini-batch-size the numnber of instances trained together
;; eta the learning rate, positive number, try 0.1 or 1 or 10 and then tweak
;; number the number of instances to train upon (max 60000 for number+test data together for the MNIST training data
;; test-data the number of instances to test against, used for accuracy calculation
;; w-init weight initiliazer function, choice between default-w and large-w
;; cost cost function, choice between quadratic and cross-entropy
;; lmbda used for regularization to prevent overfitting, must be greater or equal to zero.
;; i-path path to the input file, for MNIST the name of the file is train-images.idx3-ubyte,
;; l-path path to output file For MNIST the name of the file is train-labels.idx1-ubyte, download from http://yann.lecun.com/exdb/mnist/
(context 'nn)
(define-macro (sgd)
(set
'network '(784 20 10)
'epochs 10
'mini-batch-size 10
'eta 4
'number 10000
'test-data 100
'w-init default-w
'cost cross-entropy
'lmbda 0
'i-path "Downloads/train-images.idx3-ubyte"
'l-path "Downloads/train-labels.idx1-ubyte"
)
(when (args) (bind (explode (args) 2) true))
(when (< (length input) number)
(load-mnist-train-images (+ number test-data) i-path)
(load-mnist-train-labels (+ number test-data) l-path))
(set 'biases (map (fn(x) (array x 1 (normal 0 1 x))) (rest network)))
(set 'weights (map w-init (rest network) (chop network)))
(dotimes (j epochs)
(setq start (time-of-day))
(setq mini-batches (explode (randomize (sequence 0 number)) mini-batch-size))
(dolist (mb mini-batches)
(update-mini-batch mb))
(if test-data
(silent (fork (println "Epoch:"(+ j 1)
" Duration:"(/ (sub (time-of-day) start) 1000)
" Accuracy:" (format "%2.2f%%" (mul 100 (evaluate number (+ number (- test-data 1))))))))
(println "Epoch: " j " complete"))))
(define (update-mini-batch mini-batch)
(set 'batchsize (length mini-batch))
(backprop mini-batch)
(set 'biases (map (fn(b nb) (mat - b (mat * nb (div eta batchsize))))
biases
(map (fn(x) (multiply x (array batchsize 1 '(1)))) nabla-b)))
(set 'weights (map (fn(w nw) (mat - (mat * w (sub 1 (mul eta (div lmbda number)))) (mat * nw (div eta batchsize))))
weights
nabla-w)))
(define (backprop lst)
(set 'activations (list (transpose (map(fn (x) (flat (input x)))lst)))
'b-biases (map (fn(x) (multiply x (array 1 batchsize '(1)))) biases)
'b-weights weights
'nabla-b '() 'nabla-w '() 'zs '())
(dolist (bw (map list b-biases b-weights))
(push (mat + (multiply (bw 1) (activations -1)) (bw 0)) zs -1)
(push (sigmoid (zs -1)) activations -1))
(set 'delta (cost (activations -1) (transpose (map (fn(x) (flat (output x)))lst)) (zs -1)))
(push delta nabla-b)
(push (multiply delta (transpose (activations -2))) nabla-w)
(setq x -2)
(while (> x (sub (length network)))
(set 'delta (mat * (multiply (transpose (b-weights (+ x 1))) delta) (sigmoid-prime (zs x))))
(push delta nabla-b)
(push (multiply delta (transpose (activations (sub x 1)))) nabla-w)
(dec x)))
;; weight initializers
(define (default-w x y)
(array x y (map (fn(z) (div z (pow x 0.5))) (normal 0 1 (* x y)))))
(define (large-w x y)
(array x y (normal 0 1 (* x y))))
;; cost functions
(define (quadratic a y z)
(mat * (mat - a y) (sigmoid-prime z)))
(define (cross-entropy a y z)
(mat - a y))
;; utility functions
(define (ff f)
(let(a (list (input f)))
(argmax (flat(nth '(-1 -1)(map (fn (b w) (push (sigmoid (mat + (multiply w (a -1)) b)) a -1)) biases weights))))))
(define (ev nr)
(if (= (ff nr) (argmax(flat(output nr))))
1 0))
(define (evaluate start end)
(let (teller 0)
(for (x start end)
(inc teller (ev x)))
(div teller (+(- end start)1))))
(define (load-mnist-data var file number block offset)
(let (buff (read-file file)
parse-bytes (dup "b " block)
lst '())
(for (x offset (+ (- offset 1) (* number block)) block)
(push (explode (unpack parse-bytes (slice buff x block))) lst -1))
(set var lst))true)
(define (load-mnist-train-images number i-path)
(load-mnist-data (sym 'input) i-path number 784 16)
(set 'input (map m-normalize (eval 'input)))true)
(define (load-mnist-train-labels number l-path)
(load-mnist-data (sym 'output) l-path number 1 8)
(set 'output (convert (eval 'output)))true)
(define (convert labels)
(map (fn (x) (setq t (dup 0 10)) (setq (t (x 0)) 1)(explode t)) labels))
(define (m-map function matrix)
(map (fn(x) (map function x)) matrix))
(define (sigmoid-n z)
(div 1 (add 1 (exp (sub z)))))
(define (sigmoid-prime-n z)
(let (sig (sigmoid-n z))
(mul sig (sub 1 sig))))
(define (sigmoid m)
(m-map sigmoid-n m))
(define (sigmoid-prime m)
(m-map sigmoid-prime-n m))
(define (argmax lst)
(find (apply max lst) lst))
(define (shape lst)
(list (length lst) (length (lst 0))))
(define (normalize n (qty 255))
(div n qty))
(define (m-normalize m )
(m-map normalize m))
(define (m-log m)
(m-map log m))
(define (m-log-1 m)
(m-map log-1 m))
(define (log-1 n)
(log (sub 1 n)))
(context 'MAIN)
; NewLIps version based on Python program wriiten by Michael Nielsen, see below license of Python program.
;MIT License
;Copyright (c) 2012-2015 Michael Nielsen
;Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
;The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#38
newLISP in the real world / Re: Giving nil a value
November 07, 2017, 04:42:36 AMyou'll have to refer to an index in the list to set the correct value in the list, i is just a temporary loop variable, see below.
Code Select
(set 'a '(1 2 nil 4))
(dolist (i a)(when (null? i)(setf (a $idx) "none")))
This works but doesn't return the changed list. An easier way is to use the replace function:
Code Select
(set 'a '(1 2 nil 4))
(replace nil a "none")
>
(1 2 nil 4)
(1 2 "none" 4) #39
newLISP in the real world / Re: Best way to slice a long list in sublists
October 24, 2017, 03:22:06 PMCode Select (explode slotlist 7)There are a *lot* of usefull functions standard in newlisp ;-)
And if there wasn't such a function i would write something like:
Code Select (define (my-exp llst number)
(if (empty? llst)
'()
(cons (0 number llst) (my-exp (number llst) number))))Who doesn't like recursion and implicit indexing ! ;-)
Mvg
Ferry
#40
newLISP newS / Re: newLISP in a browser
June 26, 2017, 03:09:08 PMi've now als run some test on my iPad Pro, running beta of IOS 11 and also Safari 11 which should be able to run web assembly, results below:
With javascript:
>>>> total time: 3139
>>>>> Performance ratio: 5.31 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
With web-assembly:
>>>>> total time: 1633
>>>>> Performance ratio: 2.86 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
So almost twice as fast with web assembly.
#41
newLISP newS / Re: newLISP in a browser
June 24, 2017, 02:25:38 PMFirefox JS
>>>>> total time: 535
>>>>> Performance ratio: 1.08 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
Chrome JS
>>>>> total time: 1397
>>>>> Performance ratio: 2.48 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
Firefox Web Assembly
>>>>> total time: 511
>>>>> Performance ratio: 1.04 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
Chrome Web Assembly
>>>>> total time: 594
>>>>> Performance ratio: 1.17 (1.0 on MacOSX 10.9, 2.3GHz Intel Core i5, newLISP v10.6.0-64-bit)
#42
newLISP newS / Re: newLISP in a browser
June 24, 2017, 01:55:53 PM #43
newLISP newS / Re: newLISP in a browser
June 24, 2017, 12:35:05 PMI eventually found out where to put the switch in the build file and it works in Firefox and Chrome (not in Safari), haven't tested Explorer/Edge.
You can download newlisp-js-lib.js.wa and newlisp-js-lib.js.wasm from
You have to rename newlisp-js-lib.js.wa to newlisp-js-lib.js and put in together with new lisp-js-lib.wasm in the document directory of your web server.
I've also done some performance tests with a small Scrabble program i wrote and it is really remarkable how fast JS/WA is compared to native Newlisp (on iMac, 3.2Ghz Intel Core I3, 12 GB Ram). See below some results how long it takes to find the best solution in my little (naive/unoptimised/educational!) Scrabble program , (choosing from 35,000 words, having 5 letter and 2 jokers, 3 words already on the board).
All examples run on iMac OSX 10.12.5 (Sierra), 3.2Ghz Intel Core I3, 12 GB Ram (in minutes CPU time)
5.5
Firefox : 5
Chrome: 8
Safari Nightly: 8
Safari: 10
Firefox: 4.5
Chrome:5.5
#44
newLISP newS / Re: newLISP in a browser
June 21, 2017, 03:32:24 PMMade the js (and .mem file) available to download from here:
BR
Ferry
#45
newLISP newS / Re: newLISP in a browser too many setjmps
June 21, 2017, 12:48:51 AMGot a warning because there is the -s MAX_SETJMPS=100 setting in the makefile which isn't used/supported anymore with latest emscripten, so better to remove it in future versions.