Welcome to the CHICKEN Scheme pasting service

perlin? pundeshauptstadt? pasted by saeftl on Thu Dec 12 13:18:40 2013

(use random-bsd)
(use srfi-1)

(define (mk-grid n m )
	(let loop ((j 0) (ls '()))
		(if (= j m) ls
			(loop (+ j 1) (append ls (list
				(let loopi ((i 0) (lsi '()))
					(if (= i n) lsi
						(loopi (+ i 1) (cons (list (- (random-real) 0.5)  (- (random-real) 0.5))
									   lsi
						))))))
					))))

(define (dot2 v w)
	(+ (* (car v) (car w)) (* (cadr v) (cadr w))))

(define old-floor floor)
(define old-ceiling ceiling)
(define (floor x)
	(inexact->exact (old-floor x)))
(define (ceiling x)
	(inexact->exact (old-ceiling x)))



(define (ingrid x y grid)
	(define (ease d)
		(- (* 3 (* d d)) (* 2 (* d d))))
	(let* ((x0 (- (floor x) x))
		   (x1 (- x (ceiling x)))
		   (y0 (- (floor y) y))
		   (y1 (- y (ceiling y))))
		   (let* (
				(d0 (dot2 (list x0 y0) (list-ref (list-ref grid (floor x)) (floor y))))
				(d1 (dot2 (list x0 y1) (list-ref (list-ref grid (floor x)) (ceiling y))))
				(d2 (dot2 (list x1 y0) (list-ref (list-ref grid (ceiling x)) (floor y))))
				(d3 (dot2 (list x1 y1) (list-ref (list-ref grid (ceiling x)) (ceiling y)))))
					(+ (/ (+ d0 (ease (- d0 d1))) 2.0) 
					   (/ (+ d2 (ease (- d2 d3))) 2.0)))))

(define gr (mk-grid 4 4))
(print (map (lambda (x) (let ((rx (+ 2.0 (/ x 50.0)))) (ingrid rx rx gr))) (iota 50)))
[ permalink | raw ]

remap values pasted by C-Keen on Thu Dec 12 13:28:59 2013


;; (remap val '(-1 1) '(0 255))

(define (remap value source target)
  (let ((source-low (car source))
        (source-high (cadr source))
        (target-low (car target))
        (target-high (cadr target)))
    (inexact->exact (truncate (+ target-low
              (* (- target-high target-low)
                 (/ (- value source-low)
                    (- source-high source-low))))))))
[ permalink | raw ]

etz aba pasted by saeftl on Fri Dec 13 14:25:44 2013

(use random-bsd)

(use srfi-1)

(define (mk-grid n m)
  (let loop ((j 0) (ls '()))
    (if (> j m)
      ls
      (loop (+ j 1)
            (append
              ls
              (list (let loopi ((i 0) (lsi '()))
                      (if (> i n)
                        lsi
                        (loopi (+ i 1)
                               (cons (list (- (random-real) 0.5)
                                           (- (random-real) 0.5))
                                     lsi))))))))))

(define (dot2 v w) (+ (* (car v) (car w)) (* (cadr v) (cadr w))))

(define old-floor floor)

(define old-ceiling ceiling)

(define (floor x) (inexact->exact (old-floor x)))

(define (ceiling x) (inexact->exact (old-floor (+ x 1.0))))


(define (ingrid x y grid)
  (assert (> (length grid) (ceiling x)))
  (assert (> (length (car grid)) (ceiling y)))
  (assert (not (= (floor x) (ceiling x))))
  (assert (not (= (floor y) (ceiling y))))
  (define (ease d) (- (* 3 (* d d)) (* 2 (* d d))))
  (define (gridnode a b) (list-ref (list-ref grid a) b))
  (let* ((x0 (- x (floor x)))
         (x1 (- (+ 1.0 (ceiling x)) x))
         (y0 (- y (floor y)))
         (y1 (- (+ 1.0 (ceiling y)) y)))
    (let* ((d0 (dot2 (list x0 y0) (gridnode (floor x) (floor y))))
           (d1 (dot2 (list x0 y1) (gridnode (floor x) (ceiling y))))
           (d2 (dot2 (list x1 y0) (gridnode (ceiling x) (floor y))))
           (d3 (dot2 (list x1 y1) (gridnode (ceiling x) (ceiling y)))))
      (+ (/ (+ d0 (ease (- d0 d1))) 2.0) (/ (+ d2 (ease (- d2 d3))) 2.0)))))

(define (to-matlab gr num) 
  (define (allbutlast ls)
	(take ls (- (length ls) 1)))
  (define (linspace start stop n)
    (let ((stepsize (/ (- stop start) (exact->inexact n))))
      (let loop ((i start) (ls '()))
        (if (>= i stop) ls (loop (+ i stepsize) (append ls (list i)))))))
  (let ((maxx (exact->inexact (- (length (car gr)) 1)))
        (maxy (exact->inexact (- (length gr) 1))))
    (let ((xs (allbutlast (linspace 0.0 maxx num))) (ys (allbutlast (linspace 0.0 maxy num))))
      (define (print-xmat)
        (begin
          (print "X = [")
          (map (lambda (y)
                 (begin
                   (print "[")
                   (print (fold (lambda (x acc)
                                  (string-append acc " " (number->string x)))
                                ""
                                xs))
                   (print "],")))
               ys)
          (print "];")))
      (define (print-ymat)
        (begin
          (print "Y = [")
          (map (lambda (y)
                 (begin
                   (print "[")
                   (print (fold (lambda (x acc)
                                  (string-append acc " " (number->string y)))
                                ""
                                xs))
                   (print "],")))
               ys)
          (print "];")))
      (define (print-zmat)
        (begin
          (print "Z = [")
          (map (lambda (y)
                 (begin
                   (print "[")
                   (print (fold (lambda (x acc)
                                  (begin
                                    (string-append
                                      acc
                                      " "
                                      (number->string (ingrid x y gr)))))
                                ""
                                xs))
                   (print "],")))
               ys)
          (print "];")))
      (print-xmat)
      (print-ymat)
      (print-zmat)
      (print "surfc(X,Y,Z); sleep(200);"))))



(define dim 20.0)

(define gr (mk-grid dim dim))

(to-matlab gr 30)
[ permalink | raw ]

yohoho added by saeftl on Fri Dec 13 22:09:01 2013

(use random-bsd)

(use srfi-1)

(define (mk-grid n m)
  (let loop ((j 0) (ls '()))
    (if (> j m)
      ls
      (loop (+ j 1)
            (append
              ls
              (list (let loopi ((i 0) (lsi '()))
                      (if (> i n)
                        lsi
                        (loopi (+ i 1)
                               (cons (list (- (random-real) 0.5)
                                           (- (random-real) 0.5))
                                     lsi))))))))))


(define old-floor floor)

(define old-ceiling ceiling)

(define (floor x) (inexact->exact (old-floor x)))

(define (ceiling x) (inexact->exact (old-floor (+ x 1.0))))

(define (ingrid x y grid)
  (assert (> (length (car grid)) (ceiling x)))
  (assert (> (length grid)) (ceiling y))
  (assert (not (= (floor x) (ceiling x))))
  (assert (not (= (floor y) (ceiling y))))
  (define (ease d) (- (* 3 (* d d)) (* 2 (* d d d))))
  (define (gridnode b a) (list-ref (list-ref grid a) b))
  (define (dot2 v w) (+ (* (car v) (car w)) (* (cadr v) (cadr w))))
  (let* ((x0 (- x (floor x)))
         (x1 (- x (ceiling x)))
         (y0 (- y (floor y)))
         (y1 (- y (ceiling y))))
	(assert (inexact? x1))
    (let* ((s (dot2 (list x0 y0) (gridnode (floor x) (floor y))))
           (t (dot2 (list x0 y1) (gridnode (floor x) (ceiling y))))
           (u (dot2 (list x1 y0) (gridnode (ceiling x) (floor y))))
           (v (dot2 (list x1 y1) (gridnode (ceiling x) (ceiling y))))
           (sx (ease x0))
           (sy (ease y0))
           (a (+ s (* sy (- t s))))
           (b (+ u (* sy (- v u)))))
      (+ a (* sx (- b a))))))


(define (to-matlab gr num)
  (define (allbutlast ls) (take ls (- (length ls) 1)))
  (define (ls->string ls)
    (fold (lambda (x acc) (string-append acc " " (number->string x))) "" ls))
  (define (linspace start stop n)
    (let ((stepsize (/ (- stop start) (exact->inexact n))))
      (let loop ((i start) (ls '()))
        (if (>= i stop) ls (loop (+ i stepsize) (append ls (list i)))))))
  (let* ((maxx (- (length (car gr)) 1))
         (maxy (- (length gr) 1))
         (xs (allbutlast (linspace 0.0 maxx num)))
         (ys (allbutlast (linspace 0.0 maxy num))))
    (define (print-xmat)
      (print "Xrow = [" (ls->string xs) "];")
      (print "X = repmat(Xrow," (length ys) ",1);"))
    (define (print-ymat)
      (print "Ycol = [" (ls->string ys) "];")
      (print "Y = repmat(Ycol', 1, " (length xs) ");"))
    (define (print-zmat)
      (begin
        (print "Z = [")
        (map (lambda (y)
               (begin
                 (print "[")
                 (print (fold (lambda (x acc)
                                (begin
                                  (string-append
                                    acc
                                    " "
                                    (number->string (ingrid x y gr)))))
                              ""
                              xs))
                 (print "],")))
             ys)
        (print "];")))
    (print-xmat)
    (print-ymat)
    (print-zmat)
    (print "surfc(X,Y,Z); sleep(200);")))

(define gr (mk-grid 10 10.0))

(to-matlab gr 40)
[ permalink | raw ]

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
What's the one-argument procedure to check if a list is empty?
Visually impaired? Let me spell it for you (wav file) download WAV