Share your functions & code

[Dason]

Maybe define it as a method for lm objects?

segments.lm <- function(coef, xlim, ...) {
  a <- coef[1]
  b <- coef[2]
  x0 <- xlim[1]
  x1 <- xlim[2]
  y0 <- a + b*x0
  y1 <- a + b*x1
  segments(x0 = x0, y0 = y0, x1 = x1, y1 = y1, ...)
}

You would probably want to do this then?

segments.lm <- function(lm, xlim, ...) {
  a <- coef(lm)[1]
  b <- coef(lm)[2]
  x0 <- xlim[1]
  x1 <- xlim[2]
  y0 <- a + b*x0
  y1 <- a + b*x1
  segments(x0 = x0, y0 = y0, x1 = x1, y1 = y1, ...)
}

The way yours works you need coef to be an lm object but if that's true then you can't just subset like you're doing. But using ... is probably the better idea.

 

[Lazar]

Cheers everyone!!

 

[Lazar]

EDIT: Clean code thanks to Dason.

Ok so in preparing my script to post on CFA by hand I got distracted and developed a SEM data simulation function inspired by this. I think my one is better because it is much more flexible in that in can generate data to 1 to N latent factors and does not require you to type out a whole bunch of zeros. Also my error approximations are probably better. I would be greatful if people who do SEM could try it out and others feel free to comment on how to improve the code:

SEMsim<- function(N.Obs, fa, load, l.pattern, fcov = 1){
    ## N.Obs    : is the number of observations wanted for simulation
    ## fa       : number of factors
    ## load     : vector of factor loadings 
    ## l.pattern: pattern indicating how the factor loadings load
    ## onto     : the simulated factors
    ## fcov     : factor covariances (variances set to 1)
    ##            entered in column major order

    ## Needed for simulating multivariate normal data
    require(MASS)
    ## Needed for forceSymmetric. upper.tri is unstable
    require(Matrix) 
    ## Number of items to be simulated
    it <- length(load) 

    l <- matrix(0, it, fa)

    ## Create a loading matrix. Cross loadings constrained to zero.
    for (i in 1:fa){
        l[l.pattern[[i]], i] <- load[l.pattern[[i]]]
    }

    psi <- matrix(1, fa, fa)
    ## Use expand grid to get needed covariances
    ref <- expand.grid(1:fa, 1:fa)
    ## Picks refernce to be filled in lower tri            
    ref <- ref[ref[,1] > ref[,2], 1:2]

    for (i in 1:nrow(ref)){
        ## Is filled in column major order
        psi[ref[i,1], ref[i,2]] <- fcov[i]
    }

    ## More effective than upper.tri function
    psi <- forceSymmetric(psi, 'L')
    ## Gives decent approximation of item residuals
    e <- 1 - diag(l %*% t(l))^2
    ## Simulates population covariance matrix
    sigma <- l %*% psi %*% t(l) + diag(e)
    ## Simulates random data based on population covariance matrix.
    ## Variances set to 1. Means set to zero.
    simData<- as.data.frame(mvrnorm(N.Obs, rep(0,it), sigma))
    colnames(simData)<- paste('Var', 1:it, sep='')

    out <- list(items = it,
                sigma = sigma,
                loadingMatrix = l,
                latentCovar = psi, 
                resMatrix = e,
                data = simData)

    return(out)
}

So far I have tried the following examples which all work well in MPlus:

#Demonstrations for 5 to 1 factor.
simData5<-SEMsim(N.Obs=1000, fa=5,
                 load=c(.8,.7,.6,.7,.6,.5,.7,.8,.6,.76,.82,.72,.66,.68,.92, .87), 
                 l.pattern=list(1:3, 4:6, 7:9, 10:12, 13:16),
                 fcov=c(.25, .5, .11, .3, .22, .05, .45, .54, .32, .23))
simData4<-SEMsim(N.Obs=1000, fa=4,
       load=c(.8,.7,.6,.7,.6,.5,.7,.8,.6,.76,.82,.72), 
       l.pattern=list(1:3, 4:6, 7:9, 10:12), fcov=c(.25, .5, .11, .3, .22, .05))
