save from the IF function the variable - r

I have functions and would like to save from the IF function the variable "sick [i]" to take advantage of it
for(i in 1:licznik){
print_func <- function(a, b)
{
if(a > b)
{
print('wspolczynnik jest wiekszy' )
print(sick[i])
}
}
print_func(a[i], b[i])
}
How to do it
?

Try this from R for Data Science.
out <- vector("list", length(licznik))
for (i in seq_along(licznik)) {
if(a[[i]] > b[[i]]) {
print('wspolczynnik jest wiekszy')
print(sick[[i]])
out[[i]] <- sick[[i]]
}
}
str(unlist(out))

Related

After add new code, things cannot knit out

I met a wired situation. After add new code The code cannot knit out.
function_name <- function (...)
{
output <- if (output_format == "list") {
evolved.ts
} else if (output_format == "tsibble") {
as.tsibble(evolved.ts)
}
return(output)
}
You could read the arguments with args <- list(...):
function_name <- function (...)
{
args <- list(...)
# Code
output <- if (args$output_format == "list") {
evolved.ts
} else if (output_format == "tsibble") {
as.tsibble(evolved.ts)
}
return(output)
}

Applying technical trading rule to all combination of inputs

I have a Dataframe with columns containing different time series of data. I need to insert these columns into the function below automatically to find the best combination (highest return):
returns <- as.data.frame(rep(0, 4261)) #4261 because that's the length of n1.lc
returns$n2_5_10 <- rep(0, nrow(returns))
MSVrule <- function(n1, n2, hold){
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <- dt.lc$Settle[i - hold] - dt.lc$Settle[i]
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
{returns$n2_5_10[i] <- dt.lc$Settle[i] - dt.lc$Settle[i - hold]
}
else{
NULL
}
}
}
}
MSVrule(n1.lc$N1_2_5, n2.lc$n2_2_10, 5)
This function doesn't work, leaving returns$n2_5_10[i] 0 However, when I specifiy the vectors in the function it works:
hold <- 5
for(i in 13:nrow(n1.lc)){
if (n1.lc$N1_2_5[i] > n2.lc$n2_2_10[i] & n1.lc$N1_2_5[i-1] < n2.lc$n2_2_10[i-1]) {
returns$n2_5_10[i] <- (dt.lc$Settle[i - hold] - dt.lc$Settle[i]) / dt.lc$Settle[i]
} else {
if (n1.lc$N1_2_5[i] < n2.lc$n2_2_10[i] & n1.lc$N1_2_5[i-1] > n2.lc$n2_2_10[i-1])
{returns$n2_5_10[i] <- (dt.lc$Settle[i] - dt.lc$Settle[i - hold]) / dt.lc$Settle[i - hold]
}
else{
NULL
}
}
}
The next step would be to automatically apply the function to other combinations of vectors from the n1.lc Dataframe. But I need the function to work first.
Because you use a function with no return() attempting to modify objects outside its scope, nothing external will be changed. However, you can use <<- operator to modify external objects to the function, namely the n2_5_10 column in returns:
Below demonstrates with random generated data and assigns the column in returns with 500 or 5 as you do not post other needed, used objects (i.e., dt.lc). Adjust to actual data objects:
n1.lc <- data.frame(
N1_2_5 = runif(50),
n2_2_10 = runif(50)
)
returns <- data.frame(n2_5_10 = rep(0, nrow(n1.lc)))
MSVrule <- function(n1, n2, hold){
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <<- 500
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
{returns$n2_5_10[i] <<- 5
}
else{
NULL
}
}
}
}
MSVrule(n1.lc$N1_2_5, n1.lc$n2_2_10, 5)
However, consider using return where you create/update/output returns inside function. Then on outside, assign a new dataframe as the function's output (no need for else { NULL } clause):
MSVrule <- function(n1, n2, hold){
returns <- data.frame(n2_5_10 = rep(0, nrow(n1.lc)))
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <- 500
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
returns$n2_5_10[i] <- 5
}
}
return(returns)
}
newdf <- MSVrule(n1.lc$N1_2_5, n1.lc$n2_2_10, 5)
# BOTH ABOVE RESULT IN EQUIVALENT OUTCOMES
all.equal(returns, newdf)
# TRUE
identical(returns, newdf)
# TRUE

Autoconversion from number to NULL

