Mercurial > repos > artbio > gsc_center_scale

comparison center_scale.R @ 2:163befe5f05b draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/ARTbio/tools-artbio/tree/main/tools/gsc_center_scale commit 41ba5435a8ad12c1fe0703a9ce44b759003f3f73
author artbio
date Sun, 15 Oct 2023 16:16:16 +0000
parents a96cc346819c
children
comparison
equal deleted inserted replaced
1:a96cc346819c 2:163befe5f05b
1 options( show.error.messages=F, 1 options(show.error.messages = FALSE,
2 error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } ) 2 error = function() {
3 cat(geterrmessage(), file = stderr())
4 q("no", 1, FALSE)
5 }
6 )
3 loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8") 7 loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
4 warnings() 8 warnings()
5 library(optparse) 9 library(optparse)
6 10
7 # Arguments 11 # Arguments
8 option_list = list( 12 option_list <- list(
9 make_option( 13 make_option(
10 '--data', 14 "--data",
11 default = NA, 15 default = NA,
12 type = 'character', 16 type = "character",
13 help = "Input file that contains values to transform. Must be tabular separated, 17 help = "Input file that contains values to transform. Must be tabular separated,
14 with columns and row names, variables in rows, observations in columns [default : '%default' ]" 18 with columns and row names, variables in rows, observations in columns [default : '%default' ]"
15 ), 19 ),
16 make_option( 20 make_option(
17 '--center', 21 "--center",
18 default = TRUE, 22 default = TRUE,
19 type = 'logical', 23 type = "logical",
20 help = "center data to the mean [default : '%default' ]" 24 help = "center data to the mean [default : '%default' ]"
21 ), 25 ),
22 make_option( 26 make_option(
23 '--scale', 27 "--scale",
24 default = TRUE, 28 default = TRUE,
25 type = 'logical', 29 type = "logical",
26 help = "scale data to standard deviation [default : '%default' ]" 30 help = "scale data to standard deviation [default : '%default' ]"
27 ), 31 ),
28 make_option( 32 make_option(
29 '--factor', 33 "--factor",
30 default = '', 34 default = "",
31 type = 'character', 35 type = "character",
32 help = "A two-column observations|factor_levels table, to group observations to be transformed by levels [default : '%default' ]" 36 help = "A two-column observations|factor_levels table, to group observations to be transformed by levels [default : '%default' ]"
33 ), 37 ),
34 make_option( 38 make_option(
35 '--output', 39 "--output",
36 default = 'res.tab', 40 default = "res.tab",
37 type = 'character', 41 type = "character",
38 help = "Table of transformed values [default : '%default' ]" 42 help = "Table of transformed values [default : '%default' ]"
39 ) 43 )
40 ) 44 )
41 45
42 transform <- function(df, center=TRUE, scale=TRUE) { 46 transform <- function(df, center = TRUE, scale = TRUE) {
43 transfo <- scale( 47 transfo <- scale(t(df),
44 t(df), 48 center = center,
45 center=center, 49 scale = scale
46 scale=scale 50 )
47 ) 51 return(as.data.frame(t(transfo)))
48 return(as.data.frame(t(transfo)))
49 } 52 }
50 53
51 opt = parse_args(OptionParser(option_list = option_list), 54 opt <- parse_args(OptionParser(option_list = option_list),
52 args = commandArgs(trailingOnly = TRUE)) 55 args = commandArgs(trailingOnly = TRUE))
53 56
54 data = read.table( 57 data <- read.delim(
55 opt$data, 58 opt$data,
59 check.names = FALSE,
60 header = TRUE,
61 row.names = 1,
62 sep = "\t"
63 )
64
65 if (opt$factor != "") {
66 data_factor <- read.delim(
67 opt$factor,
56 check.names = FALSE, 68 check.names = FALSE,
57 header = TRUE, 69 header = TRUE,
58 row.names = 1, 70 sep = "\t",
59 sep = '\t' 71 stringsAsFactors = TRUE
60 ) 72 )
61 73 colnames(data_factor) <- c("cellid", "level")
62 if (opt$factor != '') { 74 data_transformed <- data.frame(row.names = rownames(data))
63 data.factor = read.table( 75 for (group in levels(data_factor$level)) {
64 opt$factor, 76 subcells <- as.data.frame(subset(data_factor, level == group, select = cellid))
65 check.names = FALSE, 77 subdata <- as.data.frame(subset(data, select = as.vector(subcells$cellid)))
66 header = TRUE, 78 subdata_transformed <- transform(subdata, center = as.logical(opt$center),
67 sep = '\t' 79 scale = as.logical(opt$scale))
68 ) 80 data_transformed <- cbind(data_transformed, subdata_transformed)
69 colnames(data.factor) <- c("cellid", "level") 81 }
70 data.transformed <- data.frame(row.names=rownames(data), stringsAsFactors=FALSE)
71 for (group in levels(data.factor$level)){
72 subcells <- as.data.frame(subset(data.factor, level==group, select=cellid))
73 subdata <- as.data.frame(subset(data, select=as.vector(subcells$cellid)))
74 subdata.transformed <- transform(subdata, center=as.logical(opt$center),
75 scale=as.logical(opt$scale))
76 data.transformed <- cbind(data.transformed, subdata.transformed)
77 }
78 } else { 82 } else {
79 data.transformed <- transform(data, center=as.logical(opt$center), 83 data_transformed <- transform(data, center = as.logical(opt$center),
80 scale=as.logical(opt$scale)) 84 scale = as.logical(opt$scale))
81 } 85 }
82 86
83 87
84 write.table( 88 write.table(
85 cbind(gene=rownames(data.transformed), data.transformed), 89 cbind(gene = rownames(data_transformed), data_transformed),
86 opt$output, 90 opt$output,
87 col.names = TRUE, 91 col.names = TRUE,
88 row.names = FALSE, 92 row.names = FALSE,
89 quote = F, 93 quote = FALSE,
90 sep = "\t" 94 sep = "\t"
91 ) 95 )
92
93
94
95
96
97
98
99
100
101
102
103