Hi Piotr,

On 03/31/2017 11:16 AM, Piotr Koller wrote:
Hi, I'd like to create a function that will sort values of a vector on a
given basis:

-zeros

-ones

-numbers divisible by 2

-numbers divisible by 3 (but not by 2)

-numbers divisible by 5 (but not by 2 and 3)

In other words, you want to sort your values by smallest divisor
(not regarding 1 as a divisor). The sorting part is easy if you can
map each value to its smaller divisor (mapping 0 to 0 and 1 to 1):

1) Map the values in 'x' to their smallest divisor:

  x <- as.integer(x)
  smallest_divisor <- sapply(x, smallestDivisor)
  smallest_divisor[x == 0L] <- 0L
  smallest_divisor[x == 1L] <- 1L

2) Then sort 'x' based on the values in 'smallest_divisor':

  x[order(smallest_divisor)]

So the real difficulty here is not the sorting, it's to find the
smallest divisor. Here is a function that does this:

  smallestDivisor <- function(x)
  {
    if (!is.integer(x) || length(x) != 1L || is.na(x))
        stop("'x' must be a single integer")

    ## All prime numbers <= 2*3*5*7 = ND
    pm210 <- as.integer(c(2, 3, 5, 7, 11, 13, 17, 19,
                          23, 29, 31, 37, 41, 43, 47,
                          53, 59, 61, 67, 71, 73, 79,
                          83, 89, 97, 101, 103, 107, 109,
                          113, 127, 131, 137, 139, 149,
                          151, 157, 163, 167, 173, 179,
                          181, 191, 193, 197, 199))
    ans <- which(x %% pm210 == 0L)[1L]
    if (!is.na(ans))
        return(pm210[ans])

    ## Use Sieve of Eratosthenes to prepare the divisors that
    ## are > ND and <= 2*ND.
    pm0 <- c(3L, 5L, 7L)  # must start with 3, not 2
    prod0 <- as.integer(cumprod(pm0)[length(pm0)])
    ND <- 2L * prod0
    div <- 1L + 2L*(0L:(prod0-1L))
    for (p in pm0)
        div <- setdiff(div, p*(1L:(ND%/%p-1L)))
    div <- div + ND
    sqrtx <- sqrt(x)
    while (div[1L] <= sqrtx) {
        ans <- which(x %% div == 0L)[1L]
        if (!is.na(ans))
            return(div[ans])
        div <- div + ND
    }
    x
  }

I'm sure there are faster ways to do this.

Cheers,
H.



etc.

I also want to omit zeros in those turns. So when I have a given vector of
c(0:10), I want to receive 0 1 2 4 6 8 10 3 9 5 7 I think it'd be the best
to use some variation of bubble sort, so it'd look like that

sort <- function(x) {
 for (j in (length(x)-1):1) {
   for (i in j:(length(x)-1)) {
     if (x[i+1]%%divisor==0 && x[i]%%divisor!=0) {
      temp <- x[i]
      x[i] <- x[i+1]
      x[i+1] <- temp
      }
    }
  }
 return(x)}

This function works out well on a given divisor and incresing sequences.

sort <- function(x) {
  for (j in (length(x)-1):1) {
     for (i in j:(length(x)-1)) {
       if (x[i+1]%%5==0 && x[i]%%5!=0) {
        temp <- x[i]
        x[i] <- x[i+1]
        x[i+1] <- temp
       }
      }
     }
  return(x)
 }

x <- c(1:10)
print(x)
print(bubblesort(x))

This function does its job. It moves values divisible by 5 on the
beginning. The question is how to increase divisor every "round" ?

Thanks for any kind of help

        [[alternative HTML version deleted]]

______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://urldefense.proofpoint.com/v2/url?u=https-3A__stat.ethz.ch_mailman_listinfo_r-2Dhelp&d=DwICAg&c=eRAMFD45gAfqt84VtBcfhQ&r=BK7q3XeAvimeWdGbWY_wJYbW0WYiZvSXAJJKaaPhzWA&m=AeHAcF7RnhWvQIqG5c2ucgFS0WIOmMFeRheLIeSwu0U&s=xJMmDOJLaQZ0QMmI7rkkNd2T5-zrh843rlJ-R1LQ9G8&e=
PLEASE do read the posting guide 
https://urldefense.proofpoint.com/v2/url?u=http-3A__www.R-2Dproject.org_posting-2Dguide.html&d=DwICAg&c=eRAMFD45gAfqt84VtBcfhQ&r=BK7q3XeAvimeWdGbWY_wJYbW0WYiZvSXAJJKaaPhzWA&m=AeHAcF7RnhWvQIqG5c2ucgFS0WIOmMFeRheLIeSwu0U&s=c9IcZitWvur2grg8C54Jnt5LmajX0ODDANY-BGRzMbk&e=
and provide commented, minimal, self-contained, reproducible code.


--
Hervé Pagès

Program in Computational Biology
Division of Public Health Sciences
Fred Hutchinson Cancer Research Center
1100 Fairview Ave. N, M1-B514
P.O. Box 19024
Seattle, WA 98109-1024

E-mail: hpa...@fredhutch.org
Phone:  (206) 667-5791
Fax:    (206) 667-1319

______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

Reply via email to