Wrong result when rotating a local point - rotational-matrices

I have got a rotation matrix set up and it seems to work well, but I am having a problem getting the correct end result when I rotate a local point around a rotation point. My code:
glm::mat4 clsBone::Rotate( float a_Pitch, float a_Yaw, float a_Roll )
{
glm::mat4 l_M = m_MatrixHandler->GetRotationMatrix( );
OutputDebugStringA( ( "Old Rotation Matrix: \n" +
std::to_string( l_M[ 0 ][ 0 ] ) + ", " + std::to_string( l_M[ 0 ][ 1 ] ) + ", " + std::to_string( l_M[ 0 ][ 2 ] ) + ", " + std::to_string( l_M[ 0 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 1 ][ 0 ] ) + ", " + std::to_string( l_M[ 1 ][ 1 ] ) + ", " + std::to_string( l_M[ 1 ][ 2 ] ) + ", " + std::to_string( l_M[ 1 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 2 ][ 0 ] ) + ", " + std::to_string( l_M[ 2 ][ 1 ] ) + ", " + std::to_string( l_M[ 2 ][ 2 ] ) + ", " + std::to_string( l_M[ 2 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 3 ][ 0 ] ) + ", " + std::to_string( l_M[ 3 ][ 1 ] ) + ", " + std::to_string( l_M[ 3 ][ 2 ] ) + ", " + std::to_string( l_M[ 3 ][ 3 ] ) + "\n" ).c_str( ) );
glm::mat4 l_RotMatrix = m_MatrixHandler->Rotate( a_Pitch, a_Yaw, a_Roll );
l_M = l_RotMatrix;
OutputDebugStringA( ( "New Rotation Matrix: \n" +
std::to_string( l_M[ 0 ][ 0 ] ) + ", " + std::to_string( l_M[ 0 ][ 1 ] ) + ", " + std::to_string( l_M[ 0 ][ 2 ] ) + ", " + std::to_string( l_M[ 0 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 1 ][ 0 ] ) + ", " + std::to_string( l_M[ 1 ][ 1 ] ) + ", " + std::to_string( l_M[ 1 ][ 2 ] ) + ", " + std::to_string( l_M[ 1 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 2 ][ 0 ] ) + ", " + std::to_string( l_M[ 2 ][ 1 ] ) + ", " + std::to_string( l_M[ 2 ][ 2 ] ) + ", " + std::to_string( l_M[ 2 ][ 3 ] ) + "\n" +
std::to_string( l_M[ 3 ][ 0 ] ) + ", " + std::to_string( l_M[ 3 ][ 1 ] ) + ", " + std::to_string( l_M[ 3 ][ 2 ] ) + ", " + std::to_string( l_M[ 3 ][ 3 ] ) + "\n" ).c_str( ) );
glm::vec4 l_LocalPos = glm::vec4( m_EndJoint->m_Position - m_StartJoint->m_Position, 1 );
OutputDebugStringA( ( "Old Local Pos: " + std::to_string( l_LocalPos.x ) + ", " + std::to_string( l_LocalPos.y ) + ", " + std::to_string( l_LocalPos.z ) + "\n" ).c_str( ) );
glm::vec4 l_NewLocalPos = l_LocalPos * l_RotMatrix;
OutputDebugStringA( ( "New Local Pos: " + std::to_string( l_NewLocalPos.x ) + ", " + std::to_string( l_NewLocalPos.y ) + ", " + std::to_string( l_NewLocalPos.z ) + "\n" ).c_str( ) );
return l_RotMatrix;
}
glm::mat4 clsMatrixHandler::Rotate( float a_Pitch, float a_Yaw, float a_Roll )
{
glm::mat4 l_Rotx;
glm::mat4 l_Roty;
glm::mat4 l_Rotz;
PitchYawRollToXYZMatrices( a_Pitch, a_Yaw, a_Roll, l_Rotx, l_Roty, l_Rotz );
m_PitchYawRolls.push_back( glm::vec3( a_Pitch, a_Yaw, a_Roll ) );
glm::mat4 l_RotationMatrix = l_Rotx * l_Roty * l_Rotz;
m_RotationMatrix *= l_RotationMatrix;
m_TransformMatrix = m_RotationMatrix * m_TranslationMatrix;
return m_RotationMatrix;
}
Result:
Old Rotation Matrix:
1.000000, 0.000000, 0.000000, 0.000000
0.000000, -0.000000, 1.000000, 0.000000
0.000000, -1.000000, -0.000000, 0.000000
0.000000, 0.000000, 0.000000, 1.000000
New Rotation Matrix:
0.707107, 0.707107, 0.000000, 0.000000
0.000000, -0.000000, 1.000000, 0.000000
0.707107, -0.707107, -0.000000, 0.000000
0.000000, 0.000000, 0.000000, 1.000000
Old Local Pos: 0.000000, -40.000000, -0.000002
New Local Pos: -28.284271, 0.000000, 28.284271
How is it possible that the new local position rotated 90 degrees into a diagonal direction while the rotation matrix rotated 45 degrees in its local y axis (world z axis)?