simData3<-SEMsim(N.Obs=1000, fa=3,
                 load=c(.8,.7,.6,.7,.6,.5,.7,.8,.6), 
                 l.pattern=list(1:3, 4:6, 7:9), fcov=c(.25, .5, .11))
simData2<-SEMsim(N.Obs=1000, fa=2,
                 load=c(.8,.7,.6,.7,.6,.5), 
                 l.pattern=list(1:3, 4:6), fcov=c(.25))
simData1<-SEMsim(N.Obs=1000, fa=1,
                 load=c(.8,.7,.6), 
                 l.pattern=list(1:3))

 

[Dason]

I cleaned up your code a little bit. I hope you don't mind!

SEMsim<- function(N.Obs, fa, load, l.pattern, fcov = 1){
    ## N.Obs    : is the number of observations wanted for simulation
    ## fa       : number of factors
    ## load     : vector of factor loadings 
    ## l.pattern: pattern indicating how the factor loadings load
    ## onto     : the simulated factors
    ## fcov     : factor covariances (variances set to 1)
    ##            entered in column major order

    ## Needed for simulating multivariate normal data
    require(MASS)
    ## Needed for forceSymmetric. upper.tri is unstable
    require(Matrix) 
    ## Number of items to be simulated
    it <- length(load) 

    l <- matrix(0, it, fa)

    ## Create a loading matrix. Cross loadings constrained to zero.
    for (i in 1:fa){
        l[l.pattern[[i]], i] <- load[l.pattern[[i]]]
    }

    psi <- matrix(1, fa, fa)
    ## Use expand grid to get needed covariances
    ref <- expand.grid(1:fa, 1:fa)
    ## Picks refernce to be filled in lower tri            
    ref <- ref[ref[,1] > ref[,2], 1:2]

    for (i in 1:nrow(ref)){
        ## Is filled in column major order
        psi[ref[i,1], ref[i,2]] <- fcov[i]
    }

    ## More effective than upper.tri function
    psi <- forceSymmetric(psi, 'L')
    ## Gives decent approximation of item residuals
    e <- 1 - diag(l %*% t(l))^2
    ## Simulates population covariance matrix
    sigma <- l %*% psi %*% t(l) + diag(e)
    ## Simulates random data based on population covariance matrix.
    ## Variances set to 1. Means set to zero.
    simData<- as.data.frame(mvrnorm(N.Obs, rep(0,it), sigma))
    colnames(simData)<- paste('Var', 1:it, sep='')

    out <- list(items = it,
                sigma = sigma,
                loadingMatrix = l,
                latentCovar = psi, 
                resMatrix = e,
                data = simData)

    return(out)
}

 

[Lazar]

Of course not!!

Many thanks!

 

[Lazar]

Hope I have this code cleaner (feel free to point out where it is not as I am still learning).

Below is a code that follows on from the SEMsimulation code above. This one mimics the pattern missing approach that is used in mplus simulations.

MISSpattern<- function(pattern, probs=1, simulation){
  #simulation     :is an SEMsimulation object
  #Pattern        :is a list  with as many elements as the length of probs
  #                Each element of the list contains a vector the length of the
  #                the number of items in the data frame. This vector represents
  #                the proportion of missing data to simulate per item.
  #probs          :is a vector. Each element indicates the proportion of the same to
  #                apply the missing data patterns to. The probs must sum to 1.
  
  #Takes data out of the SEMsimulation object.
  sim<- simulation$data
  #Takes number of items from the SEMsimulation object.
  item<- simulation$it
  
  #Function taken from stack overflow
  check.integer <- function(N){
    !length(grep("[^[:digit:]]", as.character(N)))
    }
  
  #Admissability Checks
  if(sum(probs)!=1)
  stop('FATAL ERROR: probs must sum to one')
  
  if(any(sapply(probs, function(x)(check.integer(nrow(sim)*x)))==FALSE) ) 
  stop('FATAL ERROR: when sample is multipled by probs, result must be integer')
  
  if(sum(sapply(pattern, length))!=item*length(probs))
  stop('FATAL ERROR: number of pattern entries must equal items x number of probs groups')  
  
  #The following function randomly assigns cases to probs group
  probsList<- list()
  
  for (i in 1:length(probs)){
       probsList[[i]]<- rep(i, nrow(sim)*probs[i])
      }
  #Provide a new variable in data frame used to split data to apply missing
  #data patterns
  probsList<-do.call(c, probsList)
  probsList<-sample(probsList, length(probsList))
  sim$spl<- probsList
  
  #Split data so that the patterns can be applied.
  data<- split(sim,sim$spl)
  
  #Applies missing data patterns to porpotions of sample
  #as set in probs command
  f1<-function(x,n){
    for (i in 1:item){
      if(pattern[[n]][i] == 0){x[,i]<- x[,i]
      }else{
        x[sample(nrow(x), floor(nrow(x)*pattern[[n]][i])),i]<-NA
        }
      }
   return(x)
   }
  
  for (j in 1:length(data)){
    data[[j]]<-f1(data[[j]], j)
  }
  
  #Pulls the seperate patterns back into single data frame
  sim<- do.call(rbind, data)  
  sim<- sim[,1:item]
  rownames(sim)<- seq(1:nrow(sim))
  return(sim)
}

