r,Code片段,代码实例,代码示例,代码片段库

r 在某些数据帧列上运行R函数，然后将结果粘贴到整个数据帧

在某些数据帧列上运行R函数，然后将结果粘贴到整个数据帧

gistfile1.r

time_spent <- function(from,to) {
op <- options(digits.secs = 3)  
 x<-as.numeric((strptime(to, "%Y-%m-%d %H:%M:%OS")-strptime(from, "%Y-%m-%d %H:%M:%OS")),units="secs")
 data.frame(time_spent=x)
}

dane_evaluations<-data.frame(dane_evaluations,time_spent=apply(dane_evaluations[,c('documentevaluation_start','documentevaluation_end')],1,function(x) time_spent(x[1], x[2])))

r 在R中合并（粘贴）两个数据帧：如果你想要INTERSECTION（两者的共同部分）作为结果，则为全部= FALSE =如果你想要SU，则为TRUE

在R中合并（粘贴）两个数据帧：如果你想要INTERSECTION（两者的共同部分）作为结果，则全部= FALSE如果你想要SUM（与NA完全相同的差异）作为结果：//stat.ethz，那么它= TRUE。 CH / R-手动/ R-devel的/库/碱/ HTML / merge.html

gistfile1.r

> authors
   surname nationality deceased
1    Tukey          US      yes
2 Venables   Australia       no
3  Tierney          US       no
4   Ripley          UK       no
5   McNeil   Australia       no
> books
      name                         title     other.author
1    Tukey     Exploratory Data Analysis             <NA>
2 Venables Modern Applied Statistics ...           Ripley
3  Tierney                     LISP-STAT             <NA>
4   Ripley            Spatial Statistics             <NA>
5   Ripley         Stochastic Simulation             <NA>
6   McNeil     Interactive Data Analysis             <NA>
7   R Core          An Introduction to R Venables & Smith
> authors_books<-merge(authors,books,by.x="surname",by.y="name",all=TRUE)
> authors_books
   surname nationality deceased                         title     other.author
1   McNeil   Australia       no     Interactive Data Analysis             <NA>
2   R Core        <NA>     <NA>          An Introduction to R Venables & Smith
3   Ripley          UK       no            Spatial Statistics             <NA>
4   Ripley          UK       no         Stochastic Simulation             <NA>
5  Tierney          US       no                     LISP-STAT             <NA>
6    Tukey          US      yes     Exploratory Data Analysis             <NA>
7 Venables   Australia       no Modern Applied Statistics ...           Ripley
> authors_books<-merge(authors,books,by.x="surname",by.y="name",all=FALSE)
> authors_books
   surname nationality deceased                         title other.author
1   McNeil   Australia       no     Interactive Data Analysis         <NA>
2   Ripley          UK       no            Spatial Statistics         <NA>
3   Ripley          UK       no         Stochastic Simulation         <NA>
4  Tierney          US       no                     LISP-STAT         <NA>
5    Tukey          US      yes     Exploratory Data Analysis         <NA>
6 Venables   Australia       no Modern Applied Statistics ...       Ripley

r http://stackoverflow.com/questions/18484243/r-regex-from-string-to-two-dimensional-data-frame-in-one-command迭代每一行并拆分

http://stackoverflow.com/questions/18484243/r-regex-from-string-to-two-dimensional-data-frame-in-one-command迭代每一行并将其数值拆分为由键。显示几行的示例，我希望它看起来像：

gistfile1.r

df <- data.frame(m = c(
  "{'#JJ': 121, '#NN': 938, '#DT': 184, '#VB': 338, '#RB': 52}",
  "{'#NN': 168, '#DT': 59, '#VB': 71, '#RB': 5, '#JJ': 35}",
  "{'#JJ': 18, '#NN': 100, '#DT': 23, '#VB': 52, '#RB': 11}"
))
 