So it seems I made a mistake here. I am multiplying the local position with the rotation matrix, but I should have multiplied the other way around:
glm::vec4 l_NewLocalPos = l_RotMatrix * l_LocalPos;
This will output:
Old Rotation Matrix:
1.000000, 0.000000, 0.000000, 0.000000
0.000000, -0.000000, 1.000000, 0.000000
0.000000, -1.000000, -0.000000, 0.000000
0.000000, 0.000000, 0.000000, 1.000000
New Rotation Matrix:
0.707107, 0.707107, 0.000000, 0.000000
0.000000, -0.000000, 1.000000, 0.000000
0.707107, -0.707107, -0.000000, 0.000000
0.000000, 0.000000, 0.000000, 1.000000
Old Local Pos: 0.000000, -40.000000, -0.000002
New Local Pos: 0.000000, 0.000000, -40.000000
Which makes sense:
From the identity rotation matrix, I am first pitching down, which moves the local point from (0, -40, 0) to (0, 0, -40), then I yaw 45 degrees, but since the local point is on the yaw rotation axis (local y axis, world z axis), the point will not move.

Related

where is the missing column when Converting a matrix/array to a data table in R?

I get a matrix/array from an output. My goal is to convert it to a data table and make it print friendly. However, one key column was gone when doing the conversion..
dput(tab)
structure(c(" 1950", " ", " 207 (10.6) ", " 288 (14.8) ",
" 1455 (74.6) ", " ", " 95 ( 4.9) ", " 0 ( 0.0) ",
" 1823 (93.5) ", " 0 ( 0.0) ", " 32 ( 1.6) ", "4721.83 (1322.96)",
" 553", " ", " 27 ( 4.9) ", " 99 (17.9) ", " 427 (77.2) ",
" ", " 68 (12.3) ", " 0 ( 0.0) ", " 455 (82.3) ",
" 0 ( 0.0) ", " 30 ( 5.4) ", "4698.88 (1356.03)", " 813",
" ", " 96 (11.8) ", " 64 ( 7.9) ", " 653 (80.3) ",
" ", " 8 ( 1.0) ", " 0 ( 0.0) ", " 804 (98.9) ",
" 0 ( 0.0) ", " 1 ( 0.1) ", "4957.45 (1259.53)", " 1243",
" ", " 166 (13.4) ", " 191 (15.4) ", " 886 (71.3) ",
" ", " 129 (10.4) ", " 0 ( 0.0) ", " 1098 (88.3) ",
" 0 ( 0.0) ", " 16 ( 1.3) ", "4861.85 (1221.35)", "",
"<0.001", "", "", "", " NaN", "", "", "", "", "", "<0.001",
"", "", "", "", "", "", "", "", "", "", "", ""), .Dim = c(12L,
6L), .Dimnames = list(c("n", "Race (%)", " Black", " Other race",
" White", "Ethnicity (%)", " Hispanic", " No info", " Non-hispnaic",
" Refused", " Unknown", "dx_age (mean (SD))"), `Stratified by site` = c("Phila",
"colorado", "nation", "Dup", "p", "test")))
When I converted tab to tap, the Dimnames in tab was gone.
tap <- as.data.table(tab)
dput(tap)
structure(list(Phila = c(" 1950", " ", " 207 (10.6) ",
" 288 (14.8) ", " 1455 (74.6) ", " ", " 95 ( 4.9) ",
" 0 ( 0.0) ", " 1823 (93.5) ", " 0 ( 0.0) ", " 32 ( 1.6) ",
"4721.83 (1322.96)"), colorado = c(" 553", " ", " 27 ( 4.9) ",
" 99 (17.9) ", " 427 (77.2) ", " ", " 68 (12.3) ",
" 0 ( 0.0) ", " 455 (82.3) ", " 0 ( 0.0) ", " 30 ( 5.4) ",
"4698.88 (1356.03)"), nation = c(" 813", " ", " 96 (11.8) ",
" 64 ( 7.9) ", " 653 (80.3) ", " ", " 8 ( 1.0) ",
" 0 ( 0.0) ", " 804 (98.9) ", " 0 ( 0.0) ", " 1 ( 0.1) ",
"4957.45 (1259.53)"), Dup = c(" 1243", " ", " 166 (13.4) ",
" 191 (15.4) ", " 886 (71.3) ", " ", " 129 (10.4) ",
" 0 ( 0.0) ", " 1098 (88.3) ", " 0 ( 0.0) ", " 16 ( 1.3) ",
"4861.85 (1221.35)"), p = c("", "<0.001", "", "", "", " NaN",
"", "", "", "", "", "<0.001"), test = c("", "", "", "", "", "",
"", "", "", "", "", "")), row.names = c(NA, -12L), class = c("data.table",
"data.frame"), .internal.selfref = <pointer: 0x0000000002621ef0>)
Did I do something wrong? or is there a better way to do the conversion, if not, how can I add this information back? Thanks a lot!
p.s
I also try change rownames of tap from data.frame but print out show X, X.1...which is an unintended results.
Thanks to everyone's tips, seems like there are no simple solution for this. My work around is to save rownames as permanent column and use regular expression to remove those lines starting with X within the column. Hope this will help those who came across similar issue.

