Question

I have this function in R from a previous question here

shift <- function(d, k) rbind( tail(d,k), head(d,-k), deparse.level = 0 )

this function will rotate the data frame d by K, that’s mean it will take K rows from the end of the data frame and place them on the top.

I want to create the same function(in the same language) but without using R pre-made functions(head, tail,…), but only using basics of programming.(for , …)

How this can be done?

Answer 1

Well I don’t know what you mean with without using R functions since pretty much everything is an R function, but here is a solution using only the very generic nrow() (Number of rows of a matrix), %% (modulus) and seq_len (equivalent to 1:length(x) except that it works better):

m <- matrix(1:40,,2,byrow=TRUE)

shift2 <- function(d, k) d[(seq_len(nrow(d))-k-1)%%(nrow(d))+1,]

shift2(m,5)


      [,1] [,2]
 [1,]   31   32
 [2,]   33   34
 [3,]   35   36
 [4,]   37   38
 [5,]   39   40
 [6,]    1    2
 [7,]    3    4
 [8,]    5    6
 [9,]    7    8
[10,]    9   10
[11,]   11   12
[12,]   13   14
[13,]   15   16
[14,]   17   18
[15,]   19   20
[16,]   21   22
[17,]   23   24
[18,]   25   26
[19,]   27   28
[20,]   29   30

If you mean with “normal programming code” that it shouldn’t be vectorized then, well, you are learning either the wrong language in the right way or the right language in the wrong way. Everytime you come up with a vectorized solution instead of for loops you are happy in R.

But if you really really want to do this with loops here is exactly the same function unvectorized:

shift3 <- function(d, k) 
{
  out <- matrix(,nrow(d),ncol(d))
  sorts <- (seq_len(nrow(d))-k-1)%%(nrow(d))+1
  for (i in seq_len(nrow(d))) out[i,] <- d[sorts[i],]
  return(out)
}

Proof they are all equal:

all(shift(m,5) == shift2(m,5) & shift2(m,5) == shift3(m,5))
[1] TRUE

EDIT:

Actually shift3() there STILL contained a lot of vectorizations, showing just how native that is in R. Here is a fully unvectorized version:

shift3 <- function(d, k) 
{
  out <- matrix(,nrow(d),ncol(d))
  sor <- numeric(1)
  for (i in seq_len(nrow(d))) 
  {
    if (i-k < 1) sor <- nrow(d)-k+i else sor <- i-k
    for (j in seq_len(ncol(d))) out[i,j] <- d[sor,j]
  }
  return(out)
}