working on it ...

## Filters

Sort by

Found 478 snippets

### Y-Combinator description in Racket

Y-Combinator description in Racket: y-combinator-racket.rkt
```;; lambda expression do not have any assignments
;; so we will use the form where there is not lambda expressions

((lambda ()
(define (adder n) (+ n 1))
(define (mult3 n) (* n 3))
))

;; create make-adder and compose using higher-order functions

((lambda ()
(define (make-adder a) (lambda (n) (+ n 1)))
(define (mult3 n) (* n 3))
(define (compose f g) (lambda (x) (f (g x))))
((compose mult3 (make-adder 1)) 10)))

;; tenants correspondence principle
;; introduce binding
;; wrapping a function
;; inlining

;; tenants correspondence principle
((lambda ()
(define (make-adder a) (lambda (n) (+ n 1)))
(define (mult3 n) ((lambda () (* n 3))))  ;; update due to Tenants corresponse principle
(define (compose f g) ((lambda () (lambda (x) (f (g x)))))) ;;update with Tenants correpondence principle
((compose mult3 (make-adder 1)) 10)))

;; introduce a binding
;; wrapping a function
((lambda (x) (+ x  1)) 10)

((lambda ()
(define (make-adder a) (lambda (n1) ((lambda (n) (+ n a)) n1))) ;; wrapping a function
(define (mult3 n) ((lambda (n) (* n 3)) n))
(define (compose f g) (
(lambda (v)
((lambda () (lambda (x) (f (g x)))))) 1234)) ;; introduce binding
((compose mult3 (make-adder 1)) 10)))

;; inlining
((lambda ()
;;(define (make-adder) (lambda (a) (lambda (n1) ((lambda (n) (+ n a)) n1)))) ;; wrapping a function
;;(define (mult3 n) ((lambda (n) (* n 3)) n))
(define (compose f g) (
(lambda (v)
((lambda () (lambda (x) (f (g x)))))) 1234)) ;; introduce binding
((compose
(lambda (n) (* n 3) n)
((lambda (a) (lambda (n1) ((lambda (n) (+ n a)) n1))) 1))
10)))

;; inlinit compose
((lambda ()
;;(define (make-adder) (lambda (a) (lambda (n1) ((lambda (n) (+ n a)) n1)))) ;; wrapping a function
;;(define (mult3 n) ((lambda (n) (* n 3)) n))
;;(define (compose) (lambda (f g)
;;                       (lambda (v)
;;                         ((lambda () (lambda (x) (f (g x)))))) 1234)) ;; introduce binding
(((lambda (f g)
((lambda (v)
((lambda () (lambda (x) (f (g x)))))) 1234))
(lambda (n) (* n 10))
((lambda (a) (lambda (n1) ((lambda (n) (+ n a)) n1))) 20)) 40)))

((lambda ()
(((lambda (f g)
((lambda (v)
((lambda () (lambda (x) (f (g x)))))) 1234))
(lambda (x) (* x 10))
(lambda (x) (+ x 20))) 40)))

((lambda (a) (lambda (n1) ((lambda (n) (+ n a)) n1))) 10)

```

### Count the number of "if" in a given folder and save it in a csv file

Count the number of "if" in a given folder and save it in a csv file: all-we-need-is-if
```#!/usr/bin/racket
#lang racket

(require
racket/date
(only-in srfi/19 string->date))

(define (count-ifs folder)
(string-trim
(with-output-to-string
(lambda ()
(system (format "grep -ore 'if' ~a | wc -l" folder)
#:set-pwd? #t)))
"\n"))

(define (save-to-file filepath result)
(call-with-output-file filepath #:mode 'text #:exists 'append
(lambda (out)
(displayln result out))))

(define (format-result date folder count)
(parameterize ([date-display-format 'iso-8601])
(format "~a,'~a',~a;"
(date->string date #t)
folder
count)))

(define db-path (make-parameter #f))
(define the-date (make-parameter (current-date)))

(define folder
(command-line
#:program "all-we-need-is-if"
#:once-each
[("-d" "--database") path
"Path to the CSV file to populate"
(db-path path)]
[("-f" "--fake-date") date-string
"Fake date to use instead of now"
(the-date (string->date date-string "~Y-~m-~dT~H:~M:~S"))]
#:args ([folder "."])
folder))

(when folder
(define result (format-result (the-date)
folder
(count-ifs folder)))
(if (db-path)
(save-to-file (db-path) result)
(displayln result)))

```

