Initial commit (again)

LICENSE

@@ -0,0 +1,22 @@
+Copyright 2019 Markus Pfeiffer
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation and/or
+   other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,10 @@
+[![Travis build Status](https://travis-ci.org/markuspf/coignear.svg?branch=master)](https://travis-ci.org/markuspf/coignear)
+
+# `còignear` -- implementation of some computer algebra algorithms in Racket
+
+Currently an experiment with the following goals:
+
+ * Do something. Make it work.
+
+
+## Resources

info.rkt

@@ -0,0 +1,7 @@
+#lang info
+(define collection
+  'multi)
+(define deps
+  '("base" "scribble-lib"))
+(define build-deps
+  '("racket-doc" "rackunit-lib"))

math/cgt.rkt

@@ -0,0 +1,36 @@
+#lang at-exp racket/base
+
+
+(require scribble/srcdoc
+         racket/contract
+         (for-doc racket/base
+                  scribble/base
+                  scribble/manual))
+
+
+(struct permutation
+  (image inverse)
+  #:transparent)
+
+; TODO: consistent naming for constructors
+
+; Things that permutations do:
+; *, ^, degree, inverse
+; orbits (cycles)
+; printing
+; reading
+; serialisation
+; extend (to bigger degree)
+; restrict (to smaller degree)
+; does the notion of a largest moved point make sense?
+
+; collections of permutations: lists, vectors, collection of same degree perms
+
+; need the omega that permutations act on, and subsets
+; union-find
+
+; tests
+
+(provide (proc-doc/names
+          permutation? (-> any/c boolean?)
+          (x) @{Determines if @racket[x] is a permutation.}))

math/cgt/cgt.scrbl

@@ -0,0 +1,20 @@
+#lang scribble/doc
+@(require scribble/manual
+          scribble/basic
+          scribble/extract
+          (for-label (except-in ffi/unsafe ->)
+                     racket
+                     math/cgt))
+
+@title[#:tag "top"]{Computational Group Theory in Racket}
+@author[(author+email "Markus Pfeiffer" "[email protected]")]
+
+@defmodule[math/cgt]
+
+This package provides implementations of algorithms in computational group theory, currently focusing on permutation groups.
+It aims at having clean, simple, and performant implementations of the nearly-linear time library described in Seress' book "Permutation Group Algorithms", and efficient implementations of partition backtrack and extensions..
+
+@local-table-of-contents[]
+
+@include-extracted[math/cgt]
+

math/cgt/info.rkt

@@ -0,0 +1,3 @@
+#lang setup/infotab
+(define name "Seress -- CGT in Racket")
+(define scribblings '(["cgt.scrbl" (multi-page) (net-library)]))

math/cgt/permutations-in-symmetric.rkt

@@ -0,0 +1 @@
+#lang racket

math/cgt/permutations-with-degree.rkt

@@ -0,0 +1,24 @@
+#lang racket
+
+(struct permutation
+  (degree image inverse))
+
+(define (identity-perm n)
+  (make-permutation n #() #()))
+
+; natural action of a permutation in (symmetric-group 1 n) on [1..n]
+(define (permutations-apply n pt . perms)
+  (match perms
+    [(list) pt]
+    [(list p ps ...)
+     (apply permutations-apply (vector-ref (permutation-image p) pt) ps)]))
+
+(define (permutation-* n . ps)
+  (match ps
+    [(list) (idperm n)]
+    [(list p) p]
+    [(list p ps ...)
+     (permutation-* n)]))
+
+(define (permutation-inverse n p)
+  p)

math/cgt/permutations.rkt

@@ -0,0 +1,110 @@
+#lang racket/base
+
+(require
+  rackunit
+  racket/list
+  racket/vector
+  racket/set
+  racket/match
+  syntax/parse/define
+  (for-syntax racket/base syntax/parse))
+
+(provide permutation
+         permutation-degree
+         permutations-apply
+         permutation-*
+         permutation-image
+         permutation-inverse
+         permutation-identity
+         permutation-cycles
+         permutation-random)
+
+(struct permutation (image) #:transparent)
+
+(define (permutation-degree perm)
+  (vector-length (permutation-image perm)))
+
+#;(define (permutation-apply pt . perms)
+  (if (empty? perms)
+      pt
+      (permutation-apply
+       (vector-ref (permutation-image (car perms) pt))
+       (cdr perms))))
+
+(define (permutations-apply pt . perms)
+  (match perms
+    [(list) pt]
+    [(list p ps ...)
+     (apply permutations-apply (vector-ref (permutation-image p) pt) ps)]))
+
+(define (permutation-* . ps)
+  (match ps
+    [(list) idperm]
+    [(list p ps ...)
+  (permutation
+   (for/fold [(res (permutation-image (car ps)))]
+             [(p (rest ps))]
+     (vector-map (lambda (x) (permutations-apply x p)) res)))]))
+
+(define (permutation-identity degree)
+  (permutation (list->vector (range degree))))
+
+(define (permutation-inverse perm)
+  (let* [(im (permutation-image perm))
+         (deg (permutation-degree perm))
+         (result (make-vector deg))]
+    (for [(i (in-range deg))]
+      (vector-set! result (vector-ref im i) i))
+    (permutation result)))
+
+
+; TODO: find out whether it's a good idea
+;       to use a macro here
+#;(define (vector-swap! v i j)
+    (let [(tmp (vector-ref v i))]
+      (vector-set! v i (vector-ref v j))
+      (vector-set! v j tmp)))
+
+(define-syntax (vector-swap! stx)
+  (syntax-parse stx
+    [(_ v i j)
+     #'(let* [(_i i)
+              (_j j)
+              (tmp (vector-ref v _i))]
+         (vector-set! v _i (vector-ref v _j))
+         (vector-set! v _j tmp))]))
+
+(define (permutation-random degree)
+  (let [(v (build-vector degree (λ(x) x)))]
+    (for [(i (in-range degree))]
+      (vector-swap! v i (random i degree)))
+    (permutation v)))
+
+(define (permutation-orbit/list pnt pnts perm)
+  (let [(new (permutations-apply (first pnts) perm))]
+    (if (eq? pnt new)
+        pnts
+        (permutation-orbit/list pnt (cons new pnts) perm)))) 
+
+(define (permutation-collect-cycle pnt perm)
+  (define (collect acc)
+    (let [(next (permutations-apply (last acc) perm))]
+      (if (eq? next pnt)
+          acc
+          (collect (append acc (list next))))))
+  (collect (list pnt)))
+
+(define (permutation-cycles perm)
+  (let [(v (make-vector (permutation-degree perm) #f))]
+    (define (mark-cycle p k)
+      (let [(next (permutations-apply p perm))]
+        (unless (vector-ref v next)
+          (vector-set! v next k)
+          (mark-cycle next k))))
+    (define (loop k)
+      (let [(p (vector-member #f v))]
+        (when p
+          (mark-cycle p k)
+          (loop (add1 k)))))
+    (loop 0)
+    v))

test/permutations.rkt

@@ -0,0 +1,22 @@
+#lang racket
+
+(require math/cgt/permutations
+	 rackunit)
+
+(check-eq?
+ (permutation-degree (permutation #())) 0)
+(check-eq?
+ (permutation-degree (permutation #(0 1 2 3))) 4)
+(check-equal?
+ (let [(p (permutation #(2 0 1)))]
+   (permutation-* p (permutation-inverse p)))
+ (permutation-identity 3))
+
+(for [(i (in-range 100))]
+  (let [(degree (random 1024))]
+    (check-eq? degree
+               (set-count
+                (list->set
+                 (vector->list (permutation-image (permutation-random degree))))))))
+
+