https://github.com/cran/clifford
Tip revision: b9c5906e0220582174d0c19b7d8c7533235aac08 authored by Robin K. S. Hankin on 13 August 2022, 21:00:03 UTC
version 1.0-8
version 1.0-8
Tip revision: b9c5906
extract.R
list_modifier <- function(B){
lapply(B,
function(x){
if(identical(round(x),0)){
return(numeric(0))
} else {
return(x)
}
} )
}
`[.clifford` <- function(C, index, ...){
if(is.clifford(index)){
stop("cannot extract a clifford; try A[terms(B)]")
} else if(is.disord(index)){
if(is.list(index)){
dots <- elements(index)
} else {
return(clifford(elements(terms(C)[index]),elements(coeffs(C)[index])))
}
} else if(is.list(index)){
dots <- index
} else {
dots <- c(list(index),list(...))
}
clifford(list_modifier(dots),getcoeffs(C,list_modifier(dots)))
}
`[<-.clifford` <- function(C, index, ..., value){
if(missing(index)){ # C[] <- value
dots <- list_modifier(list(...))
if(is.clifford(value)){
return(as.clifford(c_overwrite(
terms(C),coeffs(C),
terms(value),coeffs(value),
maxyterm(C,value)
)))
} else { # value a scalar
stopifnot(length(value) == 1)
return(clifford(terms(C),value + numeric(length(coeffs(C)))))
}
} else { # index supplied, dots interpreted as more terms
dots <- list_modifier(c(list(index),list(...)))
if(value==0){
jj <- clifford(dots,1)
return(as.clifford(c_overwrite(
terms(C),coeffs(C),
terms(jj),coeffs(jj),
maxyterm(C,jj)
))-jj)
} else { # value != 0
jj <- clifford(dots,value) # sic; this is legit!
return(as.clifford(c_overwrite(
terms(C),coeffs(C),
terms(jj),coeffs(jj),
maxyterm(C,jj)
)))
}
}
}