Examples:

#SEMsimulation results used for the examples
simData2<-SEMsim(N.Obs=1000, fa=2,
                 load=c(.8,.7,.6,.7,.6,.5), 
                 l.pattern=list(1:3, 4:6), fcov=c(.25))

#single pattern of missing values applied to whole sample
sim<-MISSpattern(probs=1,  
                 pattern=list(c(.2, .2, .2, .2, .4, 0)),
                 simulation=simData2)

#multiple samples applied to different proportions of the simulated sample
sim<-MISSpattern(probs=c(.2, .2, .2, .4),  
                   pattern=list(rep(.2, 6), rep(.3, 6), rep(.1, 6), rep(0, 6)),
                 simulation=simData2)

 

[Lazar]

Ok bringing the two functions above together. The following simulates N latent variable data sets or covariance matrices.

SEMulation<- function(SIMS=10, COVAR=FALSE, MISSING=FALSE, MISSlist=list(NULL),
                      N.Obs, fa, load, l.pattern, fcov = 1){
  #SIMS        :The number of simulated data sets or covariance matrices.
  #COVAR       :If true returns covariance matrices rather than data sets.
  #MISSING     :If true takes the list augments from MISSlist and runs MISSpattern
  #             MISSING=TRUE is not compatable with COVAR=TRUE.
  #             For augments in MISSlist see MISSpattern
  #MISSlist    :Needs probs and pattern. See MISSpattern.
  #For N.obs to fcov see SEMsim documentation.
  
  #If both MISSING and COVAR are true returns an error.
  if(MISSING & COVAR)
  stop("Missing simulation is not compatable with Type equals covariance")
  
  #If COVAR=TRUE runs SEMsim for N sims and returns a list of simulated covariance
  #matrices. Else data sets are returned.
  if(COVAR){
     SEMS<- list()
         for (i in 1:N){
         SEMS[[i]] <- SEMsim(N.Obs, fa,load, 
                      l.pattern, fcov)
         SEMS[[i]] <- cov(SEMS[[i]]$data)
     }

  }else{
    SEMS<- list()
    for (i in 1:SIMS){
      SEMS[[i]] <- SEMsim(N.Obs, fa,load, 
                          l.pattern, fcov)
       #If missing is true MISSpattern is run on all N sims. Else
       #data sets with no missing data are returned.
       if (MISSING){
        SEMS[[i]] <- MISSpattern(MISSlist$pattern, MISSlist$probs, SEMS[[i]])
      }else SEMS[[i]] <- SEMS[[i]]$data
      
    }
  }
  return(SEMS)
}

Example:

simData2<-SEMulation(SIMS=10, COVAR=FALSE, N.Obs=1000, fa=2,
                 load=c(.8,.7,.6,.7,.6,.5), 
                 l.pattern=list(1:3, 4:6), fcov=c(.25),
                 MISSING=TRUE,
                 MISSlist=list(probs=1,  
                 pattern=list(c(.2, .2, .2, .2, .4, 0))))

