I created a table ( 62 x 35 ) with characters in the table. I'm trying to replace the characters in a 10 x 10 table from the middle by others.
For example, if I have a table that looks like that: (62 x 35)
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
I want to be able to load a file containing (10x10):
//////////
//////////
//////////
//////////
//////////
//////////
//////////
//////////
//////////
//////////
so that the characters in this file replace the characters in the table created previously
i.e. have a table that looks like
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##########################//////////##########################
##############################################################
##############################################################
##############################################################
##############################################################
##############################################################
I don't think what I'm trying to do is very clear, so if you want more details please ask.
procedure Grid_Pilliers(A: out Grid) is -- creates grid with pilliers --
begin
for I in 0..31 loop
for J in 0..75 loop
if (I mod 4 = 1 or I mod 4 = 0) and (J mod 4 = 1 or J mod 4 = 0) then
A(I,J) := true ;
else
A(I,J) := false ;
end if ;
end loop ;
end loop ;
end Grid_Pilliers ;
procedure New_Grid_Random_Fill(A : in out New_Grid) is
type Numero is range 0 .. 1;
package Grid_Random is new Ada.Numerics.Discrete_Random (Numero);
use Grid_Random;
Random_Number : Numero;
G : Generator;
begin
Reset (G);
for I in A'Range(1) loop
for J in A'Range(2) loop
Random_Number := Random (G);
A(I,J) := (Random_Number = 1);
end loop;
end loop;
end New_Grid_Random_Fill;
You should probably use slicing... but for this example I'll use a pair of for-loops.
Assuming you have the table-type (Grid) defined as Array (Positive Range <>, Positive Range <>) of Character...
procedure copy_into( Working : in out Grid; subimage : in Grid;
Offset_X, Offset_Y : Natural ) is
begin
-- insert checks for subimage lengths [plus offsets]
-- to be less than Working's lengths.
for index_x in subimage'Range(1) loop
for index_y in subimage'Range(2) loop
Working(index_x+offset_x, index_y+offset_y):= subimage(index_x, index_y);
end loop;
end loop;
end copy_into;
To get the offsets is simple:
offset_x = big_grid_width + small_grid_width / 2.
offset_y = the above, but using height.
Related
I'm struggling with setting a y(x) condition that varies with x range. As an example below, the code wants to plot y=x between x=0 and x=5.1; otherwise y=2x.
Upon compilation, the code spits out the following: Expression must be a scalar or 1 element array in this context:
In other words don't know how to assign an array variable 'x' into if statement.
Thank you all for your help in advance.
PRO test
x = findgen(101.0,start=0)/10.0 ; 0.0 start, 10.0 end increment of 0.1
print,x
if x lt 5.1 then begin
y = 1.0 * x ;
endif else begin
y = 2.0* x
endelse
graph1=plot(x,y,thick=2,NAME=first,/CURRENT, $
linestyle = 0, ytitle=' y',xtitle='x' ) ; O
END
The problem is the test in your IF statement. Use WHERE instead to do something like the following.
y = x ;; need to initialize variable
low = WHERE(x lt 5.1,lw,COMPLEMENT=upp,NCOMPLEMENT=up)
IF (lw[0] GT 0) THEN y[low] = x[low] ;; technically don't need this line
IF (up[0] GT 0) THEN y[upp] = 2e0*x[upp]
I'm using NLopt for a constrained maximization problem. Regardless of the algorithm or start values, the optimization program is force stopped even before the first iteration (or so I assume because it gives me the initial value). I've attached my code here. I'm trying to find probabilities attached to a grid such that a function is maximized under some constraints. Any help is appreciated.
uk = x -> x^0.5
function objective(u,p,grd)
-p'*u.(grd)
end
function c3(grd,p)
c =[]
d =[]
for i=1:length(grd)
push!(c,quadgk(x -> (i-x)*(x <= i ? 1 : 0),0,1)[1])
push!(d,sum(p[1:i]'*(grd[1:i] .- grd[i])))
end
return append!(d-c,-p)
end
function c4(grd,p)
return (grd .* p)-quadgk(x,0,1)
end
grd = n -> collect(0:1/n:1)
opt = Opt(:LD_SLSQP,11)
inequality_constraint!(opt, p -> c3(grd(10),p))
inequality_constraint!(opt, p -> -p)
equality_constraint!(opt, p -> sum(p)-1)
equality_constraint!(opt, p -> c4(grd(10),p))
opt.min_objective = p -> objective(-uk, p, grd(10))
k = push!(ones(11)*(1/11))
(minf,minx,ret) = optimize(opt, k)
I'm not a julia developer, but I only know this, if you need exit before complete the loop for is not your best choice, you need do a while with a sentinel variable.
here you have an article that explain you how while with sentinels works
and here you have a julia example changing your for to a while with a sentinel that exit after the third loop
i = 1
third = 0
while i < length(grd) && third != 1
# of course you need change this, it is only an example that will exit in the 3 loop
if i == 3
third = 1
end
push!(c,quadgk(x -> (i-x)*(x <= i ? 1 : 0),0,1)[1])
push!(d,sum(p[1:i]'*(grd[1:i] .- grd[i])))
i += 1
end
I am attempting to translate the function DISCRINV() which is an excel function available in the simtools excel add-in that was created by Roger Myerson into an R function. I believe i am close, but am having difficulty understanding the looping syntax of VBA.
The VBA code for this function is as follows:
Function DISCRINV(ByVal randprob As Double, values As Object, probabilities As Object)
On Error GoTo 63
Dim i As Integer, cumv As Double, cel As Object
If values.Count <> probabilities.Count Then GoTo 63
For Each cel In probabilities
i = i + 1
cumv = cumv + cel.Value
If randprob < cumv Then
DISCRINV = values.Cells(i).Value
Exit Function
End If
Next cel
If randprob < cumv + 0.001 Then
DISCRINV = values.Cells(i).Value
Exit Function
End If
63 DISCRINV = CVErr(xlErrValue)
End Function
Attempting to translate this directly from the VBA code i have come up with this (Not Correct):
DISCRINV <- function(R,V,P){
if(length(V) != length(P)){
print("ERROR NUMBER OF VALUES DOES NOT EQUAL NUMBER OF PROBABILITIES")
} else{
for (i in 1:length(P)){
cumv=cumv+P[i]
if (R < cumv){
DISCY1 = V[i]
return(DISCY1)
}
print(cumv)
if (R < cumv +0.001){
DISCY2 = V[i]
return(DISCY2)
}
}
}
}
Attempting to translate this through my understanding of what it is doing i have come up with this:
DISCRINV <- function(x,values,probabilities){
require(FSA)
precumsum <- pcumsum(probabilities)
middle <- c()
for (i in 1:(length(values)-2)){
if (precumsum[i+1] <= x & x < precumsum[i+2]){
middle[i] <- values[i+1]}
else{
middle[i] <- 0
}
}
firstrow <- ifelse(x < precumsum[2], values[1], 0)
lastrow <- ifelse(precumsum[length(precumsum)] <= x , values[length(precumsum)] , 0)
Gvector <- c(firstrow,middle,lastrow)
print(firstrow)
print(middle)
print(lastrow)
print(Gvector)
simulatedvalue <- sum(Gvector)
return(simulatedvalue)
}
The latter option works 99% of the time, but not when the first function parameter is over 0.5, the second parameter is a vector of values c(1000,2000) and the third parameter is a vector (0.5,0.5). The case of the latter option not working 100% of the time is what has led me to try to translate the function directly. Could someone please give some insight into where my translation is going wrong?
Additionally a description of the function is as follows:
DISCRINV(randprob, values, probabilities) returns inverse cumulative values for a discrete random variable. When the first parameter is a RAND, DISCRINV returns a discrete random variable with possible values and corresponding probabilities in the given ranges.
Thank you in advance for the insight!
For anyone that is interested, i was able to successfully translate this VBA script using this code
DISCRINV <- function(x,values,probabilities){
require(FSA)
precumsum <- pcumsum(probabilities)
middle <- c()
if(length(values <3 )){
if(x<0.5){
middle1 <- values[1]
return(middle1)
} else{
middle2 <- values[2]
return(middle2)
}
}
else{
for (i in 1:(length(values)-2)){
if (precumsum[i+1] <= x & x < precumsum[i+2]){
middle[i] <- values[i+1]}
else{
middle[i] <- 0
}
}
firstrow <- ifelse(x < precumsum[2], values[1], 0)
lastrow <- ifelse(precumsum[length(precumsum)] <= x , values[length(precumsum)] , 0)
Gvector <- c(firstrow,middle,lastrow)
print(firstrow)
print(middle)
print(lastrow)
print(Gvector)
simulatedvalue <- sum(Gvector)
return(simulatedvalue)
}
}
I have a problem of optimizing a model. My function increments the value of a variable (Dem) in an iterative process to arrive at the condition set in the "WHILE".
I had to use a "FOR's" and some "IF's", I know that makes the very slow processing in the R environment, but I have to do in R.
The variable P is the length of 10958 obs. The variables A and C has a length of 65511 obs.
Using system.time (myfunction), using only one element of the variables Area [1] and C [1], my computer takes 2.5 seconds to complete the process. But for all elements of Area and C will take 45 hours.
My professor said it's too slow, but I think for the amount of data is normal, there is a way to optimize this? Should a option optimize the function (PSO,DEoptim,etc) instead using WHILE?
myfunction = function(P,Area,C,Cap,Inc){
Vin<- Cap
Q<-NA
Ov<-NA
Def<-NA
Vf<-NA
Vp<-NA
Dem<-0
Dem_100<-NA
Fail<-0
for (i in 1:length(Area)){
while(Fail==0){
Dem<-Dem+Inc
for (j in 1:length(P)){
#-----------------------------------------------------------------------#
####################### Calculate Q #####################################
#-----------------------------------------------------------------------#
if (P[j]==0){
Q<-0
}else{
Q<-P[j]*Area[i]*C[i]
}
#-----------------------------------------------------------------------
################################ Calculate Vp ##########################
#-----------------------------------------------------------------------
Vp<- (Vin + Q) - Dem
if(Vp<0){
Fail<-1
break #stop For j and continue the while
}
#----------------------------------------------------------------------
###################################### Calculate OV ###################
#----------------------------------------------------------------------
if (Vp>Cap){
Ov<-Vp-Cap
}else{
Ov<-0
}
#---------------------------------------------------------------------
######################################## Calculate Def ###############
#---------------------------------------------------------------------
if (Vp<0){
Def<-0-Vp
}else{
Def<-0
}
#---------------------------------------------------------------------#
################################## Calculate Vf ###########
#---------------------------------------------------------------------#
if (Vp>Cap){
Vf<-Cap
}else{
if (Vp<0) {
Vf<-0
}else{
Vf<-Vp
}
}
#-----------------------------------------------------------------------#
################################## Update Vin ###########
#-----------------------------------------------------------------------#
Vin<-Vf
}
Vin<- Cap # Reset the var Vin for new j
}
Dem_100[i]<-Dem-Inc
Def<-NA
Dem<-0
Vin<- Cap
Fail<-0
}
return(list(DemGar100=Dem_100))
}
Test for time process
P<-abs(rnorm(10958))
system.time(myfunction(P = P,Area = 100,C = 0.8,Cap = 10000,Inc = 1))
user system elapsed
2.45 0.00 2.50
Don't have enough rep to comment, but since not a full answer it should go there.
Did you think to replace some ifs with ifelse? That should speed it up
Eg, you could rplace the whole j-loop with something like:
for (i in 1:length(Area)){
while(Fail==0){
Dem<-Dem+Inc
Q <- ifelse(P==0,0,P*Area[i]*C[i]) ##note Q is a vector of length length(P)
...
Also I think that Def seems to be never calculated (and Vf is always Vp when Vp<=Cap), because if Vp<0 you jump out of the j-loop and maybe even the while (you set fail to 1, but I do not know when R checks the condition, at end of the cycle?Or the beginning)
So I have a simple example of what I want to do:
restart;
assume(can, real);
f := {g = x+can*x*y, t = x+x*y};
assign(f[1]); g;
can := 2;
plot3d(g, x = 0 .. 100, y = 0 .. 100);
while this works:
restart;
f := {g = x+can*x*y, t = x+x*y};
assign(f[1]);
can := 2;
plot3d(g, x = 0 .. 100, y = 0 .. 100);
But that assumptions are really important for my real life case (for some optimisations with complex numbers) so I cant just leve can not preassumed.
Why it plots nothuing for me and how to make it plot?
The expression (or procedure) to be plotted must evaluate to a numeric, floating-point quantity. And so, for your expression g, the name can must have a specific numeric value at the time any plot of g is generated.
But you can produce a sequence of 3D plots, for various values of can, and display them. You can display them all at once, overlaid. Or you can display them in an animated sequence. And you can color or shade them each differently, to give a visual cue that can is changing and different for each.
restart;
f := {g = x+can*x*y, t = x+x*y};
eval(g,f);
N:=50:
Pseq := seq(
plot3d(eval(g,f),
x=0..10,y=0..10,
color=RGB(0.5,0.5,can/(2*N)),
transparency=0.5*(can/(N+1))),
can=1 .. N):
plots:-display(Pseq, axes=box);
plots:-display([Pseq],insequence=true,axes=box);
By the way, you don't have to assign to g just for the sake of using the equation for g that appears inside f. Doing that assignment (using assign, say, like you did) makes it more awkward for you subsequently to create other equations in terms of the pure name g unless you first unassign the name g. Some people find it easier to not make the assignment to g at all for such tasks, and to simply use eval as I've done above.
Now on to your deeper problem. You create an expression containing a local, assumed name. and then later on you want to use the same expression but with the global, unassumed version of that name. You can create the expression, with it containing the global, unassumed name instead of the local, assumed name, buy performing a substitution.
restart;
assume(can, real);
f := {g = x+can*x*y, t = x+x*y};
{g = x + can~ x y, t = x + x y}
assign(f[1]);
g;
x + can~ x y
can := 2:
g;
x + can~ x y
# This fails, because g contains the local name can~
plot3d(g, x=0..100, y=0..100);
# A procedure to make the desired substitution
revert:=proc(nm::name)
local len, snm;
snm:=convert(nm,string);
len:=length(snm);
if snm[-1]="~" then
return parse(snm[1..-2]);
else return parse(nm);
end if;
end proc:
# This is the version of the expression, but with global name can
subsindets(g,`local`,revert);
x + can x y
# This should work
plot3d(subsindets(g,`local`,revert),
x=0..100,y=0..100);