Dynamic (auto increment) input length (count) on a linear regression channel drawing, starting from given bar_index/datetime in Pine Script language

My question is about the Linear Regression drawing.
The example in the documentation uses a fixed length (100), and is therefore :
shifting to the right on each new bar
of constant width (here 100 bars)
I'm trying to make it start from a custom point in time (x bars from now or bar_index or datetime...), so that :
it keeps extending on each new bar
but the starting point remains on the same location (until we change it in the settings).
That means that the length (input) would be dynamic and increase on each new bar.
I am getting the following error : Pine cannot determine the referencing length of a series. Try using max_bars_back in the study or strategy function.
Is it possible to do ?
Here is the code
//#version=4
study("Linear Regression", shorttitle="LinReg", overlay=true)
upperMult = input(title="Upper Deviation", defval=2)
lowerMult = input(title="Lower Deviation", defval=-2)
useUpperDev = input(title="Use Upper Deviation", defval=true)
useLowerDev = input(title="Use Lower Deviation", defval=true)
showPearson = input(title="Show Pearson's R", defval=true)
extendLines = input(title="Extend Lines", defval=false)
// ====================================================================
// ====================================================================
// Original parameter (the one that should increments)
// len = input(title="Count", defval=100)
// Unsuccessful attempt : "Starting from given bar_index"
barIndexOfStartingBar = 6392 - 80 // 6392 : Current bar_index, 80 : Offset to the starting bar
len = bar_index - barIndexOfStartingBar
len := nz(len[1]) + 1
// Unsuccessful attempt : "x bars from current bar"
startingPointFromCurrentBar = input(title="Count", defval=80)
len = (bar_index + startingPointFromCurrentBar) - bar_index
len := nz(len[1]) + 1
// ====================================================================
// ====================================================================
src = input(title="Source", defval=close)
extend = extendLines ? extend.right : extend.none
calcSlope(src, len) =>
if not barstate.islast or len <= 1
[float(na), float(na), float(na)]
else
sumX = 0.0
sumY = 0.0
sumXSqr = 0.0
sumXY = 0.0
for i = 0 to len - 1
val = src[i]
per = i + 1.0
sumX := sumX + per
sumY := sumY + val
sumXSqr := sumXSqr + per * per
sumXY := sumXY + val * per
slope = (len * sumXY - sumX * sumY) / (len * sumXSqr - sumX * sumX)
average = sumY / len
intercept = average - slope * sumX / len + slope
[slope, average, intercept]
[s, a, i] = calcSlope(src, len)
startPrice = i + s * (len - 1)
endPrice = i
var line baseLine = na
if na(baseLine) and not na(startPrice)
baseLine := line.new(bar_index - len + 1, startPrice, bar_index, endPrice, width=1, extend=extend, color=color.red)
else
line.set_xy1(baseLine, bar_index - len + 1, startPrice)
line.set_xy2(baseLine, bar_index, endPrice)
na
calcDev(src, len, slope, average, intercept) =>
upDev = 0.0
dnDev = 0.0
stdDevAcc = 0.0
dsxx = 0.0
dsyy = 0.0
dsxy = 0.0
periods = len - 1
daY = intercept + (slope * periods) / 2
val = intercept
for i = 0 to periods
price = high[i] - val
if (price > upDev)
upDev := price
price := val - low[i]
if (price > dnDev)
dnDev := price
price := src[i]
dxt = price - average
dyt = val - daY
price := price - val
stdDevAcc := stdDevAcc + price * price
dsxx := dsxx + dxt * dxt
dsyy := dsyy + dyt * dyt
dsxy := dsxy + dxt * dyt
val := val + slope
stdDev = sqrt(stdDevAcc / (periods == 0 ? 1 : periods))
pearsonR = dsxx == 0 or dsyy == 0 ? 0 : dsxy / sqrt(dsxx * dsyy)
[stdDev, pearsonR, upDev, dnDev]
[stdDev, pearsonR, upDev, dnDev] = calcDev(src, len, s, a, i)
upperStartPrice = startPrice + (useUpperDev ? upperMult * stdDev : upDev)
upperEndPrice = endPrice + (useUpperDev ? upperMult * stdDev : upDev)
var line upper = na
lowerStartPrice = startPrice + (useLowerDev ? lowerMult * stdDev : -dnDev)
lowerEndPrice = endPrice + (useLowerDev ? lowerMult * stdDev : -dnDev)
var line lower = na
if na(upper) and not na(upperStartPrice)
upper := line.new(bar_index - len + 1, upperStartPrice, bar_index, upperEndPrice, width=1, extend=extend, color=#0000ff)
else
line.set_xy1(upper, bar_index - len + 1, upperStartPrice)
line.set_xy2(upper, bar_index, upperEndPrice)
na
if na(lower) and not na(lowerStartPrice)
lower := line.new(bar_index - len + 1, lowerStartPrice, bar_index, lowerEndPrice, width=1, extend=extend, color=#0000ff)
else
line.set_xy1(lower, bar_index - len + 1, lowerStartPrice)
line.set_xy2(lower, bar_index, lowerEndPrice)
na
// Pearson's R
var label r = na
transparent = color.new(color.white, 100)
label.delete(r[1])
if showPearson and not na(pearsonR)
r := label.new(bar_index - len + 1, lowerStartPrice, tostring(pearsonR, "#.################"), color=transparent, textcolor=#0000ff, size=size.normal, style=label.style_labelup)
With these changes you should be able to go back a few thousand bars:
study("Linear Regression", shorttitle="LinReg", overlay=true, max_bars_back = 4999)
and either one of these:
// #1
offsetToStart = input(100, minval = 1, step = 100)
len = max(1, offsetToStart)
// #2
startingBar = input(10000, minval = 1, step = 100)
len = max(1, bar_index - startingBar)
What you are looking for is called anchoring. You can do this with a trick. What I usually do is the following:
p = input("D", title="Period", type=input.resolution)
offsetToStart = input(0, title="Begin Offset") // remove the minval
newbar(p) => change(time(p)) == 0?0:1
nb = newbar(p)
bars = barssince(nb) + offsetToStart
var line l1 = na
l1 := line.new(bar_index[bars], open, bar_index[bars], open + syminfo.mintick, extend=extend.both)
line.delete(l1[1])
Remember to remove the minval. Chose the period and you can now anchor beginning of your indicator. Playaround with p

Color cells depending of their value for each row of a data frame

I have a data frame which looks like this:
header1 header2 header3 header4 ...
rowname1 1 2 3 4
rowname2 4 3 2 1
rowname3 2 4 1 3
rowname4 1 4 3 2
...
I would like to make a color gradient depending of the values for each row. Typically I would like the maximum value of each row to be colored green, the minimum value of each row colored red, and the other cells to be colored gradually depending of their value (second worst would be orange, second best would be yellow, etc ...).
An example of what I would like to obtain:
Could you please help me in solving this matter ?
Here is a possibility with DT.
dat <- data.frame(
V1 = rpois(6,5),
V2 = rpois(6,5),
V3 = rpois(6,5),
V4 = rpois(6,5),
V5 = rpois(6,5),
V6 = rpois(6,5)
)
library(DT)
js <- c(
"function(row, data, num, index){",
" data.shift();", # remove row name
" var min = Math.min.apply(null, data);",
" var max = Math.max.apply(null, data);",
" for(var i=0; i<data.length; i++){",
" var f = (data[i] - min)/(max-min);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+(i+1)+')', row).css('background-color', color);",
" }",
"}"
)
datatable(dat, options = list(rowCallback = JS(js)))
To add black borders, do
datatable(dat, options = list(rowCallback = JS(js))) %>%
formatStyle(1:(ncol(dat)-1), `border-right` = "solid 1px")
The above solution assumes that you display the row names in the table. If you don't want to display the row names, do:
js <- c(
"function(row, data, num, index){",
" var min = Math.min.apply(null, data);",
" var max = Math.max.apply(null, data);",
" for(var i=0; i<data.length; i++){",
" var f = (data[i] - min)/(max-min);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+i+')', row).css('background-color', color);",
" }",
"}"
)
datatable(dat, rownames = FALSE, options = list(rowCallback = JS(js)))
Edit
As requested by the OP in the chat, here is a variant. Instead of generating a color proportional to the cell value, it generates a color proportional to the rank of the cell value.
js <- c(
"function(row, data, num, index){",
" data.shift();", # remove row name
" var data_uniq = data.filter(function(item, index) {",
" if(data.indexOf(item) == index){",
" return item;",
" }}).sort(function(a,b){return a-b});",
" var n = data_uniq.length;",
" var ranks = data.slice().map(function(v){ return data_uniq.indexOf(v) });",
" for(var i=0; i<data.length; i++){",
" var f = ranks[i]/(n-1);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+(i+1)+')', row).css('background-color', color);",
" }",
"}"
)
dat <- as.data.frame(matrix(round(rnorm(24),2), ncol=8))
datatable(dat, options = list(rowCallback = JS(js)))
I've found that the colors are more distinct by replacing var h = 120*f; with
var h = 60*(1 + Math.tan(2*f-1)/Math.tan(1));

missing value where TRUE/FALSE needed in Markov-Chain

I have been trying to use Markov Chain to improve my model and get trouble when computing transition matrix. It appears missing values. Someone know why my code is wrong? Many thanks
I already defined all the variables to be 0 at first.
mresiduals is residuals of my model. len is the length of vector(residuals).
Error message is:
Error in if (mresiduals[ele + 1] < lim5) { :
missing value where TRUE/FALSE needed
for (ele in 1:len) {
if (mresiduals[ele] < lim5)
{
p1 = p1 + 1
if (mresiduals[ele + 1] < lim5)
{
p1I = p1I + 1
} else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4)
{
p1II = p1II + 1
} else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3)
{
p1III = p1III + 1
} else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2)
{
p1IV = p1IV + 1
} else{
p1V = p1V + 1
}
} else if (ele > lim5 & ele < lim4)
{
p2 = p2 + 1
if (mresiduals[ele + 1] < lim5)
{
p2I = p2I + 1
} else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4)
{
p2II = p2II + 1
} else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3)
{
p2III = p2III + 1
} else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2)
{
p2IV = p2IV + 1
} else {
p2V = p2V + 1
}
} else if (ele > lim4 & ele < lim3)
{
p3 = p3 + 1
if (mresiduals[ele + 1] < lim5)
{
p3I = p3I + 1
} else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4)
{
p3II = p3II + 1
} else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3)
{
p3III = p3III + 1
} else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2)
{
p3IV = p3IV + 1
} else{
p3V = p3V + 1
}
} else if (ele > lim4 & ele < lim3)
{
p4 = p4 + 1
if (mresiduals[ele + 1] < lim5)
{
p4I = p4I + 1
} else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4)
{
p4II = p4II + 1
} else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3)
{
p4III = p4III + 1
} else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2)
{
p4IV = p4IV + 1
} else{
p4V = p4V + 1
}
} else{
p5 = p5 + 1
if (mresiduals[ele + 1] < lim5)
{
p5I = p5I + 1
} else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4)
{
p5II = p5II + 1
} else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3)
{
p5III = p5III + 1
} else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2)
{
p5IV = p5IV + 1
} else{
p5V = p5V + 1
}
}
}
When R finds NA during its execution and try to compare that with some other element results in this error. In current case mresiduals is of length len so in line 5 mresiduals[ele + 1] when ele loop reaches len; ele+1 becomes len+1 outside the boundary of mresiduals and hence the error.