Check that the long run average coverges to specified value, I used lavaan and checked that the .25 covariance between the simulated latent factors occurs:

require(lavaan)

model1 <- ' p1  =~ Var1 + Var2 + Var3
            p2 =~ Var4 + Var5 + Var6
            p1~~1*p1
            p2~~1*p2'

cfaFit<- function(x){fit<-cfa(model1, data=x)
                     return(fit@Model@GLIST$psi)}

test<-sapply(simData2,cfaFit)

rowMeans(test)[2]

Exampls 2 with 5 factors and 100 sims (note lavaan takes a while to run):

#Simulate 100 datasets with missing value.
simData5<-SEMulation(SIMS=100,N.Obs=100, fa=5,
                 load=c(.8,.7,.6,.7,.6,.5,.7,.8,.6,.76,.82,.72,.66,.68,.92, .87), 
                 l.pattern=list(1:3, 4:6, 7:9, 10:12, 13:16),
                 fcov=c(.25, .5, .11, .3, .22, .05, .45, .54, .32, .23),
                 MISSING=TRUE,
                 MISSlist=list(probs=c(.2, .2, .6),  
                               pattern=list(rep(.2, 16), rep(0, 16), rep(.1, 16))) )

#Run lavaan and check latent factor covariances
require(lavaan)

model1 <- ' p1  =~ Var1 + Var2 + Var3
            p2 =~  Var4 + Var5 + Var6
            p3  =~ Var7 + Var8 + Var9
            p4 =~  Var10 + Var11 + Var12
            p5 =~  Var13 + Var14 + Var15
            p1~~1*p1
            p2~~1*p2
            p3~~1*p3
            p4~~1*p4
            p5~~1*p5'

cfaFit<- function(x){fit<-cfa(model1, data=x)
                     return(fit@Model@GLIST$psi)}

test<-sapply(simData5,cfaFit)

rowMeans(test)

Note that the missing data pattern is less extreme in this example so results are closer to the population model.

 

[Lazar]

Did some optimization and speed up the code by a factor of 4 using lapply and only generating the population covariance matrix once rather that repeatedly for every simulation.

Spoiler

#rewrite so that only mvrnorm goes into the for loop.

SEMulation2<- function(SIMS=10, COVAR=FALSE, MISSING=FALSE, MISSlist=list(NULL),
                      N.Obs, fa, load, l.pattern, fcov = 1){
  #SIMS        :The number of simulated data sets or covariance matrices.
  #COVAR       :If true returns covariance matrices rather than data sets.
  #MISSING     :If true takes the list augments from MISSlist and runs MISSpattern
  #             MISSING=TRUE is not compatable with COVAR=TRUE.
  #             For augments in MISSlist see MISSpattern
  #MISSlist    :Needs probs and pattern. See MISSpattern.
  #For N.obs to fcov see SEMsim documentation.
  ## N.Obs    : is the number of observations wanted for simulation
  ## fa       : number of factors
  ## load     : vector of factor loadings 
  ## l.pattern: pattern indicating how the factor loadings load
  ## onto     : the simulated factors
  ## fcov     : factor covariances (variances set to 1)
  ##            entered in column major order
  #If both MISSING and COVAR are true returns an error.
  if(MISSING & COVAR)
  stop("Missing simulation is not compatable with Type equals covariance")
  
  ## Needed for simulating multivariate normal data
  require(MASS)
  ## Needed for forceSymmetric. upper.tri is unstable
  require(Matrix) 
  ## Number of items to be simulated
  it <- length(load) 
  l <- matrix(0, it, fa)
  ## Create a loading matrix. Cross loadings constrained to zero.
  for (i in 1:fa){
       l[l.pattern[[i]], i] <- load[l.pattern[[i]]]
  }
  
  psi <- matrix(1, fa, fa)
  ## Use expand grid to get needed covariances
  ref <- expand.grid(1:fa, 1:fa)
  ## Picks refernce to be filled in lower tri            
  ref <- ref[ref[,1] > ref[,2], 1:2]
  
  for (i in 1:nrow(ref)){
       ## Is filled in column major order
       psi[ref[i,1], ref[i,2]] <- fcov[i]
  }
  
  ## More effective than upper.tri function
  psi <- forceSymmetric(psi, 'L')
  ## Gives decent approximation of item residuals
  e <- 1 - diag(l %*% t(l))^2
  ## Simulates population covariance matrix
  sigma <- l %*% psi %*% t(l) + diag(e)
  #If COVAR=TRUE runs SEMsim for N sims and returns a list of simulated covariance
  #matrices. Else data sets are returned.
  SEMS<- list()
  for (i in 1:SIMS){
       SEMS[[i]]<- as.data.frame(mvrnorm(N.Obs, rep(0,it), sigma))
  }
  lapply(SEMS, function(x) colnames(x)<- paste('Var', 1:it, sep='') )
  
  if(COVAR){
     lapply(SEMS, function(x) cov(x))
  }else{
       #If missing is true MISSpattern is run on all N sims. Else
       #data sets with no missing data are returned.
       if (MISSING){
         lapply(SEMS, function(x) MISSpattern2(MISSlist$pattern, MISSlist$probs, MISSlist$item, x) )
      }else SEMS <- SEMS
  }
  return(SEMS)
}