parse.one <- function(s) {
  require(rjson)
  y <- fromJSON(gsub("'", '"', s))
  names(y) <- gsub("#", "", names(y))
  as.data.frame(y)
}
 
library(plyr)
rbind.fill(lapply(df$m, parse.one))

#    JJ  NN  DT  VB RB
# 1 121 938 184 338 52
# 2  35 168  59  71  5
# 3  18 100  23  52 11

r [R

[R

gistfile1.r

    s="{'#JJ': 121, '#NN': 938, '#DT': 184, '#VB': 338, '#RB': 52}"
    r1<-sapply(strsplit(s, "[^0-9_]+",as.numeric),as.numeric)
    r2<-sapply(strsplit(s, "[^A-Z]+",as.numeric),as.character)
    d<-data.frame(id=r2,value=r1)


r1
     [,1]
[1,]   NA
[2,]  121
[3,]  938
[4,]  184
[5,]  338
[6,]   52
 r2
     [,1]
[1,] ""  
[2,] "JJ"
[3,] "NN"
[4,] "DT"
[5,] "VB"
[6,] "RB"
> class(r1)
[1] "matrix"
 d
  id value
1       NA
2 JJ   121
3 NN   938
4 DT   184
5 VB   338
6 RB    52
 class(d)
[1] "data.frame"

r 数据时间差异在Rstrptimedifftime

数据时间差异在Rstrptimedifftime

gistfile1.r

 x1<-"2013-03-03 23:26:46.315558" 
 x2<-"2013-03-03 23:31:53.091022"
 x1 <- strptime(x1, "%Y-%m-%d %H:%M:%OS")
 x2 <- strptime(x2, "%Y-%m-%d %H:%M:%OS")
 x2
[1] "2013-03-03 23:31:53"
 x1
[1] "2013-03-03 23:26:46"
 x2-x1
Time difference of 5.112924 mins
 as.numeric(x2-x1)
[1] 5.112924
op <- options(digits.secs = 3)
 x2
[1] "2013-03-03 23:31:53.091"
 as.numeric(x2-x1,units="secs")
[1] 306.776

r secant.r

secant.r

f_test <- function(x) cos(x) - x

secant <- function(fun, x0, x1, tol=1e-9, max_iter=100) {
    # Keep track of number of interations
    iter <- 0
    # Evaluate function at initial points
    f1 <- fun(x1)
    f0 <- fun(x0)
    # Loop
    while((abs(x1-x0) > tol) && (iter<max_iter)) {
        # Calculate new value
        x_new <- x1 -  f1*(x1 - x0)/(f1 - f0)
        # Replace old value with current
        x0 <- x1
        x1 <- x_new
        f0 <- f1
        f1 <- fun(x1)
        # Increment counter
        iter <- iter + 1
    }

    if (abs(x1-x0) > tol) {
        cat("Algorithm failed to converge\n")
        return(NA)
    } 
    else {
        cat("Algorithm converged in", iter, "iterations\n")
        return(x1)
    }
}

secant(f_test, 2, 3)

r secant.r

secant.r

f_test <- function(x) cos(x) - x

secant <- function(fun, x0, x1, tol=1e-9, max_iter=100) {
    # Keep track of number of interations
    iter <- 0
    # Evaluate function at initial points
    f1 <- fun(x1)
    f0 <- fun(x0)
    # Loop
    while((abs(x1-x0) > tol) && (iter<max_iter)) {
        # Calculate new value
        x_new <- x1 -  f1*(x1 - x0)/(f1 - f0)
        # Replace old value with current
        x0 <- x1
        x1 <- x_new
        f0 <- f1
        f1 <- fun(x1)
        # Increment counter
        iter <- iter + 1
    }

    if (abs(x1-x0) > tol) {
        cat("Algorithm failed to converge\n")
        return(NA)
    } 
    else {
        cat("Algorithm converged in", iter, "iterations\n")
        return(x1)
    }
}

secant(f_test, 2, 3)