Mercurial > repos > dongjun > mosaics

comparison mosaics/R/base_adapGridMosaicsZ0_IO.R @ 6:c9e0cd67dd84 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author dongjun
date Thu, 10 Jan 2013 15:57:50 -0500
parents b6d0c6ceda2c
children
comparison
equal deleted inserted replaced
5:fa238f67850b 6:c9e0cd67dd84
1
2 #.adapGridMosaicsZ0_IO <- function( Y, X, min_n_X=50 )
3 .adapGridMosaicsZ0_IO <- function( Y, X, bgEst=NA, inputTrunc, min_n_X=50,
4 parallel=parallel, nCore=nCore )
5 {
6 X_u <- a_u <- b_u <- mean0_u <- var0_u <-
7 u0_u <- u1_u <- u2_u <- n_u <- ty_u <- c()
8
9 Y_freq <- table(Y)
10
11
12 # adaptive griding for X (Input)
13
14 X_set <- sort( unique(X), decreasing=TRUE )
15 ind_X_set <- rep( 0, length(X_set) )
16
17 ind_now <- 1
18 N_now <- 0
19
20 for ( i in 1:length(X_set) )
21 {
22 N_i <- length( which( X==X_set[i] ) )
23 if ( N_now <= min_n_X )
24 {
25 ind_X_set[i] <- ind_now
26 N_now <- N_now + N_i
27 } else
28 {
29 ind_now <- ind_now + 1
30 ind_X_set[i] <- ind_now
31 N_now <- N_i
32 }
33 }
34
35 X_set_new <- rep( 0, length(X_set) )
36 for ( i in 1:length(unique(ind_X_set)) )
37 {
38 X_set_new[ind_X_set==i] <- median( X_set[ind_X_set==i] )
39 }
40
41 X_new <- rep( 0, length(X) )
42 for ( i in 1:length(X_set) )
43 {
44 X_new[ X==X_set[i] ] <- X_set_new[i]
45 }
46
47
48 # background fit
49
50 par_est2 <- .mosaicsZ0( Y=Y, bgEst=bgEst, analysisType="IO",
51 X=X_new, inputTrunc=inputTrunc, Y_freq=Y_freq,
52 parallel=parallel, nCore=nCore )
53
54
55 # return object
56
57 par_est_final <- list( X_u = par_est2$X_u, a_u = par_est2$a_u, b_u = par_est2$b_u,
58 mean0_u = par_est2$mean0_u, var0_u = par_est2$var0_u,
59 u0_u = par_est2$u0_u, u1_u = par_est2$u1_u, u2_u = par_est2$u2_u,
60 n_u = par_est2$n_u, ty_u = par_est2$ty_u,
61 Y_val = as.numeric(names(table(Y))), Y_freq = table(Y) )
62 return( par_est_final )
63 }