I m trying to write an lisp function who test if a number is prime or not. I received lambda expression error (i ve searched previouslly answered questions related to this) but i cannot find the solution.
(defun prime(n)
(
(defvar '(*ok* nil) (*i* nil) (*d* nil)
(setf *ok* 1)
(loop for *i* from 1 to (sqrt n) do
(
(if (= (mod n *d*) 0)
(setf *ok* 0))
)
)
(if (= *ok* 1)
(format t "Numarul prim")
(format t "Numarul nu este prim")
)
)
)
I don't mean to sound rude but you do need to read a decent Common Lisp tutorial; your code is more like "you can code C in any language", with some "I didn't get the dynamic variable stuff" thrown in.
To show you what you actually want, here's how I would write your logic:
(defun prime (n)
(if (loop
for i from 2 to (sqrt n)
when (zerop (mod n i)) return nil
finally (return t))
"Numarul prim"
"Numarul nu este prim"))
Testing:
CL-USER> (loop
for i from 2 to 20
do (format t "~a ~a~%" i (prime i)))
2 Numarul prim
3 Numarul prim
4 Numarul nu este prim
5 Numarul prim
6 Numarul nu este prim
7 Numarul prim
8 Numarul nu este prim
9 Numarul nu este prim
10 Numarul nu este prim
11 Numarul prim
12 Numarul nu este prim
13 Numarul prim
14 Numarul nu este prim
15 Numarul nu este prim
16 Numarul nu este prim
17 Numarul prim
18 Numarul nu este prim
19 Numarul prim
20 Numarul nu este prim
NIL
EDIT 1 - using a local variable:
(defun prime (n)
(let ((is-prime t))
(loop
for i from 2 to (sqrt n)
when (zerop (mod n i))
do (setf is-prime nil))
(if is-prime
"Numarul prim"
"Numarul nu este prim")))
EDIT 2 - "how can I sum all these prime numbers"
Let's go back to a true function - in this case, a predicate that indicates if a number is prime (returns t) or not (returns nil):
(defun prime (n)
(loop
for i from 2 to (sqrt n)
when (zerop (mod n i)) return nil
finally (return t)))
CL-USER> (prime 2)
T
CL-USER> (prime 3)
T
CL-USER> (prime 4)
NIL
and a second function that collects all primes between a lower and an upper bound into a list:
(defun primes (pfrom pto)
(loop
for i from pfrom to pto
when (prime i) collect i))
CL-USER> (primes 2 20)
(2 3 5 7 11 13 17 19)
then you just need to
CL-USER> (reduce '+ (primes 2 20))
77
Related
For simplicity, this is a toy version of the actual problem: given a set of integers, find the longest sequence of consecutive numbers from that set.
I looked at CLIPS and other expert systems, and they seem ill-suited to express this kind of problem. Specifically, I don't see a list like data structure, which seems to be necessary to implement a solution. I'm looking for an example of implementation using logic programming.
One way:
CLIPS (6.4 2/9/21)
CLIPS>
(deffacts start
(set 1 9 2 10 4 3 11 13 5 14))
CLIPS>
(defrule combine-1
?f <- (set $?b ?n $?e)
=>
(retract ?f)
(assert (combine ?n))
(assert (set ?b ?e)))
CLIPS>
(defrule combine-2
?f1 <- (combine $?b ?j1)
?f2 <- (combine ?j2&=(+ ?j1 1) $?e)
=>
(retract ?f1 ?f2)
(assert (combine ?b ?j1 ?j2 ?e)))
CLIPS>
(defrule longest
(declare (salience -10))
(combine $?c)
(not (combine $?o&:(> (length$ ?o) (length$ ?c))))
=>
(println "Longest is " ?c))
CLIPS> (reset)
CLIPS> (run)
Longest is (1 2 3 4 5)
CLIPS> (facts)
f-21 (set)
f-22 (combine 13 14)
f-26 (combine 1 2 3 4 5)
f-28 (combine 9 10 11)
For a total of 4 facts.
CLIPS>
Another way:
CLIPS> (clear)
CLIPS>
(deffacts start
(set 1 9 2 10 4 3 11 13 5 14))
CLIPS>
(defrule sort
?f <- (set $?s)
(test (neq ?s (sort > ?s)))
=>
(retract ?f)
(assert (set (sort > ?s))))
CLIPS>
(deffunction consecutive ($?s)
(loop-for-count (?i (- (length$ ?s) 1))
(if (<> (+ (nth$ ?i ?s) 1) (nth$ (+ ?i 1) ?s))
then (return FALSE)))
(return TRUE))
CLIPS>
(defrule longest
(set $? $?s&:(consecutive $?s) $?)
(not (set $? $?s2&~$?s&:(consecutive $?s2)&:(> (length$ ?s2) (length$ ?s)) $?))
=>
(println "Longest is " ?s))
CLIPS> (reset)
CLIPS> (run)
Longest is (1 2 3 4 5)
CLIPS> (facts)
f-2 (set 1 2 3 4 5 9 10 11 13 14)
For a total of 1 fact.
CLIPS>
I am using DrRacket.
How can I write a function for the difference between the maximum and minimum number in the list using accumulators and mutually recursive functions.
For instance, (list 10 2 3 -5 4 1 -6)) 9). The list has at least one element in the list.
Do I need two accumulators?
Version 1: An accumulator based solution that's mutually recursive. Since the input list is assumed to be non-empty, we start of with the first element being max and min. As we go through the list, we pick new max and mins by comparing the current element with the accumulators.
#lang racket
; [NEList-of Number] -> Number
(define (max-min-diff.v1 nelst)
(max-min-diff/t.v1 (rest nelst) (first nelst) (first nelst)))
; [List-of Number] -> Number
(define (max-min-diff/t.v1 l max min)
(cond [(empty? l) (- max min)]
[else (get-new-max-min (rest l) (first l) max min)]))
; [List-of Number] Number Number Number -> Number
(define (get-new-max-min rst fst max min)
(max-min-diff/t.v1 rst
(if (> fst max) fst max)
(if (< fst min) fst min)))
(max-min-diff.v1 '(0 33 2 32 4 8 3 3 5))
; => 33
(max-min-diff.v1'(1 3 9 4 7 2 2 5 11))
; => 10
Version 2: An accumulator based solution that's not mutually recursive. More abstract because we pass the comparators to a generic helper.
; [NEList-of Number] -> Number
(define (max-min-diff.v2 nelst)
(max-min-diff/t.v2 (rest nelst) (first nelst) (first nelst)))
; [List-of Number] -> Number
(define (max-min-diff/t.v2 l max min)
(cond [(empty? l) (- max min)]
[else (max-min-diff/t.v2 (rest l)
(f-if (first l) max >)
(f-if (first l) min <))]))
; X X [X X -> Boolean] -> X
(define (f-if n1 n2 func)
(if (func n1 n2) n1 n2))
(max-min-diff.v2 (list 0 33 2 32 4 8 3 3 5))
; => 33
(max-min-diff.v2 (list 1 3 9 4 7 2 2 5 11))
; => 10
Version 3: Small version. No explicit recursion.
(define (max-min-diff.v3 nelst)
(- (apply max nelst) (apply min nelst)))
(max-min-diff.v3 (list 0 33 2 32 4 8 3 3 5))
; => 33
(max-min-diff.v3 (list 1 3 9 4 7 2 2 5 11))
; => 10
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