Automatic vlookup and multiply coefficients with R

I´m trying to code a function in R (stats programming language) that would allow me to automate the calculation of a linear regression (lm)
The problem:
The regression is calculated through the "step" function, so the coefficients selected cannot be known in advance.
Problem
Automate identifying the coefficients selected by the step function.
Vlookup and cross multiply the second column of the results Ex."View(OpenCoefs)" (estimates) with the last row(last day) of respective columns of the original data frame "sp"
The desirable solution would be a function that i would just type "run()" that would return the "y"s for each regression, namely, the forecast of the S&P500 index for the following day(Open, Low, High,Close).
The code retrieves data from the yahoo finance website, so it´s operational if you run it.
Here´s the code.
sp <- read.csv(paste("http://ichart.finance.yahoo.com/table.csv?s=%5EGSPC&a=03&b=1&c=1940&d=03&e=1&f=2014&g=d&ignore=.csv"))
sp$Adj.Close<-NULL
sp<-sp[nrow(sp):1,]
sp<-as.data.frame(sp)
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Open" ] <-
( sp[ i , "Open" ] / sp[ i - 1 , "Open" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_High" ] <-
( sp[ i , "High" ] / sp[ i - 1 , "High" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Low" ] <-
( sp[ i , "Low" ] / sp[ i - 1 , "Low" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Close" ] <-
( sp[ i , "Close" ] / sp[ i - 1 , "Close" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Volume" ] <-
( sp[ i , "Volume" ] / sp[ i - 1 , "Volume" ] ) - 1
}
nRows_in_sp<-1:nrow(sp)
sp<-cbind(sp,nRows_in_sp)
Open_Rollin<-NA
sp<-cbind(sp,Open_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Open_Rollin" ]<-0
} else {
sp[ i , "Open_Rollin" ]<-(( mean(sp[,"Open"][(i-100):i])))
}
}
Close_Rollin<-NA
nRows_in_sp<-1:nrow(sp)
sp<-cbind(sp,Close_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , " Close_Rollin" ]<-0
} else {
sp[ i , "Close_Rollin" ]<-(( mean(sp[,"Close"][(i-100):i])))
}
}
Low_Rollin<-NA
sp<-cbind(sp,Low_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Low_Rollin" ]<-0
} else {
sp[ i , "Low_Rollin" ]<-(( mean(sp[,"Low"][(i-100):i])))
}
}
High_Rollin<-NA
sp<-cbind(sp,High_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "High_Rollin" ]<-0
} else {
sp[ i , "High_Rollin" ]<-(( mean(sp[,"High"][(i-100):i])))
}
}
Open_GR_Rollin<-NA
sp<-cbind(sp,Open_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Open_GR_Rollin" ]<-0
} else {
sp[ i , "Open_GR_Rollin" ]<-(( mean(sp[,"Gr_Open"][(i-100):i])))
}
}
Close_GR_Rollin<-NA
sp<-cbind(sp, Close_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Close_GR_Rollin" ]<-0
} else {
sp[ i , "Close_GR_Rollin" ]<-(( mean(sp[,"Gr_Close"][(i-100):i])))
}
}
Low_GR_Rollin<-NA
sp<-cbind(sp, Low_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Low_GR_Rollin" ]<-0
} else {
sp[ i , "Low_GR_Rollin" ]<-(( mean(sp[,"Gr_Low"][(i-100):i])))
}
}
High_GR_Rollin<-NA
sp<-cbind(sp, High_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "High_GR_Rollin" ]<-0
} else {
sp[ i , "High_GR_Rollin" ]<-(( mean(sp[,"Gr_High"][(i-100):i])))
}
}
Open_SD_Rollin<-NA
sp<-cbind(sp,Open_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Open_SD_Rollin" ] <- sd(sp[,"Open"][(i-100):i])
}
}
Close_SD_Rollin<-NA
sp<-cbind(sp, Close_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Close_SD_Rollin" ] <- sd(sp[,"Close"][(i-100):i])
}
}
Low_SD_Rollin<-NA
sp<-cbind(sp, Low_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Low_SD_Rollin" ] <- sd(sp[,"Low"][(i-100):i])
}
}
High_SD_Rollin<-NA
sp<-cbind(sp, High_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "High_SD_Rollin" ] <- sd(sp[,"High"][(i-100):i])
}
}
N <- length(sp[,"Open"])
Openlag <- c(NA, sp[,"Open"][1:(N-1)])
sp<-cbind(sp,Openlag)
Highlag <- c(NA, sp[,"High"][1:(N-1)])
sp<-cbind(sp,Highlag)
Lowlag <- c(NA, sp[,"Low"][1:(N-1)])
sp<-cbind(sp,Lowlag)
Closelag <- c(NA, sp[,"Close"][1:(N-1)])
sp<-cbind(sp,Closelag)
Gr_Openlag <- c(NA, sp[,"Gr_Open"][1:(N-1)])
sp<-cbind(sp,Gr_Openlag)
Gr_Highlag <- c(NA, sp[,"Gr_High"][1:(N-1)])
sp<-cbind(sp,Gr_Highlag)
Gr_Lowlag <- c(NA, sp[,"Gr_Low"][1:(N-1)])
sp<-cbind(sp,Gr_Lowlag)
Gr_Closelag <- c(NA, sp[,"Gr_Close"][1:(N-1)])
sp<-cbind(sp,Gr_Closelag)
Gr_Volumelag <- c(NA, sp[,"Gr_Volume"][1:(N-1)])
sp<-cbind(sp,Gr_Volumelag)
Open_GR_Rollinlag <- c(NA, sp[,"Open_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Open_GR_Rollinlag)
Low_GR_Rollinlag <- c(NA, sp[,"Low_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Low_GR_Rollinlag)
High_GR_Rollinlag <- c(NA, sp[,"High_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, High_GR_Rollinlag)
Close_GR_Rollinlag <- c(NA, sp[,"Close_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Close_GR_Rollinlag)
Open_SD_Rollinlag <- c(NA, sp[,"Open_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Open_SD_Rollinlag)
Low_SD_Rollinlag <- c(NA, sp[,"Low_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Low_SD_Rollinlag)
High_SD_Rollinlag <- c(NA, sp[,"High_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, High_SD_Rollinlag)
Close_SD_Rollinlag <- c(NA, sp[,"Close_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Close_SD_Rollinlag)
OpenCoefs<-coefficients(summary(step(lm(sp[,"Open"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
LowCoefs<-coefficients(summary(step(lm(sp[,"Low"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
HighCoefs<-coefficients(summary(step(lm(sp[,"High"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
CloseCoefs<-coefficients(summary(step(lm(sp[,"Close"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
View(OpenCoefs)
View(LowCoefs)
View(HighCoefs)
View(CloseCoefs)
View(sp)
Your code is so bad, I had to take pity on you. :) Here's a refactored version of your code:
library(quantmod)
sp <- getSymbols("^GSPC", auto.assign=FALSE)
sp$GSPC.Adjusted <- NULL
colnames(sp) <- gsub("^GSPC\\.","",colnames(sp))
sp$Gr_Open <- ROC(Op(sp), type="discrete")
sp$Gr_High <- ROC(Hi(sp), type="discrete")
sp$Gr_Low <- ROC(Lo(sp), type="discrete")
sp$Gr_Close <- ROC(Cl(sp), type="discrete")
sp$Gr_Volume <- ROC(Vo(sp), type="discrete")
N <- 100
sp$Open_Rollin <- runMean(sp$Open, N)
sp$High_Rollin <- runMean(sp$High, N)
sp$Low_Rollin <- runMean(sp$Low, N)
sp$Close_Rollin <- runMean(sp$Close, N)
sp$Open_GR_Rollin <- runMean(sp$Gr_Open, N)
sp$High_GR_Rollin <- runMean(sp$Gr_High, N)
sp$Low_GR_Rollin <- runMean(sp$Gr_Low, N)
sp$Close_GR_Rollin <- runMean(sp$Gr_Close, N)
sp$Open_SD_Rollin <- runSD(sp$Open, N)
sp$High_SD_Rollin <- runSD(sp$High, N)
sp$Low_SD_Rollin <- runSD(sp$Low, N)
sp$Close_SD_Rollin <- runSD(sp$Close, N)
spLag <- lag(sp)
colnames(spLag) <- paste(colnames(sp),"lag",sep="")
sp <- na.omit(merge(sp, spLag))
There's no need to answer your first question in order to answer your second question. You don't have to cross-multiply coefficients with data by hand. You can simply access the fitted values from the model. That requires that you preserve the model though...
f <- Open ~ Openlag + Lowlag + Highlag + Closelag +
Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag +
Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag +
Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag
OpenLM <- lm(f, data=sp)
HighLM <- update(OpenLM, High ~ .)
LowLM <- update(OpenLM, Low ~ .)
CloseLM <- update(OpenLM, Close ~ .)
OpenStep <- step(OpenLM,direction="both",test="F")
HighStep <- step(HighLM,direction="both",test="F")
LowStep <- step(LowLM,direction="both",test="F")
CloseStep <- step(CloseLM,direction="both",test="F")
tail(fitted(OpenStep),1)
# 2013-02-01
# 1497.91
tail(fitted(HighStep),1)
# 2013-02-01
# 1504.02
tail(fitted(LowStep),1)
# 2013-02-01
# 1491.934
tail(fitted(CloseStep),1)
# 2013-02-01
# 1499.851

Resources