### Fun with Lenses, structs and net/url in Racket

Fun with Lenses, structs and net/url in Racket: net-lens.rkt
```#lang racket/base

(require json
lens
net/url
net/url-string
racket/dict
racket/string)

(struct/lens status (version code text) #:transparent)
(struct/lens response (status headers port) #:transparent)

(define URL "https://httpbin.org/redirect/3")
(define URL2 "http://infoscience.epfl.ch/record/169879/files/RMTrees.pdf")

;; GET url-string and return a response struct
(define (get-url url-string)
(get-pure-port/headers (string->url url-string) #:redirections 5
#:status? #t))
(define status (parse-status (get-status header)))
(response status headers port))

;; Convert dict into jsexpr? (hasheq)
(values (string->symbol (car hd)) (string-trim (cdr hd)))))

;; Pull status string from beginning of header string
(car (regexp-match #px"[\\w/ .]*" header-string)))

;; Convert status string into a struct
(define (parse-status status-str)
(define-values (version code text) (apply values (string-split status-str)))
(status version code text))

;; Lenses
(define get-content-type-lens
(lens-compose (hash-ref-lens 'Content-Type) response-headers-lens))
(define get-status-code-lens
(lens-compose status-code-lens response-status-lens))

;; Use lenses on response structs
(println (lens-view get-status-code-lens (get-url URL))) ; "200"
(println (lens-view get-content-type-lens (get-url URL2))) ; "application/pdf"

```

### Generate a text file from an hexadecimal range

Generate a text file from an hexadecimal range: text-generator.rkt
```#lang racket

(call-with-output-file "data.txt" #:exists 'replace
(lambda (out)
(for ([i (in-range #xF101 #xF12D)])
(write-char (integer->char i) out))))

```

### Example of new pattern for pattern matching in Racket

Example of new pattern for pattern matching in Racket: example-of-new-pattern.rkt
```#lang racket

(define-match-expander aba
(syntax-rules ()
[(aba a b) (list a b a)]))

(define some-list (list 4 3 4))

(match some-list
[(aba x y) (printf "x = ~a, y = ~a\n" x y)])

```

### More sophisticated lazy language with pattern matching & eval interleaved

More sophisticated lazy language with pattern matching & eval interleaved: glorious-haskill-redex.rkt
```#lang racket/base
(require redex)

[x ::= variable-not-otherwise-mentioned]
[ctor ::= cons null A B C #t #f]

; expressions
[e ::=
x
ctor
(e e ...)
(fix (x) e)
(λ (p ...) e)
(case e [p e] ...)
(match m e e)  ; note: used internally, not "surface syntax"
undefined]
[v ::=
ctor
(ctor e ...)
(λ (p ...) e)]

; patterns
[p ::= x ctor (ctor p ...)]
[vp ::= ctor (ctor p ...)]

; matching terms
[m ::=
[p = e]
(and m ...)
(ok Σ)
(fail)]
[Σ ::= ([x e] ...)]

; expression reduction context
[E ::=
(match (in-hole M [vp = E]) e e)
(E e ...)
hole]

; match reduction context
[M ::=
(and (ok Σ) ... M m ...)
hole]

; M inside E
[EM ::= (in-hole E (match M e e))])

app* : (Σ ...) -> Σ
[(app* (([x_i e_i] ...) ...)) ([x_i e_i] ... ...)])

subst* : Σ e -> e
[(subst* () e) e]
[(subst* ([x_1 e_1] [x_i e_i] ...) e)
(subst* ([x_i e_i] ...) (substitute e x_1 e_1))])

split : vp v -> ([p e] ...) or #f
[(split ctor_1 ctor_1) ()]
[(split (ctor_1 p_i ..._n) (ctor_1 e_i ..._n)) ([p_i e_i] ...)]
[(split _ _) #f])

(define rr
#:domain e

;; evaluation

(--> (in-hole E (fix (x) e))
(in-hole E (substitute e x (fix (x) e)))
"E-fix")

(--> (in-hole E ((λ (p_i ..._n) e) e_i ..._n))
(in-hole E (match (and [p_i = e_i] ...) e undefined))
"E-beta")

(--> (in-hole E (case e [p_1 e_1] [p_i e_i] ...))
(in-hole E (match [p_1 = e] e_1 (case e [p_i e_i] ...)))
"E-case")

(--> (in-hole E (case e))
(in-hole E undefined)
"E-case-mt")

(--> (in-hole E (match (ok Σ) e_1 e_2))
(in-hole E (subst* Σ e_1))
"E-ok")

(--> (in-hole E (match (fail) e_1 e_2))
(in-hole E e_2)
"E-fail")

;; pattern matching

(--> (in-hole EM [x = e])
(in-hole EM (ok ([x e])))
"M-bind")

(--> (in-hole EM [vp = v])
(in-hole EM (and [p_i = e_i] ...))
"M-split"
(where ([p_i e_i] ...) (split vp v)))

(--> (in-hole EM [vp = v])
(in-hole EM (fail))
"M-fail"
(where #f (split vp v)))

(--> (in-hole EM (and (ok Σ_i) ...))
(in-hole EM (ok (app* (Σ_i ...))))
"M-ok*")

(--> (in-hole EM (and (ok Σ_i) ... (fail) m ...))
(in-hole EM (fail))
"M-fail*")

))

```