I am trying to generate a vector of random numbers based on a finite random variable X
With probGen function I generate a variable X, l1 is the first line and l2 is the second one.
And at this point if(sum1 >= U) I recive this error Error in if (sum1 >= U) { : argument is of length zero
This is my code:
probGen=function(n)
{
v=vector()
k=sample(1:n,1)
v=rep(0,k)
for(i in 1:n)
{
aux=sample(1:k,1)
v[aux]=v[aux]+1
}
vfinal=vector()
klen=0
for(i in 1:k)
{
if(v[i]!=0) klen=klen+1
}
for(i in 1:k)
{
if(v[i]!=0)
vfinal=c(vfinal,rep(1/(klen*v[i]),v[i]))
}
vfinal=sample(vfinal)
return (vfinal)
}
n=22
l1=c(1:n)
l2=probGen(n)
l1
l2
simVar=function(l1,l2)
{
variante=vector()
U=runif(1,0,1)
for(i in 1:length(l1))
{
sum1=1-1
for(j in 1:i-1)
{
if(i-1>=1)
{
sum1=sum1+l2[j]
}
}
sum2=0.0
for(j in 1:i)
{
sum2=sum2+l2[j]
}
if(sum1 >= U)
{
if(U<sum2)
{
variante=c(variante,l1[i])
}
}
}
return (variante)
}
varR=simVar(l1,l2)
varR
Any idea?
Thanks!
The for(j in 1:i-1) near the top of the code for simVar is evaluating as (1:i)-1, resulting in a zero j which produces a NA value of sum1. Use for(j in 1:(i-1)) instead.

Why is break() not working in this loop? (but stop is)

I am trying to build a matrix model which ends if certain conditions are invoked - however for some reason the break() command isn't working, although stop() does. Unfortunately stop() is not what I need as I need to run the model a number of times.
The first break command in the model works, but I have left it in with dth>100 so that you can see for yourselves
n.steps <- 200
ns <- array(0,c(14,n.steps))
ns[13,1]<-rpois(1,3)
ns[14,1] <- 1
k<-0
for (i in 1:n.steps){
k<-k+1
ns[13,1]<-rpois(1,2)
death<-sample(c(replicate(1000,
sample(c(1,0), prob=c(surv.age.a, 1-surv.age.a), size = 1))),1)
ns[14,k] <- death
if (death == 0) {
dth <- sample(1:100, 1)
if (dth > 100) {
ns[14,k]<-0
print("stop.1")
break()
} else {
while (death == 0) {
if (ns[13, k] > 0) {
rep.vec[i]<-ns[13,k]
ns[13, k] <- ns[13, k] - 1
ns[14,k+1]<-1
print("replace")
} else {
if (ns[13, k] == 0) {
print("stop.2")
ns[14,k+1]<-0
break()
}
}
}
}
}
}
Try this (only showing the relevant portions):
for (i in 1:n.steps){
# ...
break.out.of.for <- FALSE
while (death == 0) {
if (ns[13, k-1] > 0) {
# ...
} else {
if (ns[13, k] == 0) {
# ...
break.out.of.for = TRUE
break
}
}
if (break.out.of.for) {
break
}
}

R: Using GraphNEL, term frequency of extracted keywords

I'm running the below code to extract key phrases from a raw data file. While i am successfully able to do it, i am not able to get the frequency or count of the extracted keywords which would help me understand the ranking of the occurrence of the keywords since i am using GraphNEL. Is there any way i can get the key phrase count? TIA.
ConstructTextGraph <- function(n)
{
word_graph <- new("graphNEL")
i <- 1
while (i < length(words) ) {
if ( IsSelectedWord(words[i]) ) {
links <- GetWordLinks(i,n)
if (links[1] != "") {
cat(i," ",words[i]," - ",paste(c(links),collapse=" "),"\n")
if ( length(which(nodes(word_graph)==words[i]))==0 ) {
word_graph <- addNode(words[i],word_graph)
}
for (j in 1:length(links)) {
if ( length(which(nodes(word_graph)==links[j]))==0 ) {
word_graph <- addNode(links[j],word_graph)
word_graph <- addEdge(words[i],links[j],word_graph,1)
}
else {
if ( length(which(edges(word_graph,links[j])[[1]]==words[i]))>0 ) {
prev_edge_weight <- as.numeric(edgeData(word_graph,words[i],links[j],"weight"))
edgeData(word_graph,words[i],links[j],"weight") <- prev_edge_weight+1
}
else {
word_graph <- addEdge(words[i],links[j],word_graph,1)
}
}
}
}
}
i <- i+1
}
word_graph
}
Please let me know if more information is needed.

Resources