This required a slight change in the MISSpattern code:

Spoiler

MISSpattern2<- function(pattern, probs=1, item, simulation){
  #simulation     :is an SEMsimulation object
  #Pattern        :is a list  with as many elements as the length of probs
  #                Each element of the list contains a vector the length of the
  #                the number of items in the data frame. This vector represents
  #                the proportion of missing data to simulate per item.
  #probs          :is a vector. Each element indicates the proportion of the same to
  #                apply the missing data patterns to. The probs must sum to 1.
  
  #Takes data out of the SEMsimulation object.
  sim<- simulation
  
  #Function taken from stack overflow
  check.integer <- function(N){
    !length(grep("[^[:digit:]]", as.character(N)))
    }
  
  #Admissability Checks
  if(sum(probs)!=1)
  stop('FATAL ERROR: probs must sum to one')
  
  if(any(sapply(probs, function(x)(check.integer(nrow(sim)*x)))==FALSE) ) 
  stop('FATAL ERROR: when sample is multipled by probs, result must be integer')
  
  if(sum(sapply(pattern, length))!=item*length(probs))
  stop('FATAL ERROR: number of pattern entries must equal items x number of probs groups')  
  
  #The following function randomly assigns cases to probs group
  probsList<- list()
  
  for (i in 1:length(probs)){
       probsList[[i]]<- rep(i, nrow(sim)*probs[i])
      }
  #Provide a new variable in data frame used to split data to apply missing
  #data patterns
  probsList<-do.call(c, probsList)
  probsList<-sample(probsList, length(probsList))
  sim$spl<- probsList
  
  #Split data so that the patterns can be applied.
  data<- split(sim,sim$spl)
  
  #Applies missing data patterns to porpotions of sample
  #as set in probs command
  f1<-function(x,n){
    for (i in 1:item){
      if(pattern[[n]][i] == 0){x[,i]<- x[,i]
      }else{
        x[sample(nrow(x), floor(nrow(x)*pattern[[n]][i])),i]<-NA
        }
      }
   return(x)
   }
  
  for (j in 1:length(data)){
    data[[j]]<-f1(data[[j]], j)
  }
  
  #Pulls the seperate patterns back into single data frame
  sim<- do.call(rbind, data)  
  sim<- sim[,1:item]
  rownames(sim)<- seq(1:nrow(sim))
  return(sim)
}

MISSpattern function is now the major bottleneck in terms of speed.

 

[bryangoodrich]

Since I don't understand any of this, I'm just going to assume Lazar is showing off

 

[Lazar]

I appear to be showing off my bad coding form. Thanks to dason for nesting the CODE tags inside the SPOILER tags above. It never occured to me that you could do that. Now to learn C so I can get rid of the bottleneck in MISSpattern.

 

[trinker]

A few simple utilities functions

These are nothing spectacular but may save time if you store them in your .Rprofile. I know some are opposed to this but if the code is just for you. I actually have mutiple .Rprofiles in different folders depending on if it's a project I'm screwing around on for me/HW/classwork, professional, or coding to share with others.

