Does inner and outer reduction always create the same value, if not what would cause different ones?
I am talking about Racket, a functional language.
There are I know possibilities where it is more efficient like in Racket but actually causing a different result. I wasn't able to create a case where that happens, but I feel like it should be possible and may be. dangerous not to know.
Example:
;inner reduction
(sqr (* 3 (+ 1 (sqr 2))))
->(sqr (* 3 (+ 1 (* 2 2))) ;(sqr)
->(sqr (* 3 (+ 1 4)) ;(*)
->(sqr (* 3 5)) ;(+)
->(sqr 15) ;(*)
->(* 15 15) ;(sqr)
->225 ;(*)
;outer reduction
(sqr (* 3 (+ 1 (sqr 2))))
->(* (* 3 (+ 1 (sqr 2))) (* 3 (+ 1 (sqr 2))) ;(sqr)
->(* (* 3 (+ 1 (* 2 2))) (* 3 (+ 1 (sqr 2))) ;(sqr)
->(* (* 3 (+ 1 4)) (* 3 (+ 1 (sqr 2))) ;(*)
->(* (* 3 5) (* 3 (+ 1 (sqr 2))) ;(+)
->(* 15 (* 3 (+ 1 (sqr 2))) ;(*)
->(* 15 (* 3 (+ 1 (* 2 2))) ;(sqr)
->(* 15 (* 3 (+ 1 4))) ;(*)
->(* 15 (* 3 5)) ;(+)
->(* 15 15) ;(*)
->225 ;(*)
I don't know Racket, but in general you can run into trouble if any of your expressions have side effects, such as modifying variables, doing input/output, etc.
Take the following example:
(define x 1)
(sqr (begin (set! x (add1 x)) x))
Inner reduction:
; x = 1
(sqr (begin (set! x (add1 x)) x))
; x = 2
(sqr (begin x))
; x = 2
(sqr (begin 2))
; x = 2
(sqr 2)
; x = 2
(* 2 2)
; x = 2
4
I.e. the result is 4 and the final value of x is 2.
With outer reduction, you get:
; x = 1
(* (begin (set! x (add1 x)) x)
(begin (set! x (add1 x)) x))
; x = 2
(* (begin x)
(begin (set! x (add1 x)) x))
; x = 2
(* 2
(begin (set! x (add1 x)) x))
; x = 3
(* 2
(begin x))
; x = 3
(* 2
(begin x))
; x = 3
(* 2
3)
; x = 3
6
I.e. the result is 6 and the final value of x is 3.
There's another difference. With inner reduction it's possible that you don't get a result at all:
(define (my-if c t e)
(if c t e))
(define (loop)
(loop))
(my-if #t 42 (loop))
With outer reduction:
(my-if #t 42 (loop))
; definition of 'my-if'
(if #t 42 (loop))
; built-in 'if'
42
With inner reduction:
(my-if #t 42 (loop))
; definition of 'loop'
(my-if #t 42 (loop))
; definition of 'loop'
(my-if #t 42 (loop))
; definition of 'loop'
(my-if #t 42 (loop))
; definition of 'loop'
...
This never terminates.
Related
Write a function that takes two lists of numbers, numerators and denominators, and returns a list of fractions produced by dividing numerators by denominators. If one list is shorter than the other, assume that the corresponding numbers are all 1s. Don't worry about zeros in the denominators (it's ok if your function breaks when dividing by zero).
Input: (list 1 2 3) (list 1 3 5)
Output: (list 1/1 2/3 3/5)
You can solve it by recursion:
(define (r-map func l1 l2 (default-l1 1) (default-l2 1) (acc '()))
(cond ((and (null? l1) (null? l2)) (reverse acc))
((null? l1) (r-map func '() (cdr l2) default-l1 default-l2 (cons (func default-l1 (car l2)) acc)))
((null? l2) (r-map func (cdr l1) '() default-l1 default-l2 (cons (func (car l1) default-l2) acc)))
(else (r-map func (cdr l1) (cdr l2) default-l1 default-l2 (cons (func (car l1) (car l2)) acc)))))
The nice thing with this function is that you can change the default value for each list independently from each other.
Test it:
(define a '(1 2 3))
(define b '(4 5 6))
(define c '(10 20))
(define d '(40 50 60 70))
;; run all combinations of the four:
(let ((lists (list a b c d)))
(for*/list [(x lists)
(y lists)]
(list `(r-map ,x ,y ,default-l1 ,default-l2) '=> (r-map / x y))))
It returns:
Welcome to DrRacket, version 6.11 [3m].
Language: racket, with debugging; memory limit: 128 MB.
'(((r-map (1 2 3) (1 2 3) 1 1) => (1 1 1))
((r-map (1 2 3) (4 5 6) 1 1) => (1/4 2/5 1/2))
((r-map (1 2 3) (10 20) 1 1) => (1/10 1/10 3))
((r-map (1 2 3) (40 50 60 70) 1 1) => (1/40 1/25 1/20 1/70))
((r-map (4 5 6) (1 2 3) 1 1) => (4 2 1/2 2))
((r-map (4 5 6) (4 5 6) 1 1) => (1 1 1))
((r-map (4 5 6) (10 20) 1 1) => (2/5 1/4 6))
((r-map (4 5 6) (40 50 60 70) 1 1) => (1/10 1/10 1/10 1/70))
((r-map (10 20) (1 2 3) 1 1) => (10 10 1/3))
((r-map (10 20) (4 5 6) 1 1) => (2 1/2 4 1/6))
((r-map (10 20) (10 20) 1 1) => (1 1))
((r-map (10 20) (40 50 60 70) 1 1) => (1/4 2/5 1/60 1/70))
((r-map (40 50 60 70) (1 2 3) 1 1) => (40 25 20 70))
((r-map (40 50 60 70) (4 5 6) 1 1) => (10 10 10 70))
((r-map (40 50 60 70) (10 20) 1 1) => (4 2 1/2 60 70))
((r-map (40 50 60 70) (40 50 60 70) 1 1) => (1 1 1 1)))
Let's do this a bit more straightforwardly.
There are two simple cases:
Both lists are empty; the result is '()
Neither list is empty; cons the fraction of the cars onto the result of recursing.
Short-circuiting out the tricky cases:
(define (fractions ns ds)
(cond [(and (null? ns) (null? ds)) '()]
[(null? ns) 'only-denominators]
[(null? ds) 'only-numerators]
[else (cons (/ (car ns) (car ds)) (fractions (cdr ns) (cdr ds)))]))
Test:
> (fractions '() '())
'()
> (fractions '(1 2) '(4 5))
'(1/4 2/5)
> (fractions '(1 2 3) '(4 5))
'(1/4 2/5 . only-numerators)
> (fractions '(1 2) '(4 5 6))
'(1/4 2/5 . only-denominators)
If there are only numerators, the results are the same as those numerators, since x/1 is the same as x:
...
[(null? ds) ns]
...
And if there are only denominators, you divide 1 with each element.
This is easy with map:
...
[(null? ns) (map (lambda (d) (/ 1 d)) ds)]
...
In full:
(define (fractions ns ds)
(cond [(and (null? ns) (null? ds)) '()]
[(null? ns) (map (lambda (d) (/ 1 d)) ds)]
[(null? ds) ns]
[else (cons (/ (car ns) (car ds)) (fractions (cdr ns) (cdr ds)))]))
Test:
> (fractions '() '(4 5 6))
'(1/4 1/5 1/6)
> (fractions '(1 2 3) '())
'(1 2 3)
> (fractions '(1 2 3) '(4 5))
'(1/4 2/5 3)
> (fractions '(1 2) '(4 5 6))
'(1/4 2/5 1/6)
I was trying to make a function that does scalar to vector multiplication using map, but doesn't seem to work.
(define (f k m)
(map (lambda (x) (map * k x)) m))
Example usage would be (f 2 '((1 2 3) (4 5 6) (7 8 9))) which would give '((2 4 6) (8 10 12) (14 16 18)).
Thanks.
You are near the solution, which requires two maps, since you have a list of lists:
(define (f k m)
(map (lambda (x)
(map (lambda (y) (* k y))
x))
m))
(f 2 '((1 2 3) (4 5 6) (7 8 9)))
; => '((2 4 6) (8 10 12) (14 16 18))
I have this board [10,10] for this project below and I can't move the piece on the board
this question is part of the other questions about Lisp, you can see on my profile
(defun board ()
"T in position x=0 and y=0"
'(
(T 25 54 89 21 8 36 14 41 96)
(78 47 56 23 5 NIL 13 12 26 60)
(0 27 17 83 34 93 74 52 45 80)
(69 9 77 95 55 39 91 73 57 30)
(24 15 22 86 1 11 68 79 76 72)
(81 48 32 2 64 16 50 37 29 71)
(99 51 6 18 53 28 7 63 10 88)
(59 42 46 85 90 75 87 43 20 31)
(3 61 58 44 65 82 19 4 35 62)
(33 70 84 40 66 38 92 67 98 97)
)
)
not the same but similar here the rows begin at 1 but in project is start by 0
and this function to print the board
(defun print-board (board)
(format T "~%")
(mapcar (lambda (x) (format T " ~A ~%" x)) board)
(format nil ""))
I have 8 movements implemented but I only put 4 examples for the
question not to get too much code
(defun UP-LEFT (x y board)
"Function that receives 2 indexes and board, validate movement and move piece up and left"
(cond
((equal (validate-movements (- x 1) (- y 2) board) 0)
(move-piece x y -1 -2 board))
(T nil)))
(defun UP-RIGHT (x y board)
"receive 2 indexes and board, validate movement and move piece up and right"
(cond
((equal (validate-movements (+ x 1) (- y 2) board) 0)
(move-piece x y 1 -2 board))
(T nil)))
(defun LEFT-DOWN (x y board)
"Function that receives 2 indexes and board, validate movement and move piece left and down"
(cond
((equal (validate-movements (- x 2) (+ y 1) board) 0)
(move-piece x y -2 1 board))
(T nil)))
(defun LEFT-UP (x y board)
"Function that receives 2 indexes and board, validate movement and move piece left and up"
(cond
((equal (validate-movements (- x 2) (- y 1) board) 0)
(move-piece x y -2 -1 board))
(T nil)))
(defun DOWN-RIGHT (x y board)
"Function that receives 2 indexes and board, validate movement and move piece down and right"
(cond
((equal (validate-movements (+ x 1) (+ y 2) board) 0)
(move-piece x y 1 2 board))
(T nil)))
my doubt is in this move piece in board in axis (x,y)
(defun move-piece (x y dx dy board)
"Function that receives two indexes and board to move the piece on the board"
(mapcar
(lambda (L)
(cond
((atom L) L)
((and
(equal (nth 0 L) x)
(equal (nth 1 L) y))
(list (+ (nth 0 L) dx) (+ (nth 1 L) dy) (nth 2 L)
(nth 3 L) (nth 4 L) (nth 5 L) (nth 6 L)
(nth 7 L) (nth 8 L) (nth 9 L)))
(T L))) board))
and this function to validate movements
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(cond
((and
;; validation of rows and columns
(>= x 0)
(>= y 0)
(<= x 9)
(<= y 9)
(= (apply '+ (mapcar (lambda (L)
(cond
((atom L) 0)
((or (not(equal (nth 0 L ) x)) (not (equal (nth 1 L) y))) 0)
(T 1))) board)) 0)) 0)
(T nil )))
when I try to test the movements https://ideone.com/jaeCLu it's not move,
because don´t return nothing and show nothing
what I´m doing wrong?
Let's take a look at the validation function. First, make sensible limebreaks: when a multiline form is closed, break the line.
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(cond ((and
;; validation of rows and columns
(>= x 0)
(>= y 0)
(<= x 9)
(<= y 9)
(= (apply '+
(mapcar (lambda (L)
(cond ((atom L) 0)
((or (not (equal (nth 0 L ) x))
(not (equal (nth 1 L) y)))
0)
(T 1)))
board))
0))
0)
(T nil )))
A condition that has only two possible outcomes is better handled through if:
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(if (and
;; validation of rows and columns
(>= x 0)
(>= y 0)
(<= x 9)
(<= y 9)
(= (apply '+
(mapcar (lambda (L)
(cond ((atom L) 0)
((or (not (equal (nth 0 L ) x))
(not (equal (nth 1 L) y)))
0)
(T 1)))
board))
0))
0
nil))
Comparators like <= can take more arguments:
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(if (and (<= 0 x 9)
(<= 0 y 9)
(= (apply '+
(mapcar (lambda (L)
(cond ((atom L) 0)
((or (not (equal (nth 0 L) x))
(not (equal (nth 1 L) y)))
0)
(T 1)))
board))
0))
0
nil))
Since your board is a list of lists (one 10-element sublist per line), a line will never be an atom:
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(if (and (<= 0 x 9)
(<= 0 y 9)
(= (apply '+
(mapcar (lambda (L)
(cond ((or (not (equal (nth 0 L) x))
(not (equal (nth 1 L) y)))
0)
(T 1)))
board))
0))
0
nil))
Again, a two-clause conditional is better an if:
(defun validate-movements (x y board)
"Function that receives two indexes and board to validate movement"
(if (and (<= 0 x 9)
(<= 0 y 9)
(= (apply '+
(mapcar (lambda (L)
(if (or (not (equal (nth 0 L) x))
(not (equal (nth 1 L) y)))
0
1))
board))
0))
0
nil))
Now, I wanted to tell you how booleans are much easier to express logic with. However, that condition makes no sense to me: you seem to check that there is some line on the board that carries the x coordinate in its first field and the y coordinate in the second.
Maybe you wanted to check that the target coordinate is empty?
(defun target-valid-p (x y board)
(and (<= 0 x 9)
(<= 0 y 9)
(null (nth x (nth y board)))))
Next, the move function. Again, linebreaks:
(defun move-piece (x y dx dy board)
"Function that receives two indexes and board to move the piece on the board"
(mapcar (lambda (L)
(cond
((atom L) L)
((and (equal (nth 0 L) x)
(equal (nth 1 L) y))
(list (+ (nth 0 L) dx) (+ (nth 1 L) dy) (nth 2 L)
(nth 3 L) (nth 4 L) (nth 5 L) (nth 6 L)
(nth 7 L) (nth 8 L) (nth 9 L)))
(T L)))
board))
Your lines are never atoms:
(defun move-piece (x y dx dy board)
"Function that receives two indexes and board to move the piece on the board"
(mapcar (lambda (L)
(cond
((and (equal (nth 0 L) x)
(equal (nth 1 L) y))
(list (+ (nth 0 L) dx) (+ (nth 1 L) dy) (nth 2 L)
(nth 3 L) (nth 4 L) (nth 5 L) (nth 6 L)
(nth 7 L) (nth 8 L) (nth 9 L)))
(T L)))
board))
Two-branch conditional is if:
(defun move-piece (x y dx dy board)
"Function that receives two indexes and board to move the piece on the board"
(mapcar (lambda (L)
(if (and (equal (nth 0 L) x)
(equal (nth 1 L) y))
(list (+ (nth 0 L) dx) (+ (nth 1 L) dy) (nth 2 L)
(nth 3 L) (nth 4 L) (nth 5 L) (nth 6 L)
(nth 7 L) (nth 8 L) (nth 9 L))
L))
board))
Use list* and nthcdr to update part of a list:
(defun move-piece (x y dx dy board)
"Function that receives two indexes and board to move the piece on the board"
(mapcar (lambda (L)
(if (and (equal (nth 0 L) x)
(equal (nth 1 L) y))
(list* (+ (nth 0 L) dx)
(+ (nth 1 L) dy)
(nthcdr 2 L))
L))
board))
Now it seems that you again just update the first two cells of the line. Maybe I didn't understand your data model, but I would have thought that you just want to update the cells at the given coordinates:
(defun move-piece (x y dx dy board)
(let ((new-board (copy-tree board))
(new-x (+ x dx))
(new-y (+ y dy))
(piece (nth x (nth y board))))
(setf (nth x (nth y new-board)) nil
(nth new-x (nth new-y new-board)) piece)
new-board))
I can use SHA256 in Scheme using external libraries (Java, C or system dependent) or using a specific Scheme implementation (like Chicken e.g.), but I wonder if there is a "pure" scheme implementation.
I wrote an implementation today. Alas, R5RS has neither bytevectors nor binary I/O, so this uses the R7RS APIs for bytevectors and binary I/O. It should be easy to bridge those APIs to your Scheme implementation's native APIs (for example, I actually tested my implementation on Racket and Guile).
A few notes:
This code assumes case-sensitivity. This is the default for R7RS, but not R5RS, so if you're using an R5RS implementation, beware.
It requires SRFIs 1, 26, 43, and 60.
I emphasise elegance and clarity over speed. In fact, the code is quite slow.
Contrary to what my profile says, I'm only licensing this code under the Apache Licence 2.0 (in addition to the standard Stack Overflow licence of CC BY-SA 3.0), and not under CC0 or anything resembling public domain.
Anyway, without further ado, here it is (also available as a Gist):
;;; Auxiliary definitions to avoid having to use giant tables of constants.
(define primes80 '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73
79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157
163 167 173 179 181 191 193 197 199 211 223 227 229 233 239
241 251 257 263 269 271 277 281 283 293 307 311 313 317 331
337 347 349 353 359 367 373 379 383 389 397 401 409))
(define (sqrt x)
(fold (lambda (_ y) (/ (+ (/ x y) y) 2)) 4 (iota 7)))
(define (cbrt x)
(fold (lambda (_ y) (/ (+ (/ x y y) y y) 3)) 4 (iota 8)))
(define (frac x scale base)
(bitwise-and (floor (* x (arithmetic-shift 1 scale)))
(- (arithmetic-shift 1 base) 1)))
;;; The actual initialisation and constant values.
(define sha1-init '(#x67452301 #xefcdab89 #x98badcfe #x10325476 #xc3d2e1f0))
(define sha2-init (map (lambda (x) (frac (sqrt x) 64 64)) (take primes80 16)))
(define-values (sha512-init sha384-init) (split-at sha2-init 8))
(define sha256-init (map (cut arithmetic-shift <> -32) sha512-init))
(define sha224-init (map (cut frac <> 0 32) sha384-init))
(define sha1-const (map (lambda (x) (frac (sqrt x) 30 32)) '(2 3 5 10)))
(define sha512-const (map (lambda (x) (frac (cbrt x) 64 64)) primes80))
(define sha256-const (map (cut arithmetic-shift <> -32) (take sha512-const 64)))
;;; Utility functions used by the compression and driver functions.
(define (u32+ . xs) (bitwise-and (apply + xs) #xffffffff))
(define (u64+ . xs) (bitwise-and (apply + xs) #xffffffffffffffff))
(define (bitwise-majority x y z)
(bitwise-xor (bitwise-and x y) (bitwise-and x z) (bitwise-and y z)))
(define (bytevector-be-ref bv base n)
(let loop ((res 0) (i 0))
(if (< i n)
(loop (+ (arithmetic-shift res 8) (bytevector-u8-ref bv (+ base i)))
(+ i 1))
res)))
(define (bytevector-u64-ref bv i)
(bytevector-be-ref bv (arithmetic-shift i 3) 8))
(define (bytevector-u32-ref bv i)
(bytevector-be-ref bv (arithmetic-shift i 2) 4))
(define (bytevector-be-set! bv base n val)
(let loop ((i n) (val val))
(when (positive? i)
(bytevector-u8-set! bv (+ base i -1) (bitwise-and val 255))
(loop (- i 1) (arithmetic-shift val -8)))))
(define (md-pad! bv offset count counter-size)
(define block-size (bytevector-length bv))
(unless (negative? offset)
(bytevector-u8-set! bv offset #x80))
(let loop ((i (+ offset 1)))
(when (< i block-size)
(bytevector-u8-set! bv i 0)
(loop (+ i 1))))
(when count
(bytevector-be-set! bv (- block-size counter-size) counter-size
(arithmetic-shift count 3))))
(define (hash-state->bytevector hs trunc word-size)
(define result (make-bytevector (* trunc word-size)))
(for-each (lambda (h i)
(bytevector-be-set! result i word-size h))
hs (iota trunc 0 word-size))
result)
;;; The compression functions.
(define (sha2-compress K Σ0 Σ1 σ0 σ1 mod+ getter hs)
(define W (vector->list (apply vector-unfold
(lambda (_ a b c d e f g h i j k l m n o p)
(values a b c d e f g h i j k l m n o p
(mod+ a (σ0 b) j (σ1 o))))
(length K)
(list-tabulate 16 getter))))
(define (loop k w a b c d e f g h)
(if (null? k)
(map mod+ hs (list a b c d e f g h))
(let ((T1 (mod+ h (Σ1 e) (bitwise-if e f g) (car k) (car w)))
(T2 (mod+ (Σ0 a) (bitwise-majority a b c))))
(loop (cdr k) (cdr w) (mod+ T1 T2) a b c (mod+ d T1) e f g))))
(apply loop K W hs))
(define (sha512-compress bv hs)
(define (rotr x y) (rotate-bit-field x (- y) 0 64))
(define (shr x y) (arithmetic-shift x (- y)))
(sha2-compress sha512-const
(lambda (x) (bitwise-xor (rotr x 28) (rotr x 34) (rotr x 39)))
(lambda (x) (bitwise-xor (rotr x 14) (rotr x 18) (rotr x 41)))
(lambda (x) (bitwise-xor (rotr x 1) (rotr x 8) (shr x 7)))
(lambda (x) (bitwise-xor (rotr x 19) (rotr x 61) (shr x 6)))
u64+ (cut bytevector-u64-ref bv <>) hs))
(define (sha256-compress bv hs)
(define (rotr x y) (rotate-bit-field x (- y) 0 32))
(define (shr x y) (arithmetic-shift x (- y)))
(sha2-compress sha256-const
(lambda (x) (bitwise-xor (rotr x 2) (rotr x 13) (rotr x 22)))
(lambda (x) (bitwise-xor (rotr x 6) (rotr x 11) (rotr x 25)))
(lambda (x) (bitwise-xor (rotr x 7) (rotr x 18) (shr x 3)))
(lambda (x) (bitwise-xor (rotr x 17) (rotr x 19) (shr x 10)))
u32+ (cut bytevector-u32-ref bv <>) hs))
(define (sha1-compress bv hs)
(define (getter x) (bytevector-u32-ref bv x))
(define (rotl x y) (rotate-bit-field x y 0 32))
(define W (vector->list (apply vector-unfold
(lambda (_ a b c d e f g h i j k l m n o p)
(values a b c d e f g h i j k l m n o p
(rotl (bitwise-xor a c i n) 1)))
80
(list-tabulate 16 getter))))
(define (outer f k w a b c d e)
(if (null? k)
(map u32+ hs (list a b c d e))
(let inner ((i 0) (w w) (a a) (b b) (c c) (d d) (e e))
(if (< i 20)
(let ((T (u32+ (rotl a 5) ((car f) b c d) e (car k) (car w))))
(inner (+ i 1) (cdr w) T a (rotl b 30) c d))
(outer (cdr f) (cdr k) w a b c d e)))))
(apply outer (list bitwise-if bitwise-xor bitwise-majority bitwise-xor)
sha1-const W hs))
;;; The Merkle-Damgård "driver" function.
(define (md-loop init compress block-size trunc word-size counter-size in)
(define leftover (- block-size counter-size))
(define bv (make-bytevector block-size))
(define pad! (cut md-pad! bv <> <> counter-size))
(define hs->bv (cut hash-state->bytevector <> trunc word-size))
(let loop ((count 0) (hs init))
(define read-size (read-bytevector! bv in))
(cond ((eof-object? read-size)
(pad! 0 count)
(hs->bv (compress bv hs)))
((= read-size block-size)
(loop (+ count read-size) (compress bv hs)))
((< read-size leftover)
(pad! read-size (+ count read-size))
(hs->bv (compress bv hs)))
(else
(pad! read-size #f)
(let ((pen (compress bv hs)))
(pad! -1 (+ count read-size))
(hs->bv (compress bv pen)))))))
;;; SHA-512/t stuff.
(define sha512/t-init (map (cut bitwise-xor <> #xa5a5a5a5a5a5a5a5) sha512-init))
(define (make-sha512/t-init t)
(define key (string->utf8 (string-append "SHA-512/" (number->string t))))
(define size (bytevector-length key))
(define bv (make-bytevector 128))
(bytevector-copy! bv 0 key)
(md-pad! bv size size 16)
(sha512-compress bv sha512/t-init))
(define (make-sha512/t t)
(define init (make-sha512/t-init t))
(define words (arithmetic-shift t -6))
(if (zero? (bitwise-and t 63))
(cut md-loop init sha512-compress 128 words 8 16 <>)
(lambda (in)
(bytevector-copy
(md-loop init sha512-compress 128 (ceiling words) 8 16 in)
0 (arithmetic-shift t -3)))))
;;; Public entry points.
(define sha1 (cut md-loop sha1-init sha1-compress 64 5 4 8 <>))
(define sha224 (cut md-loop sha224-init sha256-compress 64 7 4 8 <>))
(define sha256 (cut md-loop sha256-init sha256-compress 64 8 4 8 <>))
(define sha384 (cut md-loop sha384-init sha512-compress 128 6 8 16 <>))
(define sha512 (cut md-loop sha512-init sha512-compress 128 8 8 16 <>))
(define sha512/256 (make-sha512/t 256))
(define sha512/224 (make-sha512/t 224))
I implemented all the algorithms in FIPS 180-4, but you can strip out whatever you don't need.
As mentioned before, I tested this on Racket; the definitions I added to bridge to Racket's APIs are as follows:
#lang racket
(require (only-in srfi/1 iota)
(only-in srfi/26 cut)
(only-in srfi/43 vector-unfold)
(only-in srfi/60 bitwise-if rotate-bit-field)
(rename-in racket/base [build-list list-tabulate]
[bytes-copy! bytevector-copy!]
[bytes-length bytevector-length]
[bytes-ref bytevector-u8-ref]
[bytes-set! bytevector-u8-set!]
[foldl fold]
[make-bytes make-bytevector]
[read-bytes! read-bytevector!]
[string->bytes/utf-8 string->utf8]
[subbytes bytevector-copy]))
And here are the definitions for Guile (requires version 2.0.11 or above):
(use-modules (srfi srfi-1) (srfi srfi-26) (srfi srfi-43) (srfi srfi-60)
(rnrs bytevectors) (ice-9 binary-ports))
(define* (bytevector-copy bv #:optional (start 0) (end (bytevector-length bv)))
(define copy (make-bytevector (- end start)))
(bytevector-copy! copy 0 bv start end)
copy)
(define* (bytevector-copy! to at from #:optional (start 0)
(end (bytevector-length from)))
((# (rnrs bytevectors) bytevector-copy!) from start to at (- end start)))
(define* (read-bytevector! bv #:optional (port (current-input-port)) (start 0)
(end (bytevector-length bv)))
(get-bytevector-n! port bv start (- end start)))
It should be easy to make something similar for your chosen implementation.
I also have a function that prints out the output as a hex string, for ready comparison with various command-line SHA-1 and SHA-2 utilities (e.g., sha1sum, sha256sum, sha512sum, etc.):
(define (hex bv)
(define out (open-output-string))
(do ((i 0 (+ i 1)))
((>= i (bytevector-length bv)) (get-output-string out))
(let-values (((q r) (truncate/ (bytevector-u8-ref bv i) 16)))
(display (number->string q 16) out)
(display (number->string r 16) out))))
I am working in Common Lisp, trying to make Windows game minesweeper.
I have a list (1 1 1 2 2 2 3 3 3) and want to print that like matrix
(1 1 1
2 2 2
3 3 3)
How to do that?
Edit
I am at the beginning of
(format t "Input width:")
(setf width (read))
(format t "Input height:")
(setf height (read))
(format t "How many mines:")
(setf brMina (read))
(defun matrica (i j)
(cond ((= 0 i) '())
(t (append (vrsta j) (matrica (1- i) j) ))))
(setf minefield (matrica width height))
(defun stampaj ()
(format t "~%~a" minefield ))
Another example, using the pretty-printer for fun:
(defun print-list-as-matrix
(list elements-per-row
&optional (cell-width (1+ (truncate (log (apply #'max list) 10)))))
(let ((*print-right-margin* (* elements-per-row (1+ cell-width)))
(*print-miser-width* nil)
(*print-pretty* t)
(format-string (format nil "~~<~~#{~~~ad~~^ ~~}~~#:>~%" cell-width)))
(format t format-string list)))
Works like this:
CL-USER> (print-list-as-matrix (loop for i from 1 to 9 collect i) 3)
1 2 3
4 5 6
7 8 9
NIL
CL-USER> (print-list-as-matrix (loop for i from 1 to 25 collect i) 5)
1 2 3 4 5
6 7 8 9 10
11 12 13 14 15
16 17 18 19 20
21 22 23 24 25
NIL
CL-USER> (print-list-as-matrix (loop for i from 1 to 16 collect i) 2)
1 2
3 4
5 6
7 8
9 10
11 12
13 14
15 16
Like this:
(defun print-list-as-grid (list rows cols)
(assert (= (length list) (* rows cols))
(loop for row from 0 below rows do
(loop for col from 0 below cols do
(princ (car list))
(princ #\space)
(setf list (cdr list)))
(princ #\newline)))
* (print-list-as-grid '(a b c d e f g h i) 3 3)
A B C
D E F
G H I
NIL