Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
antik
gsll
Commits
d6a0d879
Commit
d6a0d879
authored
Jun 28, 2010
by
Liam Healy
Browse files
Port permutation to foreign-array
parent
827d6818
Changes
2
Hide whitespace changes
Inline
Side-by-side
data/permutation.lisp
View file @
d6a0d879
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2010-06-2
7 18:14:0
6EDT permutation.lisp>
;; Time-stamp: <2010-06-2
8 21:56:2
6EDT permutation.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -27,23 +27,20 @@
;;;; Permutation structure and CL object
;;;;****************************************************************************
(
defclass
permutation
(
mobject
grid:foreign-array
)
((
element-type
:initform
#+
int64
'
(
unsigned-byte
64
)
#+
int32
'
(
unsigned-byte
32
)
:reader
element-type
:allocation
:class
))
(
defclass
permutation
(
#+
int64
grid:vector-unsigned-byte-64
#+
int32
grid:vector-unsigned-byte-32
)
()
(
:documentation
"GSL permutations."
))
(
defmethod
initialize-instance
:after
((
object
permutation
)
&key
dimensions
&allow-other-keys
)
(
let
((
mptr
(
cffi:foreign-alloc
'gsl-permutation-c
)))
(
setf
(
slot-value
object
'mpointer
)
(
setf
(
metadata-slot
object
'mpointer
)
mptr
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'data
)
(
foreign-pointer
object
)
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'size
)
dimensions
)
(
first
dimensions
)
)
(
tg:finalize
object
(
lambda
()
(
cffi:foreign-free
mptr
)))))
(
export
'make-permutation
)
...
...
@@ -55,13 +52,21 @@
(
let
((
perm
(
make-instance
'permutation
:dimensions
(
if
(
typep
n
'permutation
)
(
dimensions
n
)
n
))))
:element-type
'
(
unsigned-byte
#+
int64
64
#+
int32
32
)
:dimensions
(
if
(
typep
n
'permutation
)
(
dimensions
n
)
(
list
n
)))))
;; It is necessary to change class because the initialize-instance
;; :after method for grid:foreign-array changes to the vector class.
(
change-class
perm
'permutation
)
(
when
initialize
(
if
(
typep
n
'permutation
)
(
copy
perm
n
)
(
error
"not available yet"
)
;
(copy perm n)
(
set-identity
perm
)))
perm
))
(
defmethod
print-object
((
object
permutation
)
stream
)
(
print-unreadable-object
(
object
stream
:type
t
)
(
princ
(
grid:contents
object
)
stream
)))
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************
...
...
@@ -77,6 +82,7 @@
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1)."
)
#|
(defmfun grid:copy-to-destination ((source permutation) (destination permutation))
"gsl_permutation_memcpy"
(((mpointer destination) :pointer)
...
...
@@ -89,6 +95,7 @@
:documentation ; FDL
"Copy the elements of the permutation source into the
permutation destination. The two permutations must have the same size.")
|#
(
defmfun
swap-elements
((
p
permutation
)
i
j
)
"gsl_permutation_swap"
...
...
@@ -152,7 +159,7 @@
:documentation
; FDL
"Reverse the order of the elements of the permutation p."
)
(
defmfun
permutation-inverse
(
inv
p
)
(
defmfun
permutation-inverse
(
p
&optional
(
inv
(
make-permutation
(
size
p
)))
)
"gsl_permutation_inverse"
(((
mpointer
inv
)
:pointer
)
((
mpointer
p
)
:pointer
))
:inputs
(
p
)
...
...
@@ -265,7 +272,7 @@
;;;; Permutations in cyclic form
;;;;****************************************************************************
(
defmfun
linear-to-canonical
(
q
p
)
(
defmfun
linear-to-canonical
(
p
&optional
(
q
(
make-permutation
(
size
p
)))
)
"gsl_permutation_linear_to_canonical"
(((
mpointer
q
)
:pointer
)
((
mpointer
p
)
:pointer
))
:inputs
(
p
)
...
...
@@ -274,7 +281,7 @@
"Compute the canonical form of the permutation p and
stores it in the output argument q."
)
(
defmfun
canonical-to-linear
(
p
q
)
(
defmfun
canonical-to-linear
(
q
&optional
(
p
(
make-permutation
(
size
q
)))
)
"gsl_permutation_canonical_to_linear"
(((
mpointer
p
)
:pointer
)
((
mpointer
q
)
:pointer
))
:inputs
(
q
)
...
...
@@ -317,25 +324,25 @@
"Generate all the permutations of n objects."
(
let
((
perm
(
make-permutation
n
)))
(
set-identity
perm
)
(
loop
collect
(
copy-seq
(
cl-array
perm
)
)
while
(
permutation-next
perm
))))
(
loop
collect
(
grid:contents
perm
)
while
(
nth-value
1
(
permutation-next
perm
))))
)
(
defun
generate-all-permutations-backwards
(
n
)
"Generate all the permutations of n objects."
(
let
((
perm
(
make-permutation
n
)))
(
set-identity
perm
)
(
permutation-reverse
perm
)
(
loop
collect
(
copy-seq
(
cl-array
perm
)
)
while
(
permutation-previous
perm
))))
(
loop
collect
(
grid:contents
perm
)
while
(
nth-value
1
(
permutation-previous
perm
))))
)
(
save-test
permutation
(
let
((
perm-1
(
make-permutation
4
t
)))
;maref
(
grid:gref
perm-1
2
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;
cl-array
(
cl-array
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;
grid:contents
(
grid:contents
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;permutation-reverse
(
set-identity
perm-1
)
(
cl-array
(
permutation-reverse
perm-1
)))
(
grid:contents
(
permutation-reverse
perm-1
)))
(
let
;permutation-next, permutation-inverse
((
perm-1
(
make-permutation
4
t
))
(
perm-2
(
make-permutation
4
t
)))
(
set-identity
perm-1
)
...
...
@@ -343,18 +350,18 @@
(
permutation-next
perm-1
)
(
permutation-next
perm-1
)
(
permutation-inverse
perm-2
perm-1
)
(
cl-array
perm-2
))
(
grid:contents
perm-2
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;swap-elements
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
(
cl-array
perm-1
))
(
grid:contents
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
))
;permute-vector
(
intvec
#
31m
(
11
22
33
44
)))
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
(
swap-elements
perm-1
0
2
)
(
permute
perm-1
intvec
)
(
cl-array
intvec
))
(
grid:contents
intvec
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;inversions
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
...
...
gsll.asd
View file @
d6a0d879
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2010-06-2
7
2
2
:1
5:09
EDT gsll.asd>
;; Time-stamp: <2010-06-2
8
2
1
:1
8:11
EDT gsll.asd>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -80,7 +80,7 @@
(
:file
"both"
:depends-on
(
"foreign-array"
"vector"
"matrix"
))
;(:file "copy-cl")
(
:file
"array-tests"
:depends-on
(
"both"
))
;
(:file "permutation" :depends-on ("foreign-array" "array-structs"))
(
:file
"permutation"
:depends-on
(
"foreign-array"
"array-structs"
))
;(:file "combination" :depends-on ("foreign-array" "array-structs"))
))
#+
(
or
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment