Calcul Fausses alarmes

Bonjour,

J'auais besoin de votre aide dans ce code :

Code:

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
 
delta<-1.5 
p<-4
h_max<-30 # Initial upper control limit value
h_min<-0.01 # Initial lower control limit value 
h_tem<-0
ARL_tem<-0
ARL_0<-200 # In-control ARL value
epsilon<-0.01 # Degree of precision
k<-1 
R_opt<-0
 
# Initialization of smoothing parameter
ARL<-NULL
H<-NULL
ARL_opt<-ARL_0
ARL1_opt<-0
 
for (i in 1:100)
{ 
   r<-i/100 
   h_tem<-(h_max + h_min)/2
   ARL_tem<-ARL_Calculator(r,h_tem,0,p) 
   while(abs(ARL_0-ARL_tem > epsilon)
   { 
      if (ARL_tem > ARL_0) 
      { 
         h_max<-h_tem
         h_tem<-(h_max +h_min)/2
         ARL_tem<- ARL_Calculator(r,h_tem,0,p) 
      } 
      else
      { 
         h_min<-h_tem 
         h_tem<-(h_max +h_rnin)/2 
         ARL_tem<- ARL_Calculator(r,h_tem,0,p) 
      }
   } 
 
   ARL[k] <-ARL_Calculator(r,h_tem,delta,p)
 
   if(ARL_opt > ARL[k]) #If-statement to find the optimal smoothing parameter 
   { 
         ARL_opt<-ARL[k]
         R_opt<-r   
   } 
 
   H[k] <-h_tem
   k=k+1
   h_max<-30
   h_min<-0.01
   h_tem<-0 
} 
}
}
R_opt
ARL_opt

Le problème ici est que dans la fonction ARL_Calculator, je n'ai pas pu changer l'entrée de H et V en données numériques : je ne sais pas comment changer V<-matrix(data=NAN,nrow=range2,ncol=range2) en V<-matrix(x, nrow=range2,ncol=range2) avec x matrice de valeurs réelles et de dimension (1024, 450) .

J'ai essayé d'exécuter ce script à part, de la fonction ARL_Calculator :

Code:

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
 
r<-0.2
h<-3
d<-2
p<-5
delta<- 1
UCL<-sqrt(h*r/(2-r))
m1<-25
m2<-25
g1<-2*UCL/(2*m1+1)
g2<-2*UCL/(2*m2+1)
 
H<-matrix(data=Nan,nrow=2*m1+1,ncol=2*m1+1) 
 
#[Defining an identity matrix and a vector of 1s]
z<-(2*m1+1)*(m2 + 1)
n1<-c(z)
I <- matrix(0,nrow=n1,ncol=n1)
I[row(I)==col(I)]<-1
one<- matrix(1,nrow=z,ncol=1)
 
#[Transition Matrix of Wtl]
range1<-2*m1+1 # range1 is the number of states of Wtl
 
for (i in 1:range1)
{
   c_i<- -UCL+(i-0.5)*g1
 
   for (j in 1:range1)
   {
      up<-(-UCL+j *gl-(1-r)*c_i)/r-delta
      down<-(-UCL+(j-1)*gl-(1-r)*c_i)/r-delta
      H[i,j]<-pnorm(up,mean=0,sd=1)-pnorm(down,mean=0,sd=1)
   }
}
 
#[Transition Matrix of Wt2]
range2<-m2+1 # range2 is the number of states of Wt2
 
V<-matrix(data=NAN,nrow=range2,ncol=range2)
 
for (i in 0:m2)
{
   c<-((1-r)*i*g2/r)^2
 
   for (j in 0:m2)
   {
      if (j==0) 
      {
         V[i+1,1]<-pchisq((0.5*(g2)/r)^2, df=p-1,ncp=c) 
      }
      else 
      {
         up<-((j+0.5)*g2/r)^2
         down<-((j-0.5)*g2/r)  ^2
 
         V[i+1,j+1]<-pchisq(up,df=p-1,ncp=c)-pchisq(down,df=p-1,ncp=c)
      }
   }
}
 
E<- kronecker(H,V)   # Operating kronecker product
 
#[Finding transient states] 
counter<-1
 
for (alpha in 1:range1)
{ 
   for (beta in 0:m2)
   {
      if ((alpha-(m1+1))^2*g1^2+(beta*g2)^2 >= UCL^2)
      { 
         E[,counter]<-0 
         E[counter,]<-0 
      }
 
      counter<-counter+1
   }
}
 
 
temp<-solve(I-E)
 
S<- matrix(0,nrow=z,ncol=1)
start<-m1*(m2+1)+1
S[start,1]<-1
ARL<-t(S)
 
ARL
}

Tout marche bien jusqu'à E, mais après, pour la sous-section #[Finding transient states] , j'ai l'impression que ca n'avance pas car j'ai eu toutes les valeurs de ARL sont des 'zéro'.