These three functions are in the for me Rprofiles.

I'm not going to formally introduce them as they're little crap functions but I especially like the rownamer as I use it pretty frequently.

rownamer Takes a dataframe and adds integers as rownames
DFduplicate Takes a data frame, repeats it, and stacks it n number of times
IDer Adds an ID column at the beginning of a data frame, simply integers IDs

rownamer <- function(dataframe){
    x <- as.data.frame(dataframe)
    rownames(x) <- 1:nrow(x)
    return(x)
}

rownamer(mtcars)
###############################################
DFduplicate <- function(dataframe, repeats=10){
    DF <- dataframe[rep(seq_len(nrow(dataframe)), repeats), ]
    rownamer(DF)
}

DFduplicate(mtcars)
##############################################
IDer <- function(dataframe, id.name="id"){
    DF <- data.frame(c=1:nrow(dataframe), dataframe)
    colnames(DF)[1] <- id.name
    return(DF)
}

IDer(mtcars)

 

[trinker]

Paste2

I see the next version of R will have a paste0 function that is a shortcut to paste(objects, sep=""). Recently I've had the need to make a paste function of my own that takes multiple columns of a data frame and pastes them together. Basically it takes an unknown list of columns and pastes them together. In the past:

This works as you know the number of columns to pass to paste. But sometimes inside of a function you don't know how many columns you will pass to paste.

paste(mtcars$am, mtcars$cyl, sep=".")

These do not work

paste(CO2[1:3], sep=".")                     
x <- list(mtcars$am, mtcars$cyl)
    paste(x, sep=".")

The solution (compliments of Dason) is paste2.

The function arguments:

paste2(multi.columns, sep=".", handle.na=TRUE, trim=TRUE)

multiple.columns columns in the form of a list or indexes from a data frame
sep come on you'd better know what this is
handle.na if there's an NA in the column returns NA, otherwise splices the NA in
trim eliminates white spaces

The Code

paste2 <- function(multi.columns, sep=".", handle.na=TRUE, trim=TRUE){

    if (trim) multi.columns <- lapply(multi.columns, function(x) {
            gsub("^\\s+|\\s+$", "", x)
        }
    )

    if (!is.data.frame(multi.columns) & is.list(multi.columns)) {
        multi.columns <- do.call('cbind', multi.columns)
      }

    m <- if(handle.na){
                 apply(multi.columns, 1, function(x){if(any(is.na(x))){
                       NA
                 } else {
                       paste(x, collapse = sep)
                 }
             }
         )   
         } else {
          apply(multi.columns, 1, paste, collapse = sep)
    }
    names(m) <- NULL
    return(m)
}

Examples

paste2(CO2[1:3])                     
paste2(CO2) 
paste2(list(mtcars$am, mtcars$cyl))

 

[trinker]

Another dumb one that's just for me. I can never remember what the function name is for the sos package [findFn()] so i made a wrapper for it and Rseek to search for r terms from within R. It's handy to me and I threw it in my .Rprofile. I can remember sos so that's the name of the function. The default method is sos but takes ressek and both as arguments as well.

sos <- function(x, method='sos'){
    require(sos)
    switch(method,
    sos=findFn(x),
    rseek=browseURL(paste("http://www.rseek.org/?cx=010923144343702598753%3Aboaz1reyxd4&newwindow=1&q=",x,"&sa=Search+functions%2C+lists%2C+and+more&cof=FORID%3A11&siteurl=www.rseek.org%2F#933",sep = "")),          
    both={browseURL(paste("http://www.rseek.org/?cx=010923144343702598753%3Aboaz1reyxd4&newwindow=1&q=",x,"&sa=Search+functions%2C+lists%2C+and+more&cof=FORID%3A11&siteurl=www.rseek.org%2F#933",sep = ""))
          findFn(x)
        }
    )
}

PS: anyone know a good way to split those web addresses up with out having to paste a bunch o pieces together?

 

[Dason]

One of the cool things about sos is that it adds a triple question mark to do a search as well

The following two lines search the same thing.

