I'm working on some functions that take a matrix as input and provide a matrix as output. Is it possible to use the magrittr pipe with matrices without using the . placeholder? Ideally, I'd like these functions to be piped into each other like a dplyr chain. The issue is that I'm constantly forgetting to specify the . placeholder and getting errors.
library(magrittr)
set.seed(123)
m <- matrix(rnorm(10), ncol = 2)
# This works perfectly:
layout_align_x <- function(n = nodes, anchor, m = matrix){
m[n, 1] <- m[anchor, 1]
return(m)}
# This also works perfectly:
layout_align_x(c(1,2), 3, m)
# And this also:
m %>% layout_align_x(c(1,2), 3, .)
# This returns error:
m %>% layout_align_x(c(1,2), 3)
#Error in m[anchor, 1] : incorrect number of dimensions
# The goal is:
m %>%
layout_align_x(c(1,2), 3) %>%
layout_align_x(c(3,4), 5)
Change your function to
layout_align_x <- function(m = matrix, n = nodes, anchor){
m[n, 1] <- m[anchor, 1]
return(m)
}
Related
I have a dataframe that has two columns, x and y (both populated with numbers). I am trying to look at a moving window within the data, and I've done it like this (source):
# Extract just x and y from the original data frame
df <- dat_fin %>% select(x, y)
# Moving window creation
nr <- nrow(df)
windowSize <- 10
windfs <- lapply(seq_len(nr - windowSize + 1), function(i) df[i:(i + windowSize - 1), ])
This lapply creates a list of tibbles that are each 10 (x, y) pairs. At this point, I am trying to compute a single quantity using each of the sets of 10 pairs; my current (not working) code looks like this:
library(shotGroups)
for (f in 1:length(windfs)) {
tsceps[f] = getCEP(windfs[f], accuracy = TRUE)
}
When I run this, I get the error:
Error in getCEP.default(windfs, accuracy = TRUE) : xy must be numeric
My goal is that the variable that I've called tsceps should be a 1 x length(windfs) data frame, each value in which comes from the getCEP calculation for each of the windowed subsets.
I've tried various things with unnest and unlist, all of which were unsuccessful.
What am I missing?
Working code:
df <- dat_fin %>% select(x, y)
nr <- nrow(df)
windowSize <- 10
windfs <- lapply(seq_len(nr - windowSize + 1), function(i) df[i:(i + windowSize - 1), ])
tsceps <- vector(mode = "numeric", length = length(windfs))
library(shotGroups)
for (j in 1:length(windfs)) {
tsceps[j] <- getCEP(windfs[[j]], type = "CorrNormal", CEPlevel = 0.50, accuracy = TRUE)
}
ults <- unlist(tsceps)
ults_cep <- vector(mode = "numeric", length = length(ults))
for (k in 1:length(ults)) {
ults_cep[k] <- ults[[k]]
}
To get this working with multiple type arguments to getCEP, just use additional code blocks for each type required.
I am using the Ryacas package in R and am trying to substitute variables for values but not simplify or solve the equation to show the working out. I have searched Stackoverflow, read the Ryacas documentation and have attempted to find this in the Yacas manual but have so far come up short. I think I am looking to turn simplification off to get the substituted equation and then on again to provide the final result.
Here is an example which provides only the result rather than the working:
library(Ryacas)
# a <- 2
# b <- 3
# c <- 4
eq <- ysym(('(a * b) / c'))
solution <- with_value(with_value(with_value(eq, 'a', 2), 'b', 3), 'c', 4)
tex(solution)
# "\\frac{3}{2}"
What I am trying to get as an output is:
# working out
# "\\frac{2 \times 3}{4}
as well as the actual solution:
# solution
# "\\frac{3}{2}"
Does anyone know whether there is a solution to this problem such as passing a command to yacas through yac_str or similar. I have tried translating to latex using the tex() command and then substituting after though the multiplication operators are removed and this means I need to find and replace them which becomes nasty when dealing with symbolics:
tex(eq)
# "\\frac{a b}{c}"
# substituting string values using stringi requires additional
# work to deal with the missing `*` between `a` and `b`
# "\\frac{2 3}{4}"
Whilst this can be done for simple expressions, there are numerous exceptions such as the variables a and c being present in \\frac etc.
I have also tried the TexForm command and substitute in various guises but am still not able to capture the unsimplified and unevaluated equation:
y_fn(substitute(with_value(eq, 'a', 2)), "TeXForm")
# "\\frac{2 b}{c}"
eval(substitute(with_value(eval(substitute(with_value(eq, 'a', 2))), 'b', 3)))
# y: 6/c
Any help appreciated.
You might need to customize this some more but this general approach can work if you are willing to do that.
We translate words to their values using gsubfn and handle the \times part at the end with gsub. Note that frac is not modified because we are matching words and frac it is not a word in the list given in the second arg to gsubfn.
library(magrittr)
library(gsubfn)
library(Ryacas)
eq <- ysym(('(a * b) / c'))
eq %>%
tex %>%
gsubfn("(\\w+)", list(a = 2, b = 3, c = 4), .) %>%
gsub("(\\d) (\\d)", "\\1 \\\\times \\2", .)
## [1] "\\frac{2 \\times 3}{4}"
Added
Take the first three code examples when searching for [r] Ryacas in stackoverflow and it worked on all of them. Note that these used the original version of Ryacas which is currently called Ryacas0 so I used that.
library(Ryacas0)
library(gsubfn)
library(magrittr)
tex_sub <- function(.x, ...) {
.x %>%
gsubfn("(\\w+)", list(...), .) %>%
gsub("(\\d) (\\d)", "\\1 \\\\times \\2", .)
}
# https://stackoverflow.com/questions/21858668/symbolic-matrix-multiplication-by-ryacas
x <- Sym("x")
mat1 <- List(
List(x, 2),
List(x^3, x))
mat2 <- List(
List(x, x),
List(3, 6 * x))
tt <- TeXForm(mat1 * mat2)
tex_sub(tt, x = 1)
###
# https://stackoverflow.com/questions/22739173/matrix-transpose-in-ryacas
u=Sym("u")
v=Sym("v")
w=Sym("w")
DG=List(List(w-v), List(u-w), List(v-u))
tt2 <- TeXForm(DG)
tex_sub(tt2, u = 2, v = 3, w = 4)
###
# https://stackoverflow.com/questions/49572184/how-to-derivate-using-ryacas
x <- Sym("x")
P <- Sym(1)
for (k in 1:3) {
P <- Simplify((1+k*x)*P + x*(1-x)*deriv(P, x))
print(P)
}
tt3 <- TeXForm(P)
tex_sub(tt3, x = 10)
I need help with a question closely related to some other question of mine.
How to merge two different groupings if they are not disjoint with dplyr
As the title of the question says, I want to generate an index in a vector that links different vectors in a list if they have an intersection or, if not, if both intersect with some other vector in a list, and so on...
This is a question involving graph theory/networks - I want to find indirectly connected vectors.
The question above solved my problem considering two columns a dataframe, but I don't know how to generalize this to a list in which elements my have different lengths.
This is an example: list(1:3, 3:5, 5, 6) should give me c(1, 1, 1, 2)
EDIT:
I've tried using the fact that the powers of an adjacency matrix represent possible paths from one edge to some other one.
find_connections <- function(list_vectors){
list_vectors <- list_vectors %>%
set_names(paste0("x", 1:length(list_vectors)))
x <- crossprod(table(stack(list_vectors)))
power <- nrow(x) - 2
x <- ifelse(x >= 1, 1, 0)
if(power > 0){
z <- accumulate(replicate(power, x, simplify = FALSE),
`%*%`, .init = x) %>%
reduce(`+`)
} else{
z <- x
}
z <- ifelse(z >= 1, 1, 0)
w <- z %>%
as.data.frame() %>%
group_by(across()) %>%
group_indices()
return(w)
}
The problem is that it took too long to run my code. Each matrix is not very large, but I do need to run the function on a large number of them.
Is it possible to improve this?
This is one way to do it. It creates a loop for the elements in each vector and then uses the same trick as the previous answer to find clusters.
library(data.table)
library(igraph)
x <- list(1:3, 3:5, 5, 6)
dt <- rbindlist(lapply(x,
function(r) data.table(from = r, to = shift(r, -1, fill = r[1]))))
dg <- graph_from_data_frame(dt, directed = FALSE)
unname(sapply(x, function(v) components(dg)$membership[as.character(v[1])]))
#> [1] 1 1 1 2
Here is the formula which I am trying to calculate in R.
So far, this is my approach using a simplified example
t <- seq(1, 2, 0.1)
expk <- function(k){exp(-2*pi*1i*t*k)}
set.seed(123)
dat <- ts(rnorm(100), start = c(1994,3), frequency = 12)
arfit <- ar(dat, order = 4, aic = FALSE) # represent \phi in the formula
tmp1 <- numeric(4)
for (i in seq_along(arfit$ar)){
ek <- expk(i)
arphi <- arfit$ar[i]
tmp1[i] <- ek * arphi
}
tmp2 <- sum(tmp1)
denom = abs(1-tmp2)^2
s2 <- t/denom
Error : Warning message:
In tmp1[i] <- ek * arphi :
number of items to replace is not a multiple of replacement length
I was trying to avoid using for loop and tried using sapply as in solutions to this question.
denom2 <- abs(1- sapply(seq_along(arfit$ar), function(x)sum(arfit$ar[x]*expf(x))))^2
but doesnt seem to be correct. The problem is to do the sum of the series(over index k) when it is taking values from another vector as well, in this case, t which is in the numerator.
Any solutions ?
Any suggestion for a test dataset, maybe using 0 and 1 to check if the calculation is done correctly in this loop here ?
Typing up the answer determined in chat. Here's a solution involving vapply.
First correct expk to:
expk <- function(k){sum(exp(-2*pi*1i*t*k))}
Then you can create this function and vapply it:
myFun <- function(i) return(expk(i) * arfit$ar[i])
tmp2 <- sum(vapply(seq_along(arfit$ar), myFun, complex(1)))
I have a data.frame in R with 40 series and I want to select pairwise series to apply a function, (ie serie 1 and serie 21, serie 2 and serie 22) . However I'm getting error with the following code:
for(i in 1:ncol(Date)) {
pairwise <-Date[, c(i,i+20)]
}
I want to use pairwise in other function.
Could someone please help me?
Thank in advance
It is because you are requesting columns higher than 40 when i > 20. See this example:
set.seed(1)
DF <- data.frame(matrix(rnorm(40*100), ncol = 40))
## simple function to apply/use
foo <- function(x1, x2) return(x1 - x2)
## something to hold results
res <- matrix(ncol = ncol(DF), nrow = nrow(DF))
## loop - oops error
for(i in seq_len(ncol(DF))) {
res[,i] <- foo(DF[,i], DF[,i+20])
}
You get this error:
Error in `[.data.frame`(DF, , i + 20) : undefined columns selected
That is because i takes values 1, ..., 40. As soon as i >= 21, (i + 20) > 40 and you only have 40 columns of data. A simple modification is to loop only over the first 20 columns:
## something to hold results
res <- matrix(ncol = ncol(DF) / 2, nrow = nrow(DF))
for(i in seq_len(ncol(DF)/2)) {
res[,i] <- foo(DF[,i], DF[,i+20])
}
if all you want is col 1 and col 21, col 2 and col 22 etc. If you want all pairwise comparisons then you need to try something different, as a single loop won't work.
(Before someone pulls me up for woefully inefficient use of a loop, that example was just that, an example with no imagination applied to the function foo(). In this case, DF[, 1:20] - DF[, 21:40] will give the same result as in res.)