### Partial prototype of a knot theory POW.

Partial prototype of a knot theory POW.: knot-theory-POW.rkt
```#! /usr/bin/env racket

#lang typed/racket #:with-refinements
;(require graph)
;raco pkg install graph
(require typed/racket/date)
(require racket/sequence)
(require typed/racket/date)
(require math/array)
(require math/matrix)

(require typed/racket/unit)
(require pfds/queue/hood-melville)

(define trefoil (array #[#[00 02 01 00]
#[02 10 09 01]
#[03 09 04 06]
#[00 03 05 04]] : Integer))
(define simple-unknot (array #[#[02 01 ]
#[03 04]] : Integer))

;TODO It must have a dimention of N by M
;TODO It must be ambiend isotopic to the knot \$K\$ that we send
;TODO It must have a set of operations \$O\$ of cardinality \$O_n\$
;DONE It must have a crossing number \$C\$
;TODO use a queue (set? ) and a set of mosaic moves to implement the checking of validity of a set of moves.
;source is optional
; Knot table
;KNOTS are specified as a \$N * M\$ matrix corresponding to \$0-18\$ that maps to the set of mosaic tiles \$T_0\$ to \$T_n\$

;(define culprit (matrix-graph [[0 3 8 #f -4]
;                           [#f 0 #f 1 7]
;                           [#f 4 0 #f #f]
;                           [2 #f -5 0 #f]
;                           [#f #f #f 6 0]]))
; https://docs.racket-lang.org/math/matrix_types.html#%28form._%28%28lib._math%2Fmatrix..rkt%29._.Matrix%29%29
(struct braidcoin ([source_knot : (Matrix Integer)]
[target_knot : (Matrix Integer)]
[crossing_number : (Refine [n : Integer] (> n 0))]
[dimention : (Refine [n : Integer] (> n 0))]
[timestamp : date])
#:prefab)
(define unknot-trefoil (braidcoin trefoil simple-unknot 3 4 (current-date)))
(define unknot-unknot (braidcoin simple-unknot simple-unknot 3 4 (current-date)))

;* Header X-braidcoin: 0:SOURCE_KNOT:DESTINATION_KNOT:CROSSING_NUMBER:DIMENTION:OPERATION_COUNTER:DATE

;KNOTS are specified as a \$N * M\$ matrix corresponding to \$0-18\$ that maps to the set of mosaic tiles \$T_0\$ to \$T_n\$
(struct knot-operations ([queue : braidcoin]))
(: crossing-number (-> (Array Integer) Integer))
(define (crossing-number array)
;09 and 10 correspond to over and under crossing
(array-count (λ: ([x : Integer]) (or (equal? x 10) (equal? x 09))) array))
(: crossing-number-test (-> braidcoin Boolean))
(define (crossing-number-test bc)
;DONE It must have a crossing number \$C\$
(if (equal? (crossing-number (braidcoin-source_knot bc))
(crossing-number (braidcoin-target_knot bc)))
#t
#f))
;(struct knot-operations braidcoin)
;(define (expansion move braidcoin)
;  #t)
;(define (reidmeister-1 braidcoin)
;  #t)

(define-type Tree (U leaf node))

(struct leaf  ([source_knot : (Matrix Integer)]
[target_knot : (Matrix Integer)]
[crossing_number : (Refine [n : Integer] (> n 0))]
[dimention : (Refine [n : Integer] (> n 0))]
[timestamp : date])
#:prefab)
(struct node ([left : Tree] [right : Tree]))

(: tree-height (-> Tree Integer))
(define (tree-height t)
(cond [(leaf? t) 1]
[else (max (+ 1 (tree-height (node-left t)))
(+ 1 (tree-height (node-right t))))]))

(define unknot-trefoil-leaf (leaf trefoil simple-unknot 3 4 (current-date)))
(define unknot-unknot-leaf (leaf simple-unknot simple-unknot 3 4 (current-date)))
(tree-height (node unknot-unknot-leaf unknot-trefoil-leaf))
(node unknot-unknot-leaf unknot-trefoil-leaf)
(tree-height (node unknot-unknot-leaf unknot-trefoil-leaf))

;(: test-fail (-> Tree Boolean))
;(define (tree-height t)
;  (cond [eqv? (crossing-number (node-left t)) (node-right t) #f]
;        [else (max (+ 1 (tree-height (node-left t)))
;                   (+ 1 (tree-height (node-right t))))]))

;(struct queue)
;(struct chain)
;(struct current_transactions)

```