> findFn("linear model")
found 8056 matches;  retrieving 20 pages, 400 matches.
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 
> ???"linear model"
found 8056 matches;  retrieving 20 pages, 400 matches.
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

 

[trinker]

Here is a simple wrapper for strwrap with nicer formatting. It works best using clipboard but you can also supply text to it. I think Wickham has something like this in stringR already.


The code

strWrap <- function(text = "clipboard", width = 70) {
    x <- ifelse(text == "clipboard", paste(readClipboard(), collapse = " "), text)
    x <- gsub("\\s+", " ", gsub("\n|\t", " ", x))
    x <- strwrap(x, width = width)
    writeClipboard(x, format = 1)
    writeLines(x)
}

Example

x <-"5t34xdtfr5  5y6gh56g56hg 6 h456rh5rhrth5h45hrt 56hhh5h  th5t rtrkhvjnevurchf4rthyuiebrtnvr  hjrvt8ujtovet8 tvujreopuicmrtg envrticmogir hurvtouvgnr tncvmoritndtiower rtcvnvperonuvtr"
strWrap(x)

Returns:

5t34xdtfr5 5y6gh56g56hg 6 h456rh5rhrth5h45hrt 56hhh5h th5t
rtrkhvjnevurchf4rthyuiebrtnvr hjrvt8ujtovet8 tvujreopuicmrtg
envrticmogir hurvtouvgnr tncvmoritndtiower rtcvnvperonuvtr

Just happened to think this works well for windows as it pastes the code to the clipboard. I'd appreciate anyone extending it to a mac and/or linux too as I'm including this in a package and don't have a mac to test it one. Would this work on Linux? (the copying to the clipboard that is)

 

[Dason]

Doesn't work on my mac. I wouldn't expect it to work on Linux either.

 

[bryangoodrich]

Yeah. That's one sad thing I noticed about the *nix environment. It doesn't have the 'clipboard' reference as a possible connection. You have to explicitly link to something (there's a workaround, but I never got it to work and it was ugly and not worth the trouble).

 

[Dason]

Yeah. That's one sad thing I noticed about the *nix environment. It doesn't have the 'clipboard' reference as a possible connection. You have to explicitly link to something (there's a workaround, but I never got it to work and it was ugly and not worth the trouble).

Yeah there are ways to do it. But the reason it doesn't work out of the box is that well... somebody might not even have a clipboard program installed. Since there are so many choices too it's hard to just make things work out of the box.

 

[bryangoodrich]

That was one thing I found interesting when I ran into that problem. We Window users take the clipboard for granted, thinking it's just a standard operating system thing, since you always can just CTRL+C some stuff! The problem is that Linux systems are diverse and do often use a variety of utilities to accomplish a given task, including the clipboard. So no generic solution will work out of the box in that regard.

 

[trinker]

Occasionally I can't remember a package name I want to call but remember part of the name or what it starts with. I then have to go search the net for that function which annoys me. So I put this function in my library that gives me a menu interface with the packages in my library. I threw this one in my .Rprofile

Function

lib(begins.with = NULL, contains = NULL)

Arguments
begins.with searches packages beginning with this string
contains searches packages containing this string

The Code

lib <- function(begins.with = NULL, contains = NULL){
    if (!is.null(begins.with) & !is.null(contains)) {
        stop("Can not use both 'begins.with' & 'contains' arguments")
    }

    y <- sort(.packages(all.available = TRUE))

    if (!is.null(begins.with)) {
        w <- gsub("(\\w*)","\\U\\1", begins.with, perl=T)
        begins.with <- c(begins.with, w)
        y <- y[substring(y, 1, nchar(begins.with)) %in% begins.with]
        if(length(y)==0) stop("No packages match")
    }
    if (!is.null(contains)) {
        y <- y[grep(contains, y, ignore.case = TRUE)]
        if(length(y)==0) stop("No packages match")
    }
    x <- select.list(y, title = "packages")
    library(x, character.only = TRUE)
    cat(x, "loaded\n")
}

Examples

lib()  #gives all packages in your library
lib(contains='plot')   #gives only packages containing the word plot in it
lib('r')  #gives only packages starting with r or R 
lib(contains='Dason_Is_Cool')  #throws up an error as Dason is not cool