I am writing a code in SAS and now I need to convert it into R
i have pasted my r code , but i know this is not correct. I need to use something like "Select in SAS" . Please help me to
convert this sas code in R
data t2; set t; by nhi ass_yr ass_mth;
R_G_Right = G1_Right;
M_G_Right = G1_Right_Maculopathy;
R_G_Left = G1_Left;
M_G_Left = G1_Left_Maculopathy;
* if G2 performed, use this ;
if G2_Right ne . then R_G_Right = G2_Right;
if G2_Right_Maculopathy ne . then M_G_Right = G2_Right_Maculopathy;
if G2_Left ne . then R_G_Left = G2_Left;
if G2_Left_Maculopathy ne . then M_G_Left = G2_Left_Maculopathy;
* collapse grades ;
* 0 - remains 0 ;
* 1-2 -> 1 ;
* 3 -> 2 ;
* 4-5-6 -> 3 ;
select (R_G_Right);
when (.) retgradeR = 0;
when (0) retgradeR = 0;``
when (1) retgradeR = 1;
when (2) retgradeR = 1;`enter code here`
when (3) retgradeR = 2;
otherwise retgradeR = 3;
end;
You can do it this way using dplyr
I did not translate the by statement in R because it does not have any impact later in the code.
Basically everything can be turned into a mutate function, and case_when replaces the select SAS code.
library(dplyr)
t2 <- t %>% mutate(R_G_Right = G1_Right,
M_G_Right = G1_Right_Maculopathy,
R_G_Left = G1_Left,
M_G_Left = G1_Left_Maculopathy,
R_G_Right = ifelse(!is.na(G2_Right),G2_Right,R_G_Right),
M_G_Right = ifelse(!is.na(G2_Right_Maculopathy),G2_Right_Maculopathy,M_G_Right),
R_G_Left = ifelse(!is.na(G2_Left),G2_Left,R_G_Left),
M_G_Left = ifelse(!is.na(G2_Left_Maculopathy),G2_Left_Maculopathy,M_G_Left),
retgradeR = case_when(
is.na(R_G_Right)| R_G_Right==0 ~ 0,
R_G_Right %in% c(1,2) ~ 1,
R_G_Right==3 ~2,
TRUE ~ 3)
)
I'm trying to use a bit of code that I found in an academic journal (). I'm new-ish to R. I keep getting an error when I reach the code calling up the function "binHist" that says "could not find the function "binhist". I can't figure out if it's in a library/ package I need to install or if there's another problem with the code. Any help would be much appreciated. Here's the code I extracted from the article:
whichData = yourData
baseH = data.frame()
RunningSum = 0
for (i in 2:16) {
tempBin = NULL
tempBin = binhist(i, whichData$rt)
theMean = sum(tempBin)/(i)
Divisor = sum(tempBin)
new = data.frame()
for (j in 1:ncol(tempBin)) {
grabVal = (tempBin[j] - theMean)^2
names(grabVal) <- NULL
new = c(new,grabVal)
}
extra = i - ncol(tempBin)
NewSum = Reduce("+",new) + extra*((0 - theMean)^2)
StdDev = sqrt(NewSum /(i-1))
RowVal = StdDev /Divisor
RunningSum = RunningSum + RowVal
baseH = c(baseH, list(tempBin))
}
paste("Number of Trials:",Divisor)
paste("Modulo-Binning Score (MBS): ",RunningSum)
library(plyr)
baseNow = do.call(rbind.fill,baseH)
Im using chainer and im try to do topic modeling. The code for the training phase contains the following:
optimizer = O.Adam()
optimizer.setup(self.train_model)
clip = chainer.optimizer.GradientClipping(5.0)
optimizer.add_hook(clip)
j = 0
msgs = defaultdict(list)
for epoch in range(epochs):
print "epoch : ",epoch
data = prepare_topics(cuda.to_cpu(self.train_model.mixture.weights.W.data).copy(),
cuda.to_cpu(self.train_model.mixture.factors.W.data).copy(),
cuda.to_cpu(self.train_model.sampler.W.data).copy(),
self.words)
top_words = print_top_words_per_topic(data)
if j % 100 == 0 and j > 100:
coherence = topic_coherence(top_words)
for j in range(self.n_topics):
print j, coherence[(j, 'cv')]
kw = dict(top_words=top_words, coherence=coherence, epoch=epoch)
data['doc_lengths'] = self.doc_lengths
data['term_frequency'] = self.term_frequency
for d, f in utils.chunks(self.batchsize, self.doc_ids, self.flattened):
t0 = time.time()
self.train_model.cleargrads()
l = self.train_model.fit_partial(d.copy(), f.copy(), update_words = update_words, update_topics = update_topics)
prior = self.train_model.prior()
loss = prior * self.fraction
loss.backward()
optimizer.update()
msg = ("J:{j:05d} E:{epoch:05d} L:{loss:1.3e} "
"P:{prior:1.3e} R:{rate:1.3e}")
prior.to_cpu()
loss.to_cpu()
t1 = time.time()
dt = t1 - t0
rate = self.batchsize / dt
msgs["E"].append(epoch)
msgs["L"].append(float(l))
j += 1
logs = dict(loss=float(l), epoch=epoch, j=j, prior=float(prior.data), rate=rate)
print msg.format(**logs)
print "\n ================================= \n"
#serializers.save_hdf5("lda2vec.hdf5", self.model)
msgs["loss_per_epoch"].append(float(l))
whn i execute the code i get for example:
J:00200 E:00380 L:0.000e+00 P:-2.997e+04 R:2.421e+04
only the L(loss) dont change, can someone please help to know why this value remain zero?
I've got a group of query strings that run as follows:
var nq = db.QueryValue("select COALESCE(COUNT(*),0)from OPPORTUNITY where START_DATE = DATEDIFF(d,0,getdate())");
var nrt = db.QueryValue("select COALESCE(COUNT(*),0)from OPPORTUNITY where START_DATE = DATEDIFF(d,0,getdate()) and OPPORTUNITY_STAGE = '-1'");
var nrep = nrt / nq;
All it gives me is unhandled exeption: cannot divide by zero.
There is often going to be a zero in either or both of the first two query results. How do I get it to display NaN (not a number) instead of crashing?
I'm sure I've asked this before, but I couldn't seem to find what the answer was.
Thanks in advance.
how about adding IF condition?
var nq = db.QueryValue("select COALESCE(COUNT(*),0)from OPPORTUNITY where START_DATE = DATEDIFF(d,0,getdate())");
var nrep = 0;
if (nq != 0)
{
var nrt = db.QueryValue("select COALESCE(COUNT(*),0)from OPPORTUNITY where START_DATE = DATEDIFF(d,0,getdate()) and OPPORTUNITY_STAGE = '-1'");
nrep = nrt / nq;
}
You can simply replace
var nrep = nrt / nq;
with
Double nrep = Double.NaN;
if (nq != 0)
{
nrep = nrt / nq;
}
PresentValue <- function(interest.rate, number.periods, frequency) {
if (interest.rate > 1) {interest.rate = interest.rate/100} else {"input interest.rate as a whole number"}
if (frequency < 1 || frequency > 12 ) {"frequency must be between 1 and 12"} else {interest.rate = interest.rate/frequency}
(1+interest.rate)^number.periods
}
The code above is simple but I need to catch user input error. I looked at tryCatch but it made no sense to me. Plus I think that it is not what I need at this point.
Basically, I need to do the following things
First, make sure the user has input the interest rate as a whole number (i.e. 5% not .05)
Second I need "ask" user how the rate is paid (frequency) monthly, annually, etc. Then divide the interest rate by the frequency.
What is strange is that the first condition only checks when the other if statements are remarked out.
This function will be an object in a larger set of functions so I think I need to consider these as warnings that will ultimately work with try catch. Finally, it would be nice if on the interest rate error the function did not terminate but simply asked for the user to correctly input the interest rate.
In apologize for the simplicity in advance but just could not find what I was looking for.
EDIT add some conetxt
Below is the bigger function. This shows the table output for convexity I need to incorporate duration and then a yield and price table and output to a page using swerve. This is going into a text book on structured finance. So it needs to work well for students
Bond.Cash.Flow <-function(issue.date, start.date, end.date, coupon, principal,
frequency, price){
library(lubridate)
issue.date <- as.Date(c(issue.date), "%m-%d-%Y")
start.date <- as.Date(c(start.date), "%m-%d-%Y")
end.date <- as.Date(c(end.date), "%m-%d-%Y")
price = price/100
# 30/360 day count calculation
d1 = day(issue.date)
m1 = month(issue.date)
y1 = year(issue.date)
d2 = day(end.date)
m2 = month(end.date)
y2 = year(end.date)
diff = (max(0, 30 - d1) + min(30, d2) + 360*(y2-y1) + 30*(m2-m1-1))/360
ncashflows = diff * frequency
cf.period = seq(1:ncashflows)
pmtdate = seq(start.date, end.date, by = "6 months")
time.period = (cf.period * 6)/12
couponincome = rep(coupon/frequency * principal, ncashflows)
principalincome = rep(0,ncashflows)
principalincome[ncashflows] = principal
cashflow = couponincome + principalincome
# Yield to maturity
irr <- function(rate, time.period, cashflow, principal, price){
pv = cashflow * 1/(1+rate)^time.period
proceeds = principal * price
sum(pv) - proceeds
}
ytm = uniroot(irr, interval = c(lower = -.20, upper = .20), tol =.000000001,
time.period = time.period, cashflow = cashflow, principal = principal, price = price)$root
ytm.vec = c(rep(ytm,ncashflows))
pv.factor = 1/(1+ytm.vec)^time.period
pv.cashflow = cashflow*pv.factor
pv.price = pv.cashflow /(principal * (price/100))
pv.period = pv.price * time.period
cvx.time = time.period*(time.period + 1)
cf.cvx = (cashflow/(1+ytm)^(time.period + 2))/(principal * (price/100))
cf.cvx.period = cf.cvx * cvx.time
cashflow.table <- data.frame(Period = cf.period, Time = time.period,
Cashflow = cashflow, PVFactor = pv.factor,PV = pv.cashflow, PV.Price = pv.price,
pv.period = pv.period, cvx.time = cvx.time, cf.cvx = cf.cvx,
cf.cvx.period = cf.cvx.period)
cashflow.table
(sum(pv.period) / (price * 100))/( 1+ (ytm/frequency))
.5 * ((sum(cf.cvx.period)/(price * 100)))
print(xtable(cashflow.table, digits = 4))
}
Bond.Cash.Flow <-function(issue.date, start.date, end.date, coupon, principal,
frequency, price){
library(lubridate)
issue.date <- as.Date(c(issue.date), "%m-%d-%Y")
start.date <- as.Date(c(start.date), "%m-%d-%Y")
end.date <- as.Date(c(end.date), "%m-%d-%Y")
price = price/100
# 30/360 day count calculation
d1 = day(issue.date)
m1 = month(issue.date)
y1 = year(issue.date)
d2 = day(end.date)
m2 = month(end.date)
y2 = year(end.date)
diff = (max(0, 30 - d1) + min(30, d2) + 360*(y2-y1) + 30*(m2-m1-1))/360
ncashflows = diff * frequency
cf.period = seq(1:ncashflows)
pmtdate = seq(start.date, end.date, by = "6 months")
time.period = (cf.period * 6)/12
couponincome = rep(coupon/frequency * principal, ncashflows)
principalincome = rep(0,ncashflows)
principalincome[ncashflows] = principal
cashflow = couponincome + principalincome
# Yield to maturity
irr <- function(rate, time.period, cashflow, principal, price){
pv = cashflow * 1/(1+rate)^time.period
proceeds = principal * price
sum(pv) - proceeds
}
ytm = uniroot(irr, interval = c(lower = -.20, upper = .20), tol =.000000001,
time.period = time.period, cashflow = cashflow, principal = principal, price = price)$root
ytm.vec = c(rep(ytm,ncashflows))
pv.factor = 1/(1+ytm.vec)^time.period
pv.cashflow = cashflow*pv.factor
pv.price = pv.cashflow /(principal * (price/100))
pv.period = pv.price * time.period
cvx.time = time.period*(time.period + 1)
cf.cvx = (cashflow/(1+ytm)^(time.period + 2))/(principal * (price/100))
cf.cvx.period = cf.cvx * cvx.time
cashflow.table <- data.frame(Period = cf.period, Time = time.period,
Cashflow = cashflow, PVFactor = pv.factor,PV = pv.cashflow, PV.Price = pv.price,
pv.period = pv.period, cvx.time = cvx.time, cf.cvx = cf.cvx,
cf.cvx.period = cf.cvx.period)
cashflow.table
(sum(pv.period) / (price * 100))/( 1+ (ytm/frequency))
.5 * ((sum(cf.cvx.period)/(price * 100)))
print(xtable(cashflow.table, digits = 4))
}
It is not clear what do you want to do since you don't give a precise context of the call of your function. So my answer will be partial.
Please assign default values to your arguments, especially one you have more than one argument to validate. Default arguments uses lazy evaluation in R and are really a powerful feature of the language.
Use stop and/or warning to throw an error/warning and catch it in its final call context to give the user a human message.
take a look at match.call(difficult for a beginner) to get the effective call of your function.
here an example using stop:
PresentValue <- function(interest.rate, number.periods=1, frequency=1) {
if (missing(interest.rate))
stop("Need to specify interest.rate as number between 0 and 1 for calculations.")
if (!is.numeric(interest.rate) )
stop("No numeric interest.rate specified.")
if (interest.rate <0 | interest.rate > 1)
stop("No valid interest.rate specified.")
## you do the same thing for other arguments
}
some tests:
PresentValue()
Error in PresentValue() :
Need to specify interest.rate as number between 0 and 1 for calculations.
> PresentValue("a")
Error in PresentValue("a") : No numeric interest.rate specified.
> PresentValue(5)
Error in PresentValue(5) : No valid interest.rate specified.
> PresentValue(0.9) ## normal use