-
Notifications
You must be signed in to change notification settings - Fork 0
/
utils.R
185 lines (171 loc) · 6.53 KB
/
utils.R
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#' # utils
#' @author Gürol Canbek, <[email protected]>
#' Copyright (C) 2017-2018 Gürol CANBEK
#' @references <http://gurol.canbek.com>
#' @keywords utilities, common functions
#' @title utils - Common utility R functions
#' @date 16 January 2017
#' @version 1.2
#' @note version history
#' 1.2, 16 Feburary 2018, Plot to devide or PNG file
#' 1.1, 14 February 2018, Column name checking avoiding parameter for rclip
#' 1.0, 1 February 2017, The first version
#' @description Common R functions that can be called from other scripts
#' libraries
library(parallel) # Preinstalled in environment
plot_to_device <- 'Device'
#' ### getNumberOfCPUCores
#' Return the number of CPU cores in the current host
#' **Parameters:**
#' *logical*: if possible, use the number of physical CPUs/cores (if FALSE)
#' (default: FALSE)
#' **Return:**
#' Number of CPU cores
getNumberOfCPUCores<-function(logical=FALSE)
{
cores <- detectCores(logical=logical)
if (is.na(cores))
cores <- 1
return(cores)
}
#' ### wclip
#' Write to the Clipboard (i.e. Copy)
#' **Parameters:**
#' *metric*: Performance metric
#' *sep*: Seperator between column values (default: TAB)
#' *na*: Not Available identifies (default: 'NA')
#' *dec*: Decimal seperator (default: '.')
#' *row.names*: Does source metric have row names (default: TRUE)
#' *col.names*: Does source metric have column names (default: TRUE)
#' **Return:**
#' none
#' **Details:**
#' Code changes according to operating system (Windows or Mac OS)
#' **Warning:**
#' write.table writes unwanted leading empty column to header when has rownames
#' See http://stackoverflow.com/questions/2478352/write-table-writes-unwanted-leading-empty-column-to-header-when-has-rownames
#' **Examples:** `wclip(ACC)` or `wclip(ACC, dec= ',')`
wclip <- function(metric, sep='\t', na='NA', dec='.',
row.names=TRUE, col.names=TRUE)
{
if (.Platform$OS.type == 'windows')
write.table(metric, 'clipboard-256', sep=sep, dec=dec,
row.names=row.names, col.names=col.names)
else {
clip <- pipe('pbcopy', 'w')
write.table(metric, file=clip, sep=sep, na=na, dec=dec,
row.names=row.names, col.names=col.names)
close(clip)
}
}
#' ### rclip
#' Read from the Clipboard (i.e. Paste)
#' **Parameters:**
#' *sep*: Seperator between column values (default: TAB)
#' *na*: Not Available identifier (default: 'NA')
#' *dec*: Decimal seperator (default: '.')
#' *header*: Does source have column names (header)? (default: TRUE)
#' *stringsAsFactors*: Should character vectors be converted to factors?
#' (default: FALSE)
#' *check.names*: Avoid addition of "X" prefix into column names (default: FALSE)
#' **Return:**
#' Readed data frame
#' **Details:**
#' Code changes according to operating system (Windows or Mac OS)
#' **Warning:**
#' ignore warning message: incomplete final line found by readTableHeader on 'pbpaste'
#' **Examples:** `ACC <- rclip()` or `ACC <- wclip(dec= ',')`
rclip <- function(sep='\t', na='NA', dec='.', header=TRUE,
stringsAsFactors=FALSE, check.names=FALSE)
{
if (.Platform$OS.type == 'windows')
values <- read.table('clipboard-256', sep=sep, dec=dec, header=header,
stringsAsFactors=stringsAsFactors,
check.names=check.names)
else {
clip <- pipe('pbpaste')
values <- read.table(file=clip, sep=sep, na=na, dec=dec, header=header,
stringsAsFactors=stringsAsFactors,
check.names=check.names)
}
return(values)
}
#' ### pressEnterToContinue
#' Stop script run and show a (custom) message to user to press ENTER
#' **Parameters:**
#' *message*: custom message text to display (default: '')
#' **Return:**
#' none
#' **Details:**
#' Show a given message with 'Press [enter] to continue' statement and wait for
#' the user interaction. It is useful for pausing script run
#' **Examples:** `pressEnterToContinue()` or `pressEnterToContinue('wait')`
pressEnterToContinue<-function(message='')
{
invisible(readline(prompt=paste0(message, 'Press [enter] to continue')))
}
#' ### renameDataFrameColumn
#' Rename the column name of a data frame
#' **Parameters:**
#' *df*: data frame
#' *column_name*: existing column name
#' *new_column_name*: new column name
#' **Return:**
#' new data frame
#' **Details:**
#' **Examples:** `renameDataFrameColumn(df, 'test', 'product')`
renameDataFrameColumn<-function(df, column_name, new_column_name)
{
colnames(df)[colnames(df)==column_name] <- new_column_name
return(df)
}
#' ### emptyDataFrame
#' Create and return an empty data frame with given column names
#' **Parameters:**
#' *column_names*: column names vector
#' **Return:**
#' new data frame
#' **Details:**
#' **Examples:** `df <- emptyDataFrame(c('Col1', 'Col2'))`
emptyDataFrame<-function(column_names)
{
return(setNames(
data.frame(matrix(ncol=length(column_names), nrow=0)), column_names))
}
#' ### plotToDeviceOrFile
#' Plot a graphic to a device of a PNG file (if a file name is given)
#' **Parameters:**
#' *data*: data or R object to plot
#' *main_title*: n overall title for the plot (default: NULL)
#' *xlabel*: a title for the x axis (default: NULL)
#' *ylabel*: a title for the x axis (default: NULL)
#' *filepath*: path of the file (default: NULL to plot on device)
#' *width*: the width of the device/file (default: 20cm)
#' *height*: the height of the device/file (default: 15cm)
#' *units*: The units in which height and width are given (default: 'cm')
#' Could be 'in', 'px', 'mm'
#' *res*: The nominal resolution in ppi which will be recorded in the bitmap
#' file (default: 300)
#' *file_type*: Type of the file if filepath is provided: 'png', 'pdf'
#' (default: 'png')
#' **Return:**
#' none
#' **Examples:** `plotToDeviceOrFile(data, filepath='fig1.png')`
plotToDeviceOrFile<-function(data, col=NULL,
main_title=NULL, xlabel=NULL, ylabel=NULL,
filepath=NULL, width=20, height=15, units='cm',
res=300, file_type='png')
{
if (filepath != plot_to_device) {
if (file_type == 'png') {
png(filename=filepath, width=width, height=height, units=units, res=res)
}
else {
pdf(filename=filepath, width=width, height=height, units=units, res=res)
}
}
plot(data, col=col, main=main_title, xlab=xlabel)
if (FALSE == is.null(filepath)) {
dev.off()
}
}