+ Reply to Thread
Page 15 of 19 FirstFirst 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 LastLast
Results 211 to 225 of 273

Thread: Share your functions & code

  1. #211
    Beep
    Points: 61,742, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    Discussion EnderPosting AwardCommunity AwardMaster TaggerFrequent Poster
    Dason's Avatar
    Location
    Ames, IA
    Posts
    11,112
    Thanks
    261
    Thanked 2,156 Times in 1,837 Posts

    Re: Share your functions & code




    I think you meant to put dput2 and not repex.

    And this isn't working for me!
    Code: 
    dput2(mtcars + 2)
    Of course I'm just being facetious but I had to find a way to break your function
    Morte a tutti i raptors
    001100010010011110100001101101110011

  2. The Following User Says Thank You to Dason For This Useful Post:

    trinker (10-14-2012)

  3. #212
    ggplot2orBust
    Points: 35,306, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    User with most referrers
    trinker's Avatar
    Location
    Buffalo, NY
    Posts
    3,949
    Thanks
    1,356
    Thanked 753 Times in 674 Posts

    Re: Share your functions & code

    Yeah dason it was supposed to be dput2, originally it was repex for reproducible example but I couldn't remember the name for the function. And yes I knew it was fairly simple to break as I used:

    Code: 
    dput2(head(head(mtcars, 20)))
    but generally I want to dput a dataframe or the head of a dataframe. Anything else it works but you'll have to rename the object it's being assigned to. I don't really have any work around for all the different scenerios that could break it but if anyone has an easy solution I'm all eyes.
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  4. #213
    Beep
    Points: 61,742, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    Discussion EnderPosting AwardCommunity AwardMaster TaggerFrequent Poster
    Dason's Avatar
    Location
    Ames, IA
    Posts
    11,112
    Thanks
    261
    Thanked 2,156 Times in 1,837 Posts

    Re: Share your functions & code

    I doubt there is a direct solution. Consider
    Code: 
    val <- 10
    dput2(head(mtcars, val))
    How should it know which variable you want the name to be? You aren't dputting either object directly so there is no clear way to tell.
    Morte a tutti i raptors
    001100010010011110100001101101110011

  5. #214
    ggplot2orBust
    Points: 35,306, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    User with most referrers
    trinker's Avatar
    Location
    Buffalo, NY
    Posts
    3,949
    Thanks
    1,356
    Thanked 753 Times in 674 Posts

    Re: Share your functions & code

    an alternative would be to just use dat as the object we assign to since you're likely making a reproducible example anyway. What are your thoughts on that?
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  6. #215
    Beep
    Points: 61,742, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    Discussion EnderPosting AwardCommunity AwardMaster TaggerFrequent Poster
    Dason's Avatar
    Location
    Ames, IA
    Posts
    11,112
    Thanks
    261
    Thanked 2,156 Times in 1,837 Posts

    Re: Share your functions & code

    No I think the way you're doing it is fine. In 99% of the cases you'll correctly identify the name.
    Morte a tutti i raptors
    001100010010011110100001101101110011

  7. #216
    ggplot2orBust
    Points: 35,306, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    User with most referrers
    trinker's Avatar
    Location
    Buffalo, NY
    Posts
    3,949
    Thanks
    1,356
    Thanked 753 Times in 674 Posts

    Re: Share your functions & code

    Thought I'd share this one cause it's simple and has the possibility for lots of applications. outer is pretty nice but it doesn't take vectors. I once asked at SO how to make outer work with vectors and got two responses (LINK). I recieved two great responses but have stuck with the Vectorize solution though it's slower because it is more readable to me. Anyway this v.outer is a vectorized version of outer that you can supply a function to and that functions arguments. Acts on a matrix or data.frame.

    Code: 
    v.outer <- 
    function(x, FUN, digits = 3, ...){
        FUN <- match.fun(FUN)
        if (is.matrix(x)) {
            x <- as.data.frame(x)
        }
        if (is.list(x) & !is.data.frame(x)){
            if (is.null(names(x))) {
                names(x) <- paste0("X", seq_along(x))
            }
            nms <- names(x)   
        } else {
            nms <- colnames(x)
        }
        z <- outer(
          nms, 
          nms, 
          Vectorize(function(i,j) FUN(unlist(x[[i]]), unlist(x[[j]]), ...))
        )
        dimnames(z) <- list(nms, nms)
        if (is.numeric(z)) {
            z <- round(z, digits = digits)
        }
        z
    }
    
    v.outer(mtcars, cor)
    v.outer(mtcars, cor, method="kendall")
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  8. The Following User Says Thank You to trinker For This Useful Post:

    Lazar (10-29-2012)

  9. #217
    ggplot2orBust
    Points: 35,306, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    User with most referrers
    trinker's Avatar
    Location
    Buffalo, NY
    Posts
    3,949
    Thanks
    1,356
    Thanked 753 Times in 674 Posts

    Re: Share your functions & code

    ps I realize cor is a lttle silly in that it already gives you this output but it was the first function that came to mind that takes an x and y vector and so I used it. here's an example with a function for pooled sd (again this is a bit silly in that you'd do pooled for all and the function for pooled may be incorrect) but it can help people understand more:

    Code: 
    pooled.sd <- function(x, y) {
        n1 <- length(x)
        n2 <- length(y)
        s1 <- sd(x)
        s2 <- sd(y)
        sqrt(((n1-1)*s1 + (n2-1)*s2)/((n1-1) + (n2-1)))
    }
    
    v.outer(mtcars, pooled.sd)
    PS can anyone think of functions that take an x and y vectors and return a single value?
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  10. #218
    Phineas Packard
    Points: 9,473, Level: 65
    Level completed: 41%, Points required for next Level: 177
    Lazar's Avatar
    Location
    Sydney
    Posts
    918
    Thanks
    154
    Thanked 249 Times in 226 Posts

    Re: Share your functions & code

    um how about Euclidean distance:
    Code: 
    > euc.dist <- function(x,y) sqrt(sum((x - y) ^ 2))
    > v.outer(mtcars, euc.dist)

  11. The Following User Says Thank You to Lazar For This Useful Post:

    trinker (10-30-2012)

  12. #219
    Points: 1,363, Level: 20
    Level completed: 63%, Points required for next Level: 37
    Nathan G's Avatar
    Location
    Sacramento, CA
    Posts
    94
    Thanks
    27
    Thanked 29 Times in 23 Posts

    Re: Share your functions & code

    I'm new to R, but I'm learning fast... With \Huge{ thanks! } to everyone adding to this thread.. Just finished going through all the code.. Simply amazing stuff. I couldn't get everything to work: The unwrap() function was especially frustrating. I tried for a couple hours to no avail; I did get wrap() to work fairly quickly with some substitutions to make it functional on my mac. I realize now the functions I was writing were very raw. But here they are:
    1) a function that renames the column names to latex math format for my lab reports - yes I'm an undergrad
    2) a search function that returns the first occurrences of unique values in a data.frame column

    Code: 
        #################################################
        # 1)
        #	puts $dollar signs in front and behind all column names col_{sub} -> $col_{sub}$		
        #
        ###################################################
      
        amscols <- function(x){ colnames(x) <- paste( "$" , colnames(x) , "$" , sep = "" ) x }
    
        #################################################
        # 2)
        # Returns a data.frame of the first occurances of all unique values of the "search" column
        #
        ###############################################
    
        getfirsts <- function(data, searchcol){
        # Receives a data.frame and a "search" column
        # Returns a data.frame of the first occurances of all unique values of the "search" column
    	
    	  rows <- as.data.frame(match(unique(data[[searchcol]]), data[[searchcol]]))	
    	  firsts = data[rows[[1]],]
    	
    	  return(firsts)
        }

  13. #220
    Beep
    Points: 61,742, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    Discussion EnderPosting AwardCommunity AwardMaster TaggerFrequent Poster
    Dason's Avatar
    Location
    Ames, IA
    Posts
    11,112
    Thanks
    261
    Thanked 2,156 Times in 1,837 Posts

    Re: Share your functions & code

    Does using xtable from the xtable package not work for you to transfer tables to latex code?
    Morte a tutti i raptors
    001100010010011110100001101101110011

  14. #221
    Points: 1,363, Level: 20
    Level completed: 63%, Points required for next Level: 37
    Nathan G's Avatar
    Location
    Sacramento, CA
    Posts
    94
    Thanks
    27
    Thanked 29 Times in 23 Posts

    Re: Share your functions & code

    Thats what I use, but for the column names, I need subscripts and superscripts and the occasional equation which is translated by latex.
    Code: 
      library(xtable)
    
      #some code manipulating data into the format i like
    
        amscols(my.data.frame)    # <- formats column names from colname to $colname$
    
        mytable <-xtable(
            my.data.frame,
            caption="\\\\ \\textit{This is an example table with good latex formatting}", 
            label="tab:mytable", 
            align="cccccccccc",
            digits=2
        )
        print.xtable(
            mytable, 
            type="latex", 
            file="filepath.tex",
            include.rownames=F,
            table.placement="H",  
            size="small" , 
            caption.placement="top",
            sanitize.colnames.function=function(x){x}   # <- lifesaver
        )

  15. #222
    ggplot2orBust
    Points: 35,306, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    User with most referrers
    trinker's Avatar
    Location
    Buffalo, NY
    Posts
    3,949
    Thanks
    1,356
    Thanked 753 Times in 674 Posts

    Re: Share your functions & code

    Hey Nathan,

    Sorry about the unwrap causing frustration. I wrote it early in my understanding of R and didn't consider other platforms. Most likely the adaptations you did to wrap should be generalizable to unwrap. I must admit I no longer use these functions and so didn't really develop them any further. Glad to have you contributing to the discussions at talkstats.
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  16. The Following User Says Thank You to trinker For This Useful Post:

    Nathan G (12-18-2012)

  17. #223
    Points: 1,363, Level: 20
    Level completed: 63%, Points required for next Level: 37
    Nathan G's Avatar
    Location
    Sacramento, CA
    Posts
    94
    Thanks
    27
    Thanked 29 Times in 23 Posts

    Re: Share your functions & code

    No apology needed. I like the challenge and it's good me for me to go back and decode.. I started using R dealing exclusively with data.frames with the plyr and reshape2 packages and without any clear understanding of how they worked. Unraveling other peoples code helps me learn different methods and forces me to go back to the basics and dig into the nuances of R.
    “Super genius… I like the way that rolls out! Super Genius!" - Wile E. Coyote, SG
    "87.3% of all statistics are made up, the other 12.7% get done up.” - NRG

  18. #224
    Points: 1,980, Level: 26
    Level completed: 80%, Points required for next Level: 20
    derksheng's Avatar
    Posts
    247
    Thanks
    49
    Thanked 35 Times in 28 Posts

    Re: Share your functions & code

    Extremely simple function that strips NAs from vectors. Has improved my efficiency a lot when working interactively with data.

    Code: 
    noNA <- function(input)
    {
    	output <- input[!is.na(input)]
    	return(output)
    }
    Last edited by derksheng; 01-08-2013 at 07:44 AM.

  19. #225
    Beep
    Points: 61,742, Level: 100
    Level completed: 0%, Points required for next Level: 0
    Awards:
    Discussion EnderPosting AwardCommunity AwardMaster TaggerFrequent Poster
    Dason's Avatar
    Location
    Ames, IA
    Posts
    11,112
    Thanks
    261
    Thanked 2,156 Times in 1,837 Posts

    Re: Share your functions & code


    Quote Originally Posted by derksheng View Post
    Extremely simple function that strips NAs from vectors. Has improved my efficiency a lot when working interactively with data.

    Code: 
    noNA <- function(input)
    {
    	output <- input[!is.na(input)]
    	return(output)
    }
    There is also na.omit and na.exclude but those do a little bit more so you'll probably be more comfortable with your self made function.
    Morte a tutti i raptors
    001100010010011110100001101101110011

+ Reply to Thread
Page 15 of 19 FirstFirst 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 LastLast

           




Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts






Advertise on Talk Stats