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

Thread: Share your functions & code

  1. #31
    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




    That doBy is a pretty big dependency just to recode the variables.

  2. #32
    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

    Point taken Dason

    I eliminated that dependency and eliminated the need for quotations around the game argument. Still somewhat inefficient (could have pasted the number and suits of the cards together but I'm lazy right now).

  3. #33
    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

    Get Package and Load it with One Function
    When I find a library I want I usually get it and load it right away. I use the install.packages() & library() functions. I've decided I'm too lazy for that. So I made one function to do both actions. Thanks to Dason for helping me work this one out.

    You do not need to put quotes around the library name when you use the code.

    Function
    Code: 
    get.lib<-function(package){
        pack1<-substitute(package)
           pack<-as.character(pack1)
    install.packages(pack)
    library(pack, character.only = TRUE)
    }
    Example
    Code: 
    get.lib(car)
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  4. #34
    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

    MODE OF Vectors and Data frames

    Description
    [R] has a mean and a median function and mode means something other than you'd expect. At times I wish there was a mode function (may be one in a package). Anyway I decided to make a function for mode. It takes a vector or data frame argument and returns 1) the mode, or 2) a warning if there is no mode (frequency of everything is 1). I made it work on data frames but I feel like it's not at its fullest yet. I have addressed this concern with the change from apply to lapply noted at the bottom Please critique so we can improve this.

    Function
    MODE(x)
    Arguments
    x is a vector or dataframe

    Function
    Code: 
    MODE <- function(dataframe){
        DF <- as.data.frame(dataframe)
    
        MODE2 <- function(x){      
            if (is.numeric(x) == FALSE){
                df <- as.data.frame(table(x))  
                df <- df[order(df$Freq), ]         
                m <- max(df$Freq)        
                MODE1 <- as.vector(as.character(subset(df, Freq == m)[, 1]))
    
                if (sum(df$Freq)/length(df$Freq)==1){
                    warning("No Mode: Frequency of all values is 1", call. = FALSE)
                }else{
                    return(MODE1)
                }
    
            }else{ 
                df <- as.data.frame(table(x))  
                df <- df[order(df$Freq), ]         
                m <- max(df$Freq)        
                MODE1 <- as.vector(as.numeric(as.character(subset(df, Freq == m)[, 1])))
    
                if (sum(df$Freq)/length(df$Freq)==1){
                    warning("No Mode: Frequency of all values is 1", call. = FALSE)
                }else{
                    return(MODE1)
                }
            }
        }
    
        return(as.vector(lapply(DF, MODE2)))
    }
    Example
    Code: 
    x1<-c(1:10)
    x2<-c(2,3,4,4,5,5,6,6,8,10)
    x3<-c(2,3,4,4,4,200)
    x4<-factor(c("yes","no","yes"))
    
    MODE(x1)
    MODE(x2)
    MODE(x3)
    MODE(x4)
    MODE(mtcars)
    MODE(CO2)
    I made it work on data frames but I feel like it's not at its fullest yet.
    I figured out what I was not doing correctly. I was using apply rather than lapply. This caused the data frame to be converted to a matrix. Meaning in a dataframe like CO2 (in base package) the numerics were converted to character. The function returned non-numeric warnings for all columns. The switch to lapply (what should be used for dataframes) corrected this error.
    Last edited by trinker; 07-31-2011 at 01:23 AM. Reason: Code Improvement
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

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

    SiBorg (04-17-2012)

  6. #35
    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've wondered this for a while - if you post code without indentation does that mean that you didn't indent in your original source code or just that the indentation got stripped when you posted it? Because I can't read unindented code. Well I can but I don't enjoy it.

  7. #36
    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

    Dason,

    Thanks for your question.
    I've wondered this for a while - if you post code without indentation does that mean that you didn't indent in your original source code or just that the indentation got stripped when you posted it?
    I don't know the answer to the first question (does the indenting get stripped away; I doubt it) but the answer to the second is yes I formatted it unindented. I'm not a programmer and [R] is my first language. What I've looked up this far about grammar/structure has not been helpful to a nonprogrammer. I'd appreciate if you have a resource to guide a nonprogrammer as to how to style/format code and functions? I don't even have the proper vocabulary around programming to know what terms to search for to get a style guide. Once I have that figured out I'll go back through and reformat the code I put in to be more readable. I want to become a stronger programmer and knowledge around this would help immensely.

    EDIT: Added links below
    Google Style Guide

    Hadley Wickam’s guide
    Last edited by trinker; 07-31-2011 at 11:36 AM. Reason: Found the answer to my own questions:

  8. #37
    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

    Looks like I got beat to it. I like those style guides. I was just going to provide this link and mention that I prefer something similar to K&R - except I never have an opening brace on a separate line.

  9. #38
    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

    I've read through the style guides and have attempted to follow them (this is my first attempt at writing in a more readable style. I really want to open this up for critique. I won't get better and people can't learn from this if we're worried about hurting someone's feelings. I want this thread to be open to critique in the name of improvement. So please give me the feedback I need to improve.

    I have attached the code here but edited in the original post as well (so future searchers will have quality code accessible right away). I actually debated whether or not to leave the original as a learning thread but decided in favor of editing my original post. I will not edit this post though, so others may learn from your feedback.

    Code: 
    MODE <- function(df){
    
    df <- as.data.frame(df)
    
    {MODE2 <- function(x){      
      if (is.numeric(x)==FALSE)
        {warning("MODE not meaningful for non-numeric vectors", call. = FALSE)
          }
      else { 
        df <- as.data.frame(table(x))  
           df <- df[order(df$Freq), ]         
              m <- max(df$Freq)        
    (MODE1 <- as.vector(as.numeric(as.character(subset(df,Freq==m)[, 1]))))
    
      if (sum(df$Freq)/length(df$Freq)==1){
        warning("No Mode: Frequency of all values is 1", call. = FALSE)
          } 
      else {
        MODE1
          }
        }
      }
    }
    
    as.vector(lapply(df, MODE2))
    
    }

  10. #39
    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

    Code: 
    MODE <- function(df){
        df <- as.data.frame(df)
    
        MODE2 <- function(x){      
            if (is.numeric(x) == FALSE){
                warning("MODE not meaningful for non-numeric vectors", call. = FALSE)
            }else{ 
                df <- as.data.frame(table(x))  
                df <- df[order(df$Freq), ]         
                m <- max(df$Freq)        
                MODE1 <- as.vector(as.numeric(as.character(subset(df, Freq == m)[, 1])))
    
                if (sum(df$Freq)/length(df$Freq)==1){
                    warning("No Mode: Frequency of all values is 1", call. = FALSE)
                }else{
                    return(MODE1)
                }
            }
        }
    
        return(as.vector(lapply(df, MODE2)))
    }
    Your indentation was really weird to me. I'm not sure if that was a result of mixing tabs/spaces (it's best to stick to one or the other - or use tabs to indent to the current indentation level and then if you want to align code use spaces). I fixed that up. You also had some parenthesis and curly braces that I couldn't figure out what the point of them was. I removed those and it didn't seem to break anything.

    I added a few spaces between operators. I'm not quite as big a fan of throwing in extra spaces as some of my professors are but I do think they are useful (I changed something like j==3 to j == 3)

    On a personal note I found it somewhat confusing to create a variable called df inside of MODE2 since there is already a df defined in the parent scope.

    On a side note - is there a reason you only accept numeric input? I typically only think of using the mode for non-numeric input so I found it interesting that you only find it for numeric input.

  11. #40
    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

    Dason,

    Thanks for the time and feedback. That helps immensely. For me to have someone give critique on something you've made is much more meaningful than looking up critiques and tearing apart code. Hopefully people will see the progression of the code as well and will find the style useful in their own learning.

    Your indentation was really weird to me. I'm not sure if that was a result of mixing tabs/spaces (it's best to stick to one or the other - or use tabs to indent to the current indentation level and then if you want to align code use spaces).
    yes this was the problem. I was also using str to look at other functions and saw mixed methods. Your example provides very clear guidance.

    You also had some parenthesis and curly braces that I couldn't figure out what the point of them was. I removed those and it didn't seem to break anything.
    I thought I was supposed to do the curly braces to section off (not the right term) a function within a function. I'm not sure where I got this idea from.

    (I changed something like j==3 to j == 3)
    I wasn't sure what to do here. The style guides seemed to not be definitive with = signs but I think that was a single =.

    On a personal note I found it somewhat confusing to create a variable called df inside of MODE2 since there is already a df defined in the parent scope.
    Didn't know this was bad. I'll make changes to reflect that. Thank you for that awareness on this point.

    On a side note - is there a reason you only accept numeric input? I typically only think of using the mode for non-numeric input so I found it interesting that you only find it for numeric input.
    I gave this some thought and I think it goes with thinking of central tendency measures as numeric. Mean and median are applied to numeric data. But on investigating this I found it is fine and actual useful for non-numeric data as well. I made the change to the code to reflect that as well.

    Updated Code
    Code: 
    MODE <- function(dataframe){
        DF <- as.data.frame(dataframe)
    
        MODE2 <- function(x){      
            if (is.numeric(x) == FALSE){
                df <- as.data.frame(table(x))  
                df <- df[order(df$Freq), ]         
                m <- max(df$Freq)        
                MODE1 <- as.vector(as.character(subset(df, Freq == m)[, 1]))
    
                if (sum(df$Freq)/length(df$Freq)==1){
                    warning("No Mode: Frequency of all values is 1", call. = FALSE)
                }else{
                    return(MODE1)
                }
    
            }else{ 
                df <- as.data.frame(table(x))  
                df <- df[order(df$Freq), ]         
                m <- max(df$Freq)        
                MODE1 <- as.vector(as.numeric(as.character(subset(df, Freq == m)[, 1])))
    
                if (sum(df$Freq)/length(df$Freq)==1){
                    warning("No Mode: Frequency of all values is 1", call. = FALSE)
                }else{
                    return(MODE1)
                }
            }
        }
    
        return(as.vector(lapply(DF, MODE2)))
    }

  12. #41
    TS Contributor
    Points: 5,839, Level: 49
    Level completed: 45%, Points required for next Level: 111

    Location
    Nottingham
    Posts
    682
    Thanks
    0
    Thanked 27 Times in 27 Posts

    Re: Share your functions & code

    This is a collection of functions that R does not have them in libraries (except from the Hotelling's test)
    http://www.scribd.com/doc/54592873/M...functions-in-R

  13. #42
    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

    RANDOM COLORS

    Description
    This is a function I use when I'm looking at scatterplots of data and would like each point to be a unique color. This helps me with certain visualization of the data where I want individual data points to stand out; sometimes keeping everything in black blurs it all together. I became annoyed with writing out the argument to get random color choices (if you just use a preseat palette the color choices are often very similar because the numeric sequence is very similar in color shade, hence the desire for randomization). This function can also be used to quickly change the palette settings (which contains eight colors by default) to as many different random colors as you want (see eaxmple at the bottom).

    There very well may be a more efficient method of doing this but I use the following function and keep it in a sourced .Rdata file or in the startup function .First() as a sourced object. Generally, I find the colors or rainbow argument to be most useful in differentiating points, thus the assignment of color.choice as rainbow. Not the most amazing function but it's a time saver for me.

    FUNCTION
    ran.col(c(dataframe, vector, number), color.choice = c(colors, rainbow, heat, terrain, topo, cm))

    The first argument will accespt a dataframe, vector or number as an arument. The second argument are any of the built in Color Palettes.

    FUNCTION CODE
    Code: 
    ran.col <- function(x, color.choice = "rainbow"){
        color.choice <- substitute(color.choice)
        color.choice <- as.character(color.choice)
    
        if(is.data.frame(x) == TRUE) { 
            switch(color.choice,
                   colors = sample(colors()[-1], nrow(x), replace = FALSE),
    	         rainbow = sample(rainbow(10000), nrow(x), replace = FALSE),
    	         heat = sample(heat.colors(10000), nrow(x), replace = FALSE),
    	         terrain = sample(terrain.colors(10000), nrow(x), replace = FALSE),
    	         topo = sample(topo.colors(10000), nrow(x), replace = FALSE),
    	         cm = sample(cm.colors(10000), nrow(x), replace = FALSE))
    
        }else if(is.vector(x) == TRUE & length(x)!= 1) { 
            switch(color.choice,
    	         colors = sample(colors()[-1], length(x), replace = FALSE),
    	         rainbow = sample(rainbow(10000), length(x), replace = FALSE),
    	         heat = sample(heat.colors(10000), length(x), replace = FALSE),
    	         terrain = sample(terrain.colors(10000), length(x), replace = FALSE),
    	         topo = sample(topo.colors(10000), length(x), replace = FALSE),
    	         cm = sample(cm.colors(10000), length(x), replace = FALSE))
           
        }else if(is.numeric(x) == TRUE) { 
            switch(color.choice,
    	         colors = sample(colors()[-1], x, replace = FALSE),
    	         rainbow = sample(rainbow(10000), x, replace = FALSE),
    	         heat = sample(heat.colors(10000), x, replace = FALSE),
    	         terrain = sample(terrain.colors(10000), x, replace = FALSE),
    	         topo = sample(topo.colors(10000), x, replace = FALSE),
    	         cm = sample(cm.colors(10000), x, replace = FALSE))
        }
    }
    EXAMPLE
    Code: 
    x11(16,8)
    par(mfrow = c(2,3))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(mtcars,colors),main="COLORS"))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(mtcars,rainbow),main="RAINBOW"))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(mtcars,heat),main="HEAT"))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(mtcars,terrain),main="TERRAIN"))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(mtcars,topo),main="TOPO"))
    with(mtcars,plot(mpg,disp,pch=19,col=ran.col(3,cm),main="CM"))
    
    ran.col(6,colors)
    #USING TO SET PALETTE
    palette()  #current palette
    palette(ran.col(10))   #set palette
    palette()    #current palette
    with(mtcars,plot(mpg,disp,pch=19,col=cyl,main="COLORS"))
    palette("default")    #return to default
    with(mtcars,plot(mpg,disp,pch=19,col=cyl,main="COLORS"))

    PS trying to follow style guide rules Hoping I am, but if not, let me know so I can correct it.
    Last edited by trinker; 08-04-2011 at 12:08 AM. Reason: Code style improvement
    "If you torture the data long enough it will eventually confess."
    -Ronald Harry Coase -

  14. #43
    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'm still not exactly sure how you're doing indenting but that's alright. Here's how I would indent it. If you ever use Emacs+ESS there is a nice little function that will correct indentation for you...

    Code: 
    ran.col <- function(df, color.choice = "rainbow"){
        color.choice <- substitute(color.choice)
        color.choice <- as.character(color.choice)
        switch(color.choice,
               colors = sample(colors()[-1], nrow(df), replace = FALSE),
               rainbow = sample(rainbow(10000), nrow(df), replace = FALSE),
               heat = sample(heat.colors(10000), nrow(df), replace = FALSE),
               terrain = sample(terrain.colors(10000), nrow(df), replace = FALSE),
               topo = sample(topo.colors(10000), nrow(df), replace = FALSE),
               cm = sample(cm.colors(10000), nrow(df), replace = FALSE))
    }
    I used spaces to align the options in the switch with color.choice. Well I indented to the same level as the switch (1 indent) and then used spaces from there - this will keep everything aligned on any system.

  15. #44
    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

    Dason,

    Thanks for the continued feedback. I made some adjustments to the code to accept vectors and numbers as well. I rewrote it and tried to follow your indentation guide. I updated the original post.

    May I ask why everything gets 5 indentation spaces but colors in the switch argument gets 8? Continue to critique, that will help me. Sometimes I'm not sure how to indent the if else portions.

  16. #45
    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


    Everything gets one indent (I don't use spaces) because it is only one level deep (it's all inside the function). The colors in the switch statement get aligned to the first argument with spaces because they are part of the switch statement - they aren't new commands so they're aligned with that first argument to show that they aren't new commands but just part of the switch statement - but that the switch statement would be far too long to have as a single line.

    Here is how I would do something like an if/else
    Code: 
    fact <- function(n){
        if(n < 0){
            warning("Inappropriate input to factorial")
        }else if(n == 0 | n == 1){
            return(1)
        }else{
            return(n*fact(n-1))
        }
    }

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

    trinker (08-04-2011)

+ Reply to Thread
Page 3 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