I'm quite new to Julia and I'm considering the following problem.
I'd like to solve the (possible stiff) ODE system which describes the relaxation of a flow behind a shock wave according to a state-to-state approach which means that each vibrational level of the molecular species is considered as a pseudo-species with its continuity equation.
Here, I consider a binary mixture of N2/N (actually the concentration of N=0).
I have splitted the julia code in several .jl files. In the main, I call the ODE solver as follows:
prob = ODEProblem(rpart!,Y0_bar,xspan, 1.)
sol = DifferentialEquations.solve(prob, Tsit5(), reltol=1e-8, abstol=1e-8, save_everystep=true, progress=true)
where Y0_bar and xspan have been defined earlier and in the rpart.jl file I define the system:
function rpart!(du,u,p,t)
ni_b = zeros(l);
ni_b[1:l] = u[1:l]; print("ni_b = ", ni_b, "\n")
na_b = u[l+1]; print("na_b = ", na_b, "\n")
v_b = u[l+2]; print("v_b = ", v_b, "\n")
T_b = u[l+3]; print("T_b = ", T_b, "\n")
nm_b = sum(ni_b); #print("nm_b = ", nm_b, "\n")
Lmax = l-1; #println("Lmax = ", Lmax, "\n")
temp = T_b*T0; #print("T = ", temp, "\n")
ef_b = 0.5*D/T0; #println("ef_b = ", ef_b, "\n")
ei_b = e_i./(k*T0); #println("ei_b = ", ei_b, "\n")
e0_b = e_0/(k*T0); #println("e0_b = ", e0_b, "\n")
sigma = 2.; #println("sigma = ", sigma, "\n")
Theta_r = Be*h*c/k; #println("Theta_r = ", Theta_r, "\n")
Z_rot = temp./(sigma.*Theta_r); #println("Z_rot = ", Z_rot, "\n")
M = sum(m); #println("M = ", M, "\n")
mb = m/M; #println("mb = ", mb, "\n")
A = zeros(l+3,l+3)
for i = 1:l
A[i,i] = v_b
A[i,l+2] = ni_b[i]
end
A[l+1,l+1] = v_b
A[l+1,l+2] = na_b
for i = 1:l+1
A[l+2,i] = T_b
end
A[l+2,l+2] = M*v0^2/k/T0*(mb[1]*nm_b+mb[2]*na_b)*v_b
A[l+2,l+3] = nm_b+na_b
for i = 1:l
A[l+3,i] = 2.5*T_b+ei_b[i]+e0_b
end
A[l+3,l+1] = 1.5*T_b+ef_b
A[l+3,l+2] = 1/v_b*(3.5*nm_b*T_b+2.5*na_b*T_b+sum((ei_b.+e0_b).*ni_b)+ef_b*na_b)
A[l+3,l+3] = 2.5*nm_b+1.5*na_b
AA = inv(A); println("AA = ", AA, "\n", size(AA), "\n")
# Equilibrium constant for DR processes
Kdr = (m[1]*h^2/(m[2]*m[2]*2*pi*k*temp))^(3/2)*Z_rot*exp.(-e_i/(k*temp))*exp(D/temp); println("Kdr = ", Kdr, "\n")
# Equilibrium constant for VT processes
Kvt = exp.((e_i[1:end-1]-e_i[2:end])/(k*temp)); println("Kvt = ", Kvt, "\n")
# Dissociation processes
kd = zeros(2,l)
kd = kdis(temp) * Delta*n0/v0;
println("kd = ", kd, "\n", size(kd), "\n")
# Recombination processes
kr = zeros(2,l)
for iM = 1:2
kr[iM,:] = kd[iM,:] .* Kdr * n0
end
println("kr = ", kr, "\n", size(kr), "\n")
RD = zeros(l)
for i1 = 1:l
RD[i1] = nm_b*(na_b*na_b*kr[1,i1]-ni_b[i1]*kd[1,i1]) + na_b*(na_b*na_b*kr[2,i1]-ni_b[i1]*kd[2,i1])
end
println("RD = ", RD, "\n", size(RD))
B = zeros(l+3)
for i = 1:l
B[i] = RD[i]
end
B[l+1] = - 2*sum(RD)
du = AA*B
end
The problem is that when I run the simulation, and plot the solution it looks like nothing happened and all profiles are equal and flat. In fact, the solutions at each time-step is equal to itself. So, I think I make some mistake in the update of u and du but I cannot fix it.
In the Matlab version I obtain a correct evolution.
Kind regards,
Lorenzo
You're using the version for mutating the output, but you're creating an array instead of mutating the output. du .= AA*B
Related
When I run a shiny app for portfolio optimization, I get this error ("constraints are inconsistent, no solution") randomly about half the time, while it seems to work correctly half the time. I'm not really sure where the code is going wrong, as I've run the specific solve.QP and quadprog related commands on the console and it works fine there. It's only when I run it on the shiny app that the issue occurs. I suspect it may have something to do with how the code is processing the input, or with how the meq is defined. But I can't tell for sure. I have looked at similar questions on stack overflow but am unsure of how exactly I should change my meq constraints or make the Dmat matrix symmetric (if those two are the issues).
Here's the code:
library(quantmod)
library(lubridate)
library(dplyr)
library(data.table)
library(quadprog)
library(shiny)
Define UI for application that draws a histogram
ui <- fluidPage(
Application title
titlePanel("Robo-Advisor Shiny App"),
Sidebar with a slider inputs
fluidRow(
column(3,
numericInput(
inputId = "start",
label = "Beginning Date (yyymmdd):",
value = 20160101
),
numericInput(
inputId = "end",
label = "Ending Date (yyymmdd):",
value = 20201231
),
selectInput(
inputId = "parameter",
label = "Return optimal portfolio for given:",
choices = c("mu", "vol"),
selected = "mu"
),
numericInput(
inputId = "desired_annual_expected_return",
label = "Desired annual expected return (in decimal format):",
value = 0.2
),
numericInput(
inputId = "desired_annual_vol",
label = "Desired annual vol (in decimal format):",
value = 0.15
)
),
column(9,align="center",
fluidRow(
#splitLayout(div(plotOutput("prcPlot")), div(tableOutput("titleTable"), style = "font-size:100%"), div(tableOutput("prcTable"), style = "font-size:100%"), cellWidths = c("50%", "50%"))
div(plotOutput("prcPlot")),
div(tableOutput("titleTable")),
div(tableOutput("prcTable"))
)
)
) #close fluidRow
)#close fluidPage
Define server logic required to draw a histogram
server <- function(input, output) {
#####PREPARING DATA FOR PLOT & TABLE FUNCTIONS
dataPrep = reactive ({
#define variables from input boxes--------------------
startdt = ymd(input$start)
enddt = ymd(input$end)
parameter = input$parameter
d_mean = input$desired_annual_expected_return
d_sd = input$desired_annual_vol
#download and organize data---------------------------
symbolList = c("MSFT", "WMT", "AAPL", "IBM", "KO")
getSymbols(symbolList, from = startdt, to = enddt, src="yahoo") #default source is finance.yahoo.com
#Convert to dataframe
MSFT = as.data.frame(MSFT)
WMT = as.data.frame(WMT)
AAPL = as.data.frame(AAPL)
IBM = as.data.frame(IBM)
KO = as.data.frame(KO)
MSFT = to.monthly(MSFT) #converts to monthly frequency
WMT = to.monthly(WMT)
AAPL = to.monthly(AAPL)
IBM = to.monthly(IBM)
KO = to.monthly(KO)
prices = cbind(MSFT$MSFT.Adjusted, WMT$WMT.Adjusted, AAPL$AAPL.Adjusted,
IBM$IBM.Adjusted, KO$KO.Adjusted)
len = dim(prices)[1]
returns = as.data.frame(prices[2:len,] / prices[1:(len-1),]) - 1
names(returns) = c("msft", "wmt", "aapl", "ibm", "ko")
#Define the mean-variance optimization function
QPoptim = function(Eport, noshort, N, muvec, covmat){
ones = array(1,N)
Dmat = covmat
dvec = array(0,N)
Amat = cbind(muvec, ones)
b0vec = c(Eport, 1)
if(noshort==1) {
idmat = matrix(0,N,N)
diag(idmat) = 1
Amat = cbind(Amat,idmat)
b0vec = c(b0vec, array(0,N))
}
wvec = solve.QP(Dmat, dvec, Amat, b0vec, meq=2)$solution
sigport = sqrt( t(wvec) %*% covmat %*% wvec ) #returns this last value
}
#repeating the Qpoptim code partly to get only the portfolio weights
meanvarweights = function(Eport, noshort, N, muvec, covmat){
ones = array(1,N)
Dmat = covmat
dvec = array(0,N)
Amat = cbind(muvec, ones)
b0vec = c(Eport, 1)
if(noshort==1) {
idmat = matrix(0,N,N)
diag(idmat) = 1
Amat = cbind(Amat,idmat)
b0vec = c(b0vec, array(0,N))
}
wvec = solve.QP(Dmat, dvec, Amat, b0vec, meq=2)$solution
}
#initialize
N = 5
muvec = colMeans(returns[,1:N])
covmat = var(returns[,1:N])
#scroll through Eport values to derive efficient frontier
mincut = min(muvec)
maxcut = max(muvec)
Eportvec = seq(mincut,maxcut,length=300)
sigportvec = unlist(lapply(Eportvec, QPoptim, noshort=1, N, muvec, covmat))
#annualize stats
sigportvec = sigportvec * sqrt(12)
Eportvec = Eportvec * 12
#defining efficient frontier---------------------------------------------------
Emincut = Eportvec[which(sigportvec==min(sigportvec))]
idx = which(Eportvec>=Emincut)
#selecting the optimal portfolio
if (parameter=="mu") {
muportvec=c(d_mean)
w1 = meanvarweights(Eport=muportvec[1]/12, noshort=1, N, muvec, covmat)
sig1 = sqrt( t(w1) %*% covmat %*% w1 ) * sqrt(12)
} else {
sigportvec_1 = sigportvec[idx]
Eportvec_1 = Eportvec[idx]
a = which(abs(sigportvec_1-d_sd)==min(abs(sigportvec_1-d_sd)))
muportvec = c(Eportvec_1[a])
w1 = meanvarweights(Eport=(muportvec[1]/12), noshort=1, N, muvec, covmat)
sig1 = sqrt( t(w1) %*% covmat %*% w1 ) * sqrt(12)
}
#return data for output function-----------------------
temp = list(Eportvec = Eportvec, sigportvec = sigportvec,
w1=w1, muportvec=muportvec,sig1=sig1,idx=idx)
})
#####Plotting frontier
output$prcPlot <- renderPlot({
#calls above function for prepped data------------------------------
temp = dataPrep()
sigportvec = temp$sigportvec
Eportvec = temp$Eportvec
muportvec = temp$muportvec
w1 = temp$w1
sig1 = temp$sig1
idx= temp$idx
#define variables from input boxes----------------------------------
startdt = ymd(input$start)
enddt = ymd(input$end)
parameter = input$parameter
d_mean = input$desired_annual_expected_return
d_sd = input$desired_annual_vol
#text heading of plot
startdt_txt = format(startdt, "%Y-%m-%d")
enddt_txt = format(enddt, "%Y-%m-%d")
str1 = "Efficient Frontier (based on data from)"
str2 = "to"
main_text_string = paste(str1,startdt_txt,str2,enddt_txt)
#plots all minimum variance portfolios------------------------------------------
plot(sigportvec, Eportvec,
xlim=c(0,max(sigportvec)), ylim=c(0,max(Eportvec)),
type="l", xlab="sigma", ylab="E(r)",
main=main_text_string, col = "black", lwd=1, lty="dashed")
#now just plot efficient frontier on top------------------------------------------
lines(x=sigportvec[idx], y=Eportvec[idx], type="l", col = "blue", lwd=2)
#point label text
sig1_d = format(round(sig1,2), nsmall = 2)
muportvec_d = format(round(muportvec,2), nsmall = 2)
sig1_t = as.character(sig1_d)
muportvec_t = as.character(muportvec_d)
sig1_txt = paste("sig=",sig1_t)
muportvec_txt = paste("mu=",muportvec_t)
label1 = paste(sig1_txt, ",", muportvec_txt)
#pick a portfolio along efficient frontier-----------------------
points(x=c(sig1), y=muportvec, col="blue", lwd=3, pch=1)
text(x=c(sig1), y=muportvec, labels = c(label1), pos=4)
})
#Making table heading
output$titleTable <- renderTable({
#calls above function for prepped data------------------------------
temp = dataPrep()
sigportvec = temp$sigportvec
Eportvec = temp$Eportvec
muportvec = temp$muportvec
w1 = temp$w1
sig1 = temp$sig1
idx= temp$idx
#define variables from input boxes----------------------------------
startdt = ymd(input$start)
enddt = ymd(input$end)
parameter = input$parameter
d_mean = input$desired_annual_expected_return
d_sd = input$desired_annual_vol
#Prepare table heading format
sig1_d = format(round(sig1,2), nsmall = 2)
muportvec_d = format(round(muportvec,2), nsmall = 2)
if (parameter=="mu") {
string1 <- "The following portfolio achieves your desired annual mu ="
string2 <- "with vol ="
result = paste(string1, muportvec_d, string2, sig1_d)
} else {
string1 <- "The following portfolio achieves your desired annual vol ="
string2 <- "with mu ="
result = paste(string1, sig1_d, string2, muportvec_d)
}
#making table
colnamevec = c(" ")
numcol = length(colnamevec)
blank = array("", numcol)
blank = as.data.frame(t(blank))
colnames(blank) = colnamevec #prepared so that header of output is empty
row1 = blank
row1[1] = c(result)
ltemp = list(row1)
FINALOUT = rbindlist(ltemp) #prints this final table
}, align = 'c')
#####Plotting Summary Table
output$prcTable <- renderTable({
#calls above function for prepped data------------------------------
temp = dataPrep()
sigportvec = temp$sigportvec
Eportvec = temp$Eportvec
muportvec = temp$muportvec
w1 = temp$w1
sig1 = temp$sig1
idx= temp$idx
#define variables from input boxes----------------------------------
startdt = ymd(input$start)
enddt = ymd(input$end)
parameter = input$parameter
d_mean = input$desired_annual_expected_return
d_sd = input$desired_annual_vol
#reducing decimal places in the weight values
w1_d = format(round(w1,2),nsmall=2)
#making table
colnamevec = c(" ", " ")
numcol = length(colnamevec)
blank = array("", numcol)
blank = as.data.frame(t(blank))
colnames(blank) = colnamevec #prepared so that header of output is empty
row1 = blank
row2 = blank
row3 = blank
row4 = blank
row5 = blank
row1[1:2] = c("MSFT",w1_d[1])
row2[1:2] = c("WMT",w1_d[2])
row3[1:2] = c("AAPL",w1_d[3])
row4[1:2] = c("IBM",w1_d[4])
row5[1:2] = c("KO",w1_d[5])
ltemp = list(row1, row2, row3, row4, row5)
FINALOUT = rbindlist(ltemp) #prints this final table
}, align = 'cc')
}
Run the application
shinyApp(ui = ui, server = server)
I have a simple data.frame that I would like to write to an output .txt file using R.
Sample code:
my_df <- data.frame(name = c("Wendy", "Quinn"), age = c(23, 43))
write.table(my_df, file = "my_output_file.txt", sep = " ", col.names = F, row.names = F, quote = F, eol = "\n")
The trouble is that I am getting the following output file when viewed in Notepad++ (see screenshot). I understand the eol = "\n" argument places a carriage return at the end of each line -- I want that for the line separation between these two rows, but not at the end of the document. Is there a method to omit the final carriage return that results in my .txt file being 3 lines long instead of only 2?
I don't know of an automatic way to do it, but try this:
my_df <- data.frame(name = c("Wendy", "Quinn"), age = c(23, 43))
write.table(my_df, file = "my_output_file.txt", sep = " ", col.names = F, row.names = F, quote = F, eol = "\n")
produces the same output:
but this
my_output <- capture.output(write.table(my_df, sep = " ", col.names = F, row.names = F, quote = F, eol = "\n"))
writeBin(paste(my_output, collapse = "\n"), "my_output_file2.txt")
produces this:
You can write the object minus the last line, then append it without a line ending.
write.table(my_df[1:(nrow(my_df)-1),], file = "my_output_file.txt",
sep = " ", col.names = F, row.names = F, quote = F, eol = "\n")
write.table(my_df[nrow(my_df),], file = "my_output_file.txt",
sep = " ", col.names = F, row.names = F, quote = F, eol = "", append=T)
Dear All R Developers,
I maintain a package GENEAread and have recently found a bug in the package which comes from within the function header.info. This function is designed to read in the header information stored in a GENEActiv binary file, from the Actigraphy watch GENEActiv. This information is stored in the first 100 lines of the binary file.
The part of this function that is reading in values incorrectly uses the function scan(). Until recently this has worked, however the frequency which is read in by the function header.info now takes a different form because of the varying output of scan() that now occurs.
Below is some sample code which demonstrates the issue:
install.packages(“GENEAread”)
library(GENEAread)
binfile = system.file("binfile/TESTfile.bin", package = "GENEAread")[1]
nobs = 300
info <- vector("list", 15)
# index <- c(2, 20:22, 26:29)
tmpd = readLines(binfile, 300)
#try to find index positions - so will accomodate multiple lines in the
notes sections
#change when new version of binfile is produced.
ind.subinfo = min(which((tmpd == "Subject Info" )& (1:length(tmpd) >= 37)))
ind.memstatus = max(which(tmpd == "Memory Status"))
ind.recdata = (which(tmpd == "Recorded Data"))
ind.recdata = ind.recdata[ind.recdata > ind.memstatus][1:2]
ind.calibdata = max(which(tmpd == "Calibration Data"))
ind.devid = min(which(tmpd == "Device Identity"))
ind.config = min(which(tmpd == "Configuration Info"))
ind.trial = min(which(tmpd == "Trial Info"))
index = c(ind.devid + 1, ind.recdata[1] + 8, ind.config + 2:3, ind.trial +
1:4, ind.subinfo + 1:7, ind.memstatus + 1)
if (max(index) == Inf){
stop("Corrupt headers or not Geneactiv file!", call = FALSE)
}
# Read in header info
nm <- NULL
for (i in 1:length(index)) {
line = strsplit(tmpd[index[i]], split = ":")[[1]]
el = ""
if (length(line) > 1){
el <- paste(line[2:length(line)],collapse=":")
}
info[[i]] <- el
nm[i] <- paste(strsplit(line[1], split = " ")[[1]], collapse = "_")
}
info <- as.data.frame(matrix(info), row.names = nm)
colnames(info) <- "Value"
Decimal_Separator = "."
if (length( grep(",", paste(tmpd[ind.memstatus + 8:9], collapse = "")) ) > 0){
Decimal_Separator = ","
}
info = rbind(info,
Decimal_Separator = Decimal_Separator)
# more here
# if (more){
# grab calibration data etc as well
calibration = list()
fc = file(binfile, "rt")
index = sort(c(ind.config + 4,
ind.calibdata + 1:8,
ind.memstatus + 1,
ind.recdata + 3,
ind.recdata[1] + c(2,8))
)
#### First appearance in the function header.info of the function scan. ####
# tmp <- substring(scan(fc,
# skip = index[1] - 1,
# what = "",
# n = 3,
# sep = " ",
# quiet = TRUE)[3],
# c(1,2,5),
# c(1, 3, 6))
# Isolating scan and running multiple times #
scan(fc,
skip = index[1] - 1,
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3]
scan(fc,
skip = index[1] - 1,
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3]
scan(fc,
skip = (index[1] - 1),
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3]
#### Checking the same thing happens with the substring ####
# Checking by using 3.4.3 possibly
substring(scan(fc,
skip = index[1] - 1,
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3],
c(1,2,5),
c(1, 3, 6))
substring(scan(fc,
skip = index[1] - 1,
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3],
c(1,2,5),
c(1, 3, 6))
substring(scan(fc,
skip = index[1] - 1,
what = "",
n = 3,
sep = " ",
quiet = TRUE)[3],
c(1,2,5),
c(1, 3, 6))
Why does the output of the scan function vary? I have run the examples given on the scan help page and the output is the same if the code is ran more than once. What in the build up to running this function can cause the output to vary?
Any help would be much appreciated.
You opened the fc connection using
fc = file(binfile, "rt")
This means scan() will read from it and leave it open, with the file pointer advanced to the end of the read. Each time you call scan(), you are reading a later part of the file. That's why the results vary.
If you want to always read the same part of the file, you would do it something like this:
seek(fc, 0)
scan(fc, ...)
seek(fc, 0)
scan(fc, ...)
Alternatively, don't open fc when you create it, and scan() will open and close it each time. You do this by writing
fc <- file(binfile) # No open specified
Or even more simply (but a tiny bit less efficiently)
fc <- binfile
which will create a new connection each time.
I used the bibliometrix function in R, and want to plot some useful graphs.
library(bibliometrix)
??bibliometrix
D<-readFiles("E:\\RE\\savedrecs.txt")
M <- convert2df(D,dbsource = "isi", format= "plaintext")
results <- biblioAnalysis(M ,sep = ";" )
S<- summary(object=results,k=10, pause=FALSE)
plot(x=results,k=10,pause=FALSE)
options(width=100)
S <- summary(object = results, k = 10, pause = FALSE)
NetMatrix <- biblioNetwork(M1, analysis = "co-occurrences", network = "author_keywords", sep = ";")
S <- normalizeSimilarity(NetMatrix, type = "association")
net <- networkPlot(S, n = 200, Title = "co-occurrence network",type="fruchterman", labelsize = 0.7, halo = FALSE, cluster = "walktrap",remove.isolates=FALSE, remove.multiple=FALSE, noloops=TRUE, weighted=TRUE)
res <- thematicMap(net, NetMatrix, S)
plot(res$map)
But in the net <- networkPlot(S, n = 200, Title = "co-occurrence network",type="fruchterman", labelsize = 0.7, halo = FALSE, cluster = "walktrap",remove.isolates=FALSE, remove.multiple=FALSE, noloops=TRUE, weighted=TRUE), it shows error
Error in V<-(*tmp*, value = *vtmp*) : invalid indexing
. Also I cannot do the CR, it always shows unlistCR. I cannot use the NetMatrix function neither.
Some help me plsssssssss
The problem is in the data itself not in the code you presented. When I downloaded the data from bibliometrix.com and changed M1 to M (typo?) in biblioNetwork function call everything worked perfectly. Please see the code below:
library(bibliometrix)
# Plot bibliometric analysis results
D <- readFiles("http://www.bibliometrix.org/datasets/savedrecs.txt")
M <- convert2df(D, dbsource = "isi", format= "plaintext")
results <- biblioAnalysis(M, sep = ";")
S <- summary(results)
plot(x = results, k = 10, pause = FALSE)
# Plot Bibliographic Network
options(width = 100)
S <- summary(object = results, k = 10, pause = FALSE)
NetMatrix <- biblioNetwork(M, analysis = "co-occurrences", network = "author_keywords", sep = ";")
S <- normalizeSimilarity(NetMatrix, type = "association")
net <- networkPlot(S, n = 200, Title = "co-occurrence network", type = "fruchterman",
labelsize = 0.7, halo = FALSE, cluster = "walktrap",
remove.isolates = FALSE, remove.multiple = FALSE, noloops = TRUE, weighted = TRUE)
# Plot Thematic Map
res <- thematicMap(net, NetMatrix, S)
str(M)
plot(res$map)
I am using the referenceIntervals package in R, to do some data analytics.
In particular I am using the refLimit function which calculates reference and confidence intervals. I want to edit it to remove certain functionality (for instance it runs a shapiro normalitiy test, which stops the entire code if the data larger than 5000, it wont allow you to parametrically test samples less than 120). To do this I have been typing refLimit into the terminal - copying the function definition, then saving it as a separate file (below is the full original definition of the function).
singleRefLimit =
function (data, dname = "default", out.method = "horn", out.rm = FALSE,
RI = "p", CI = "p", refConf = 0.95, limitConf = 0.9)
{
if (out.method == "dixon") {
output = dixon.outliers(data)
}
else if (out.method == "cook") {
output = cook.outliers(data)
}
else if (out.method == "vanderLoo") {
output = vanderLoo.outliers(data)
}
else {
output = horn.outliers(data)
}
if (out.rm == TRUE) {
data = output$subset
}
outliers = output$outliers
n = length(data)
mean = mean(data, na.rm = TRUE)
sd = sd(data, na.rm = TRUE)
norm = NULL
if (RI == "n") {
methodRI = "Reference Interval calculated nonparametrically"
data = sort(data)
holder = nonparRI(data, indices = 1:length(data), refConf)
lowerRefLimit = holder[1]
upperRefLimit = holder[2]
if (CI == "p") {
CI = "n"
}
}
if (RI == "r") {
methodRI = "Reference Interval calculated using Robust algorithm"
holder = robust(data, 1:length(data), refConf)
lowerRefLimit = holder[1]
upperRefLimit = holder[2]
CI = "boot"
}
if (RI == "p") {
methodRI = "Reference Interval calculated parametrically"
methodCI = "Confidence Intervals calculated parametrically"
refZ = qnorm(1 - ((1 - refConf)/2))
limitZ = qnorm(1 - ((1 - limitConf)/2))
lowerRefLimit = mean - refZ * sd
upperRefLimit = mean + refZ * sd
se = sqrt(((sd^2)/n) + (((refZ^2) * (sd^2))/(2 * n)))
lowerRefLowLimit = lowerRefLimit - limitZ * se
lowerRefUpperLimit = lowerRefLimit + limitZ * se
upperRefLowLimit = upperRefLimit - limitZ * se
upperRefUpperLimit = upperRefLimit + limitZ * se
shap_normalcy = shapiro.test(data)
shap_output = paste(c("Shapiro-Wilk: W = ", format(shap_normalcy$statistic,
digits = 6), ", p-value = ", format(shap_normalcy$p.value,
digits = 6)), collapse = "")
ks_normalcy = suppressWarnings(ks.test(data, "pnorm",
m = mean, sd = sd))
ks_output = paste(c("Kolmorgorov-Smirnov: D = ", format(ks_normalcy$statistic,
digits = 6), ", p-value = ", format(ks_normalcy$p.value,
digits = 6)), collapse = "")
if (shap_normalcy$p.value < 0.05 | ks_normalcy$p.value <
0.05) {
norm = list(shap_output, ks_output)
}
else {
norm = list(shap_output, ks_output)
}
}
if (CI == "n") {
if (n < 120) {
cat("\nSample size too small for non-parametric confidence intervals, \n \t\tbootstrapping instead\n")
CI = "boot"
}
else {
methodCI = "Confidence Intervals calculated nonparametrically"
ranks = nonparRanks[which(nonparRanks$SampleSize ==
n), ]
lowerRefLowLimit = data[ranks$Lower]
lowerRefUpperLimit = data[ranks$Upper]
upperRefLowLimit = data[(n + 1) - ranks$Upper]
upperRefUpperLimit = data[(n + 1) - ranks$Lower]
}
}
if (CI == "boot" & (RI == "n" | RI == "r")) {
methodCI = "Confidence Intervals calculated by bootstrapping, R = 5000"
if (RI == "n") {
bootresult = boot::boot(data = data, statistic = nonparRI,
refConf = refConf, R = 5000)
}
if (RI == "r") {
bootresult = boot::boot(data = data, statistic = robust,
refConf = refConf, R = 5000)
}
bootresultlower = boot::boot.ci(bootresult, conf = limitConf,
type = "basic", index = 1)
bootresultupper = boot::boot.ci(bootresult, conf = limitConf,
type = "basic", index = 2)
lowerRefLowLimit = bootresultlower$basic[4]
lowerRefUpperLimit = bootresultlower$basic[5]
upperRefLowLimit = bootresultupper$basic[4]
upperRefUpperLimit = bootresultupper$basic[5]
}
RVAL = list(size = n, dname = dname, out.method = out.method,
out.rm = out.rm, outliers = outliers, methodRI = methodRI,
methodCI = methodCI, norm = norm, refConf = refConf,
limitConf = limitConf, Ref_Int = c(lowerRefLimit = lowerRefLimit,
upperRefLimit = upperRefLimit), Conf_Int = c(lowerRefLowLimit = lowerRefLowLimit,
lowerRefUpperLimit = lowerRefUpperLimit, upperRefLowLimit = upperRefLowLimit,
upperRefUpperLimit = upperRefUpperLimit))
class(RVAL) = "interval"
return(RVAL)
}
However when I then execute this file a large number of terms end up being undefined, for instance when I use the function I get 'object 'nonparRanks' not found'.
How do I edit the function in the package? I have looked at trying to important the package namespace and environment but this has not helped. I have also tried to find the actual function in the package files in my directory, but not been able to.
I am reasonably experienced in R, but I have never had to edit a package before. I am clearly missing something about how functions are defined in packages, but I am not sure what.
In the beginning of the package there is a line
data(sysdata, envir=environment())
See here: https://github.com/cran/referenceIntervals/tree/master/data/sysdata.rda
I suspect that "nonparRanks" is defined there as I don't see it defined anywhere else. So perhaps you could download that file, write your own function, then run that same line before running your function and it may work.
EDIT:
Download the file then run:
load("C:/sysdata.rda")
With your path to the file and then your function will work.
nonparRanks is a function in the referenceIntervals package:
Table that dictate the ranks for the confidence intervals
around thecalculated reference interval
Your method of saving and editing the function is fine, but make sure you load all the necessary underlying functions to run it too.
The easiest thing to do might be to:
save your copied and pasted R function as a different name, e.g. singleRefLimit2, then
call library("referenceIntervals"), which will load all the underlying functions you need and then
load your function source("singelRefLimit2.R"), with whatever edits you choose to make.