ParallelR/PP_for_COS/ExplicitParallel.R at master · PatricZhao/ParallelR · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
# Examples for the R and Parallel Computing blog in COS website （cos.name)
# Author: Peng Zhao, 8/30/2016

# Generate data
len <- 1e8
a <- runif(len, -10, 10)
a[sample(len, 100,replace=TRUE)] <- 0

b <- runif(len, -10, 10)
c <- runif(len, -10, 10)

# Not vectorized function
solve.quad.eq <- function(a, b, c)
{
  # Not validate eqution: a and b are almost ZERO
  if(abs(a) < 1e-8 && abs(b) < 1e-8) return(c(NA, NA) )

  # Not quad equation
  if(abs(a) < 1e-8 && abs(b) > 1e-8) return(c(-c/b, NA))

  # No Solution
  if(b*b - 4*a*c < 0) return(c(NA,NA))

  # Return solutions
  x.delta <- sqrt(b*b - 4*a*c)
  x1 <- (-b + x.delta)/(2*a)
  x2 <- (-b - x.delta)/(2*a)

  return(c(x1, x2))
}

#############################################################################################
# *apple style
##############################################################################################
# serial code
system.time(
    res1.s <- lapply(1:len, FUN = function(x) { solve.quad.eq(a[x], b[x], c[x])})
)

# parallel
library(parallel)
# multicores on Linux
system.time(
  res1.p <- mclapply(1:len, FUN = function(x) { solve.quad.eq(a[x], b[x], c[x])}, mc.cores = 4)
)


# cluster on Windows
cores <- detectCores(logical = FALSE)
cl <- makeCluster(cores)
clusterExport(cl, c('solve.quad.eq', 'a', 'b', 'c'))
system.time(
   res1.p <- parLapply(cl, 1:len, function(x) { solve.quad.eq(a[x], b[x], c[x]) })
)
stopCluster(cl)


##########################################################################################
# For style
###########################################################################################
# serial code
res2.s <- matrix(0, nrow=len, ncol = 2)
system.time(
    for(i in 1:len) {
        res2.s[i,] <- solve.quad.eq(a[i], b[i], c[i])
    }
)

# foreach
library(foreach)
library(doParallel)

# Real physical cores in my computer
cores <- detectCores(logical = FALSE)
cl <- makeCluster(cores)
registerDoParallel(cl, cores=cores)

# clusterSplit are very convience to split data but it takes lots of extra memory
# chunks <- clusterSplit(cl, 1:len)

# split data by ourselves
chunk.size <- len/cores

system.time(
  res2.p <- foreach(i=1:cores, .combine='rbind') %dopar%
  {  # local data for results
     res <- matrix(0, nrow=chunk.size, ncol=2)
     for(x in ((i-1)*chunk.size+1):(i*chunk.size)) {
        res[x - (i-1)*chunk.size,] <- solve.quad.eq(a[x], b[x], c[x])
     }
     # return local results
     res
  }
)

stopImplicitCluster()
stopCluster(cl)


# Direct implementation but in-efficiency
# Real physical cores in my computer
# cores <- detectCores(logical=F)
# cl <- makeCluster(cores)
# registerDoParallel(cl, cores=cores)

#system.time(
#  res2.p <- foreach(i=1:len, .combine='rbind') %dopar%
#  {
#      solve.quad.eq(a[i], b[i], c[i])
#  }
#)
#stopImplicitCluster()
#stopCluster(cl)


###############################################################################
# Results on Intel Xeon  (Linux System)
###############################################################################
#> Rscript ExplicitParallel.R
#   user  system elapsed
# 78.914   0.445  79.435
#   user  system elapsed
# 21.644   1.485  23.153
#[1] TRUE
#   user  system elapsed
#  4.448   0.244  23.868
#[1] TRUE
#   user  system elapsed
# 53.081   0.071  53.202
#Loading required package: iterators
#   user  system elapsed
#  1.460   0.168  15.327
#[1] TRUE