Related
I have been trying to find the observations associated with rank j in Ranked Set Sampling method. The problem is I don't know how to use the simulations to find the Xj values I'm supposed to work with further. Please help!
#The rankedsets function selects ranked sets from a target population. The selection of units in a set is without replacement, but the sets are selecting with replacement.
rankedsets<-function(X,m,s=m){
if(s==m){
x=sample(X,(m^2),replace=F)
n=matrix(x,ncol=m,nrow=m,byrow=T)
ms=matrix(0,ncol=m,nrow=m)
for (i in 1:m){
ms[i,]=sort(n[i,])
}
}else {
x=sample(X,(m*s),replace=F)
n=matrix(x,ncol=m,nrow=s,byrow=T)
ms=matrix(0,ncol=m,nrow=s)
for (i in 1:s){
ms[i,]=sort(n[i,])
}
}
return(ms)
}
#The rss function samples from a target population by using ranked set sampling method
rss<-function(X,m,r=1,sets=FALSE){
rss=numeric()
set=matrix(0,ncol=m,nrow=(m*r))
if (is.vector(X)){
a=0
for (j in 1:r){
ms=rankedsets(X,m)
for (i in 1:(m)){
set[i+a,]=ms[i,]
rss[i+a]=ms[i,i]
}
a=a+m
}
rss=matrix(rss,ncol=m,nrow=r,byrow=T)
cn=rn=numeric()
for (i in 1:r){
rn[i]=paste("r","=",i)
}
for (i in 1:m){
cn[i]=paste("m","=",i)
}
rownames(rss)=rn
colnames(rss)=cn
if (sets){
s=list(sets=set,sample=rss)
return(s)
} else {
return(rss)}
}else stop(" X must be a vector!",call.=F)
}
#RSS Data Generation
data=rnorm(10000,1,3)
rss(data,m=5,r=3,sets=TRUE)
I was trying using simulations but the code doesn't return Xj values:
sims = 1000
Xj = rep(NA, sims)
because I don't really know where I should put my for loop.
I am trying to code the Markov Chain approximation for some control problems.
But I have the following bug in R and I checked similar question in Stackoverflow and still have
no idea how to solve it. Any help will be greatly appreciated.
The bug comes from where I would like to find the minimum value among all of 'u' in a for loop.
To specific, in the uit-for-loop, for each next uit I could get a new single value (I thought) temp and would like to compare this with the temporary minimal stored by a single value variable vmin. That is the idea in the if-else sentence.
It is better to skip the parameter setting and initialization procedure.
#----- parameters ------
xleft=0; xright=10
yleft=0; yright=10
h=0.01
Nx=(xright-xleft)/h
Ns=2
Nu=11; hu=0.2
la=0.1
qMainDiag=c(-0.5,-0.5)
qSubDiag=c(0.5,0.5)
alpha=c(0.2,0.25)
beta=c(0.35,0.2)
a=c(0.6,0.8)
b=c(0.5,0.3)
c=c(0.45,0.5)
d=c(0.65,0.8)
tol=10^(-8)
maxitr=10000
#---- Initialization -----
Vold=array(0,dim=c(Nx+1,Nx+1,Ns))
Vnew=array(0,dim=c(Nx+1,Nx+1,Ns))
Uopt=array(0,dim=c(Nx+1,Nx+1,Ns))
for(r in 1:Ns){
for(i in 1:(Nx+1)){
for(j in 1:(Nx+1)){
Vold[i,j,r]=1
}
}
}
#---- iteration ----
for(n in 1:maxitr){
for(r in 1:Ns){
# inner of O
for(i in 2:Nx){
for(j in 2:Nx){
vInt=0
for(it in 1:(min(i,j)+1)){
vInt=vInt+Vold[i-it+1,j-it+1,r]*0.1*exp(-0.1*(it-1)*h)*h
}
# For each u, want to find the minimum temp value and its u.
for(uit in 1:Nu){
x=xleft+(i-1)*h; y=yleft+(j-1)*h
u=hu*(uit-1)
Xi11=(alpha[r]*x)^2; Xi22=(beta[r]*y)^2
f1=x*(a[r]-b[r]*y+u); f2=y*(-c[r]+d[r]*x+u)
g=1+r*(x+y)*(1+u^2)
Qh=(Xi11+Xi22)+h*(abs(f1)+abs(f2))+h-(h^2)*qMainDiag[r]
dlt=(h*h)/Qh
pforward=0.5*(Xi11+2*h*max(f1,0.0))/Qh
pback=0.5*(Xi11+2*h*max(-f1,0.0))/Qh
pup=0.5*(Xi22+2*h*max(f2,0.0))/Qh
pdown=0.5*(Xi22+2*h*max(-f2,0.0))/Qh
pswitch=(h*h*qSubDiag[r])/Qh
pstay=h/Qh
temp=(1-la*dlt)*(pforward*Vold[i+1,j,r]+pback*Vold[i-1,j,r]
+pup*Vold[i,j+1,r]+pdown*Vold[i,j-1,r]
+pswitch*Vold[i,j,3-r]
+pstay*Vold[i,j,r])+la*dlt*vInt+dlt*g
# find the minimal value (Here is the spot!!!)
if(uit==1){
vmin=temp; umin=u
}else if(temp<vmin){
vmin=temp; umin=u
}
}
Vnew[i,j,r]=vmin
Uopt[i,j,r]=umin
}
}
errormax=max(abs(Vold-Vnew))
print(n)
print(errormax)
Vold=Vnew
if(errormax<tol){
break
}
}
}
I am trying to cluster the data set "H" loaded from file but R tells "could not find function H". My code looks like as
H=read.table("X3.txt")
y=read.table("Y3.txt")
#X[3,]
#length(X[3])
#y
#y[3,]
m=2;R = 2; Ec = 0.001
p=1/(m-1)
Cold=matrix(c(1.89,3.76,2.47,4.76),2,2,byrow=TRUE)
C=matrix(,2,2)
M=length(H[,1])
mu=matrix(,M,R)
repeat {
for (i in 1:M){
for (j in 1:R){
for (k in 1:R){
mu(i,j)= (((H(i,)-Cold(j,))^2)/((H(i,)-Cold(k,))^2))+mu(i,j)
}
}
}
mu=1/mu;
#centre Update
for (j in 1:R){
A=matrix(,1,2);B=matrix(,1,2);
for (i in 1:M){
A=H(i,)*mu(i,j)^m+A;
B=mu(i,j)^m+B
}
C(j,)=A/B;
}
# centre update end
if (abs(Cold-C)>Ec) {Cold=C
} else {break()}
} #repeat ending loop
C
Can somebody help me how can i get through this, when i run the code i get following error
Error: could not find function "H"
In #centre Update part, in for loop you are using this code:
H(i,)
I assume that you are trying to get the first row of this H matrix. So use [] like this:
H[i,]
() - for function
[] - for matrix/data.frame subsetting
Aim : global decoding of hidden sequence using matrix. The step-by-step code is below:
# equilibrium probs
equil=function(P){
e=eigen(t(P))$vectors[,1]
e/sum(e)
}
# simulate hidden sequence
hssim=function(n,lambda)
{
r=dim(lambda)[1]
states=1:r
s=vector("numeric",n)
pi.lam=equil(lambda)
s[1]=sample(states,1,FALSE,pi.lam)
for (t in 2:n) {
s[t]=sample(states,1,FALSE,prob=lambda[s[t-1],])
}
s
}
# simulate observed sequence
obssim=function(s,P)
{
n=length(s)
r=dim(P)[2]
q=dim(P)[1]
states=1:q
obs=vector("numeric",n)
for (t in 1:n) {
obs[t]=sample(states,1,FALSE,prob=P[,s[t]])
}
obs
}
lambda=rbind(c(0.999,0.0002,0.0003,0.0004,0.0001),c(0.001,0.9930,0.010,0.004,0.002),c(0.0004,0.0020,0.9900,0.0075,0.0001),c(0.0007,0.0030,0.0003,0.9940,0.0020),c(0.0010,0.0005,0.0040,0.0020,0.9925))
s=hssim(10000,lambda)
P=cbind(c(0.6,0.1,0.1,0.2),c(0.25,0.3,0.2,0.25),c(0.1,0.6,0.2,0.1),c(0.25,0.2,0.4,0.1),c(0.5,0.2,0.2,0.1))
obs=obssim(s,P)
# optional - converting to/from another alphabet...
letters=c("a","c","g","t")
numbers=1:4
convert=function(x,frm,to)
{
to[match(x,frm)]
}
obslets=convert(obs,numbers,letters)
# estimate emmision probs from observed and hidden sequence
Pest=function(s,obs,r,q)
{
est=matrix(0,nrow=q,ncol=r)
for (i in 1:r) {
est[,i]=table(obs[s==i])
est[,i]=est[,i]/sum(est[,i])
}
est
}
phat=Pest(s,obs,5,4)
# estimate lambda from hidden sequence
lambdaest=function(s,r)
{
n=length(s)
est=matrix(0,ncol=r,nrow=r)
for (t in 2:n) {
est[s[t-1],s[t]]=est[s[t-1],s[t]]+1
}
for (i in 1:r) {
est[i,]=est[i,]/sum(est[i,])
}
est
}
lamhat=lambdaest(s,5)
# global decoding algorithm
global=function(obs,lambda,P)
{
r=dim(lambda)[1]
q=dim(P)[1]
n=length(obs)
s=vector("numeric",n)
f=matrix(0,nrow=r,ncol=n)
# forwards
f0=equil(lambda)
f[,1]=P[obs[1],]*(f0%*%lambda)
for (i in 2:n) {
for (k in 1:r){
f[k,i]=P[obs[i],k]*max(f[,i-1]*lambda[,k])
}
f[,i]=f[,i]/sum(f[,i])
}
# backwards
s[n]=which.max(f[,n])
for (i in (n-1):1) {
s[i]=which.max(lambda[,s[i+1]]*f[,i])
}
s
}
globest=global(obs,lambda,P)
I created function to solve viterbi decoding of a hidden sequence and showed error,and so i couldnt plot the graph identify the difference.Can anyone fix this for me.
The problem is that function max does not work with complex data like your f matrix.
I suggest taking the module before applying max. Example:
x = c(1 + 1i, 2)
# What you are doing
max(x)
# >> Error in max(x) : invalid 'type' (complex) of argument
# Suggestion
max(Mod(x))
# >> 2
I have a graph with each edge having cost and quality. I need to modify the dijkstras to find the path with the highest quality - but if the quality of two path is the same, then the path with the least cost should be chosen.
Initially, I was using dijkstras to find the path with minimum cost (code is pasted below).
Is it possible to modify those dijkstras in the above mentioned way?
If not, then please suggest another way to achieve this.
R code:
dijs<-function(n,v,cost,dist)
{
dist<-numeric(n)
flag<- numeric(n)
prev<-numeric(n)
for(i in 1:n)
prev[i] = -1
for(i in 1:n)
dist[i]<-cost[v,i]
count=2
while(count <= n)
{
min=999
for(w in 1:n)
{
if(dist[w] < min && !flag[w])
{
min=dist[w]
u=w
}
}
flag[u]=1
count<-count+1
for(w in 1:n)
{
if((dist[u]+cost[u,w] < dist[w]) && !flag[w])
{
dist[w]=dist[u]+cost[u,w]
prev[w]=u
}
}
}
printmin(v,dist,n)
return(prev)
}
main<-function()
{
cat('Enter no of nodes:', '\n')
n<-scan("",n=1,quiet=TRUE)
cat('Enter cost matrix','\n')
cost<-matrix(0,n,n)
for(i in 1:n) for(j in 1:n)
{
if(i == j)
cost[i,j]<-999
if(i != j && cost[i,j] == 0)
{
cat(sprintf("enter the cost from node %d to %d",i,j))
cost[i,j]<-scan("",n=1,quiet=TRUE)
if(cost[i,j] == 0)
cost[i,j]=999
cost[j,i]<-cost[i,j]
}
}
print(cost)
print('Enter the source:',quote=FALSE)
v<-scan("",n=1,quiet=TRUE)
prev<-digs(n,v,cost,dest)
print("the shortest distance")
for(i in 1:n)
{
cat(sprintf("path to %d ->",i))
printpath(i,prev)
cat('\n')
}
}
printmin<-function(v,mindist,n)
{
for(i in 1:n)
{
if(i != v)
{
cat(sprintf("%d -> %d, cost =%f",v,i,mindist[i]))
cat('\n')
}
}
}
printpath<-function(dest,prev)
{
if(prev[dest] != -1)
printpath(prev[dest],prev)
cat(sprintf("%d ",dest))
}
Assuming the quality that you use as the cost does not lead to negative cycles, I think the easiest way to do so is to compute all shortest path between source and dest and then rank all paths according to your second objective. You can use the default Dijkstra implementation to compute all equivalent shortest paths according to the first objective, just keep exploring the queue (instead of stopping when you reach the goal) until the next path taken from the queue is bigger than the optimal one. Then, compute the costs for each min path using your second objective and rank them using a sorting algorithm.
If you want to modify the original Dijkstra to compare the cost using prioritized objectives (first quality then cost or vice-versa) then you must prove that your modified version is optimal and complete