### racket aoc2017.1

racket aoc2017.1: aoc2017.1.rkt
```#lang racket

(define (chk s)
(println s)
(let ([f (first s)]
[g (first (rest s))])
(printf "~a ~a\n" f g)
)
)

(define (precheck s)
(chk (string->list s))
)

(precheck "1122")

```

### Basic implementation of Church Numerals and Compound date in Scheme utilizing lambda calculus

Basic implementation of Church Numerals and Compound date in Scheme utilizing lambda calculus: LambdaPractice.rkt
```#lang scheme

;;---Lambda Calculus---

(define I
(λ (x) x))

(define K
(λ (x) (λ (y) x)))

(define KI
(λ (x) ((K I) x)))

(define V
(λ (x) (λ (y) (λ (f) ((f x) y)))))

;;---Constructor and Selector Functions---

(define cons
(λ (x y) ((V x) y)))

(define car
(λ (l) (l K)))

(define cdr
(λ (l) (l KI)))

;;---Church Numerals and Arithmetic---

(define zero
(λ (f) (λ (x) x)))

(define succ
(λ (n)
(λ (f) (λ (x)
(f ((n f) x))))))

(λ (m) (λ (n)
(λ (f) (λ (x)
((m f) ((n f) x)))))))

(define one   (λ (f) (λ (x) (f  x))))
(define two   (λ (f) (λ (x) (f (f  x)))))
(define three (λ (f) (λ (x) (f (f (f  x))))))

;;---Printing and Output Functions---

(define printPair
(λ (p) (begin
newline
(display "(")
(display (car p))
(display ",")
(display (cdr p))
(display ")"))))

(define printNumeral
(λ (n) (display
((n (λ (x) (+ x 1))) 0))))

```

### Accessible minimal website

Accessible minimal website: serverlet.rkt
```#lang racket/base

(require web-server/servlet
web-server/servlet-env)

(define (start req)
(response/xexpr
`(html ([lang "en"])
(meta ([charset "utf-8"]))
(meta ([name "viewport"]
[content "width=device-width, initial-scale=1.0, shrink-to-fit=no"]))
(head (title "Hello world!")
(style ([type "text/css"])
"@keyframes focus {0% {outline: 1px solid; outline-offset: 1em;} 100% {outline: 6px solid; outline-offset: .10em;}}"
"a:focus {outline: 6px solid; outline-offset: .10em; animation: focus .15s}"
"html {font-family: Fira Code;}"
"body {min-width: 26ch; max-width: 60ch; width: 100%; margin: 0 auto;}"
"aside {width: 50%; float: right;}"
"aside p {margin: 10px; text-align: right;}"
"p {text-align: justify;}"))
(body (header (h1 "Vegetables & Fruits"))
(nav (ul
(li (a ([href "#vegetables"]) "Vegetables"))
(li (a ([href "#fruits"]) "Fruits"))
(main
(article
(h2 ([id "vegetables"]) "Vegetables")
(p "I love vegetables.")
(p "abcdefghijklmnopqrstuvwxyz")
(p "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefgh")
(h3 "Especially")
(p "Bla bla bla...")
(p "Bla bla."))
(article
(h2 ([id "fruits"]) "Fruits")
(p "I also like fruits.")
(h3 "Especially")
(p "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. "
"Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.")
(aside (p "Note to self: add some content here."))
(p "Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. "
"Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")))
(footer
(p "We like vegetables and fruits")
(hr)

(serve/servlet start)

```
• Public Snippets
• Channels Snippets