Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
G
gsll
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Container Registry
Model registry
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Antonio Juan
gsll
Commits
d6a0d879
Commit
d6a0d879
authored
14 years ago
by
Liam Healy
Browse files
Options
Downloads
Patches
Plain Diff
Port permutation to foreign-array
parent
827d6818
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
data/permutation.lisp
+31
-24
31 additions, 24 deletions
data/permutation.lisp
gsll.asd
+2
-2
2 additions, 2 deletions
gsll.asd
with
33 additions
and
26 deletions
data/permutation.lisp
+
31
−
24
View file @
d6a0d879
;; Permutations
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; 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
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;; Distributed under the terms of the GNU General Public License
...
@@ -27,23 +27,20 @@
...
@@ -27,23 +27,20 @@
;;;; Permutation structure and CL object
;;;; Permutation structure and CL object
;;;;****************************************************************************
;;;;****************************************************************************
(
defclass
permutation
(
mobject
grid:foreign-array
)
(
defclass
permutation
((
element-type
(
#+
int64
grid:vector-unsigned-byte-64
#+
int32
grid:vector-unsigned-byte-32
)
:initform
()
#+
int64
'
(
unsigned-byte
64
)
#+
int32
'
(
unsigned-byte
32
)
:reader
element-type
:allocation
:class
))
(
:documentation
"GSL permutations."
))
(
:documentation
"GSL permutations."
))
(
defmethod
initialize-instance
:after
(
defmethod
initialize-instance
:after
((
object
permutation
)
&key
dimensions
&allow-other-keys
)
((
object
permutation
)
&key
dimensions
&allow-other-keys
)
(
let
((
mptr
(
cffi:foreign-alloc
'gsl-permutation-c
)))
(
let
((
mptr
(
cffi:foreign-alloc
'gsl-permutation-c
)))
(
setf
(
slot-value
object
'mpointer
)
(
setf
(
metadata-slot
object
'mpointer
)
mptr
mptr
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'data
)
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'data
)
(
foreign-pointer
object
)
(
foreign-pointer
object
)
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'size
)
(
cffi:foreign-slot-value
mptr
'gsl-permutation-c
'size
)
dimensions
)
(
first
dimensions
)
)
(
tg:finalize
object
(
lambda
()
(
cffi:foreign-free
mptr
)))))
(
tg:finalize
object
(
lambda
()
(
cffi:foreign-free
mptr
)))))
(
export
'make-permutation
)
(
export
'make-permutation
)
...
@@ -55,13 +52,21 @@
...
@@ -55,13 +52,21 @@
(
let
((
perm
(
let
((
perm
(
make-instance
(
make-instance
'permutation
'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
(
when
initialize
(
if
(
typep
n
'permutation
)
(
if
(
typep
n
'permutation
)
(
copy
perm
n
)
(
error
"not available yet"
)
;
(copy perm n)
(
set-identity
perm
)))
(
set-identity
perm
)))
perm
))
perm
))
(
defmethod
print-object
((
object
permutation
)
stream
)
(
print-unreadable-object
(
object
stream
:type
t
)
(
princ
(
grid:contents
object
)
stream
)))
;;;;****************************************************************************
;;;;****************************************************************************
;;;; Setting values
;;;; Setting values
;;;;****************************************************************************
;;;;****************************************************************************
...
@@ -77,6 +82,7 @@
...
@@ -77,6 +82,7 @@
"Initialize the permutation p to the identity, i.e.
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1)."
)
(0,1,2,...,n-1)."
)
#|
(defmfun grid:copy-to-destination ((source permutation) (destination permutation))
(defmfun grid:copy-to-destination ((source permutation) (destination permutation))
"gsl_permutation_memcpy"
"gsl_permutation_memcpy"
(((mpointer destination) :pointer)
(((mpointer destination) :pointer)
...
@@ -89,6 +95,7 @@
...
@@ -89,6 +95,7 @@
:documentation ; FDL
:documentation ; FDL
"Copy the elements of the permutation source into the
"Copy the elements of the permutation source into the
permutation destination. The two permutations must have the same size.")
permutation destination. The two permutations must have the same size.")
|#
(
defmfun
swap-elements
((
p
permutation
)
i
j
)
(
defmfun
swap-elements
((
p
permutation
)
i
j
)
"gsl_permutation_swap"
"gsl_permutation_swap"
...
@@ -152,7 +159,7 @@
...
@@ -152,7 +159,7 @@
:documentation
; FDL
:documentation
; FDL
"Reverse the order of the elements of the permutation p."
)
"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"
"gsl_permutation_inverse"
(((
mpointer
inv
)
:pointer
)
((
mpointer
p
)
:pointer
))
(((
mpointer
inv
)
:pointer
)
((
mpointer
p
)
:pointer
))
:inputs
(
p
)
:inputs
(
p
)
...
@@ -265,7 +272,7 @@
...
@@ -265,7 +272,7 @@
;;;; Permutations in cyclic form
;;;; 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"
"gsl_permutation_linear_to_canonical"
(((
mpointer
q
)
:pointer
)
((
mpointer
p
)
:pointer
))
(((
mpointer
q
)
:pointer
)
((
mpointer
p
)
:pointer
))
:inputs
(
p
)
:inputs
(
p
)
...
@@ -274,7 +281,7 @@
...
@@ -274,7 +281,7 @@
"Compute the canonical form of the permutation p and
"Compute the canonical form of the permutation p and
stores it in the output argument q."
)
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"
"gsl_permutation_canonical_to_linear"
(((
mpointer
p
)
:pointer
)
((
mpointer
q
)
:pointer
))
(((
mpointer
p
)
:pointer
)
((
mpointer
q
)
:pointer
))
:inputs
(
q
)
:inputs
(
q
)
...
@@ -317,25 +324,25 @@
...
@@ -317,25 +324,25 @@
"Generate all the permutations of n objects."
"Generate all the permutations of n objects."
(
let
((
perm
(
make-permutation
n
)))
(
let
((
perm
(
make-permutation
n
)))
(
set-identity
perm
)
(
set-identity
perm
)
(
loop
collect
(
copy-seq
(
cl-array
perm
)
)
(
loop
collect
(
grid:contents
perm
)
while
(
permutation-next
perm
))))
while
(
nth-value
1
(
permutation-next
perm
))))
)
(
defun
generate-all-permutations-backwards
(
n
)
(
defun
generate-all-permutations-backwards
(
n
)
"Generate all the permutations of n objects."
"Generate all the permutations of n objects."
(
let
((
perm
(
make-permutation
n
)))
(
let
((
perm
(
make-permutation
n
)))
(
set-identity
perm
)
(
set-identity
perm
)
(
permutation-reverse
perm
)
(
permutation-reverse
perm
)
(
loop
collect
(
copy-seq
(
cl-array
perm
)
)
(
loop
collect
(
grid:contents
perm
)
while
(
permutation-previous
perm
))))
while
(
nth-value
1
(
permutation-previous
perm
))))
)
(
save-test
permutation
(
save-test
permutation
(
let
((
perm-1
(
make-permutation
4
t
)))
;maref
(
let
((
perm-1
(
make-permutation
4
t
)))
;maref
(
grid:gref
perm-1
2
))
(
grid:gref
perm-1
2
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;
cl-array
(
let
((
perm-1
(
make-permutation
4
t
)))
;
grid:contents
(
cl-array
perm-1
))
(
grid:contents
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;permutation-reverse
(
let
((
perm-1
(
make-permutation
4
t
)))
;permutation-reverse
(
set-identity
perm-1
)
(
set-identity
perm-1
)
(
cl-array
(
permutation-reverse
perm-1
)))
(
grid:contents
(
permutation-reverse
perm-1
)))
(
let
;permutation-next, permutation-inverse
(
let
;permutation-next, permutation-inverse
((
perm-1
(
make-permutation
4
t
))
(
perm-2
(
make-permutation
4
t
)))
((
perm-1
(
make-permutation
4
t
))
(
perm-2
(
make-permutation
4
t
)))
(
set-identity
perm-1
)
(
set-identity
perm-1
)
...
@@ -343,18 +350,18 @@
...
@@ -343,18 +350,18 @@
(
permutation-next
perm-1
)
(
permutation-next
perm-1
)
(
permutation-next
perm-1
)
(
permutation-next
perm-1
)
(
permutation-inverse
perm-2
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
(
let
((
perm-1
(
make-permutation
4
t
)))
;swap-elements
(
set-identity
perm-1
)
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
(
swap-elements
perm-1
1
3
)
(
cl-array
perm-1
))
(
grid:contents
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
))
;permute-vector
(
let
((
perm-1
(
make-permutation
4
t
))
;permute-vector
(
intvec
#
31m
(
11
22
33
44
)))
(
intvec
#
31m
(
11
22
33
44
)))
(
set-identity
perm-1
)
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
(
swap-elements
perm-1
1
3
)
(
swap-elements
perm-1
0
2
)
(
swap-elements
perm-1
0
2
)
(
permute
perm-1
intvec
)
(
permute
perm-1
intvec
)
(
cl-array
intvec
))
(
grid:contents
intvec
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;inversions
(
let
((
perm-1
(
make-permutation
4
t
)))
;inversions
(
set-identity
perm-1
)
(
set-identity
perm-1
)
(
swap-elements
perm-1
1
3
)
(
swap-elements
perm-1
1
3
)
...
...
This diff is collapsed.
Click to expand it.
gsll.asd
+
2
−
2
View file @
d6a0d879
;; Definition of GSLL system
;; Definition of GSLL system
;; Liam Healy
;; 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
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;; Distributed under the terms of the GNU General Public License
...
@@ -80,7 +80,7 @@
...
@@ -80,7 +80,7 @@
(
:file
"both"
:depends-on
(
"foreign-array"
"vector"
"matrix"
))
(
:file
"both"
:depends-on
(
"foreign-array"
"vector"
"matrix"
))
;(:file "copy-cl")
;(:file "copy-cl")
(
:file
"array-tests"
:depends-on
(
"both"
))
(
: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"))
;(:file "combination" :depends-on ("foreign-array" "array-structs"))
))
))
#+
(
or
)
#+
(
or
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment