Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
packages
onlineforecast
Commits
2f982f4a
Commit
2f982f4a
authored
Jul 02, 2021
by
pbac
Browse files
multiplier issue fixed
parent
d51c07a0
Changes
4
Hide whitespace changes
Inline
Side-by-side
R/depth.R
0 → 100644
View file @
2f982f4a
#' Depth of a list
#'
#' Returns the depth of a list
#' @title Depth of a list
#' @param this list
#' @return integer
depth
<-
function
(
this
)
ifelse
(
is.list
(
this
),
1L
+
max
(
sapply
(
this
,
depth
)),
0L
)
R/flattenlist.R
0 → 100644
View file @
2f982f4a
#' Flattens list in a single list of data.frames
#'
#' Flattens list. Can maybe be made better. It might end up copying data in
#' memory!? It might change the order of the elements.
#' @title Flattens list
#' @param x List to flatten.
#' @return A flatten list
flattenlist
<-
function
(
x
){
(
n
<-
depth
(
x
))
if
(
n
==
2
){
# Its fine
return
(
x
)
}
else
if
(
n
==
3
){
unlist
(
x
,
recursive
=
FALSE
)
}
else
{
morelists
<-
sapply
(
x
,
function
(
xprime
)
class
(
xprime
)[
1
]
==
"list"
)
out
<-
c
(
x
[
!
morelists
],
unlist
(
x
[
morelists
],
recursive
=
FALSE
))
if
(
sum
(
morelists
)){
Recall
(
out
)
}
else
{
return
(
out
)
}
}
}
R/forecastmodel.R
View file @
2f982f4a
...
...
@@ -212,11 +212,11 @@ forecastmodel <- R6::R6Class("forecastmodel", public = list(
if
(
class
(
L
)[
1
]
==
"data.frame"
){
return
(
list
(
L
))
}
if
(
class
(
L
)[
1
]
!=
"list"
){
stop
(
pst
(
"The value returned from evaluating: "
,
input
$
expr
,
", was not a matrix, data.frame or a list of them."
))}
if
(
class
(
L
[[
1
]])[
1
]
==
"matrix"
){
return
(
lapply
(
L
,
function
(
mat
){
return
(
as.data.frame
(
mat
))
}))
}
return
(
L
)
return
(
flattenlist
(
L
)
)
})
#
Put together in one
data.list
L
<-
structure
(
do.call
(
c
,
L
),
class
=
"data.
list
"
)
#
#
Make it a data.list with no subsubelements (it's maybe not a data.list, since it miss "t", however to take subsets etc., it must be a
data.list
)
L
<-
flatten
list
(
L
)
class
(
L
)
<-
"data.list"
return
(
L
)
},
#----------------------------------------------------------------
...
...
R/operator_multiply.R
View file @
2f982f4a
...
...
@@ -49,35 +49,39 @@
#' @export
"%**%"
<-
function
(
x
,
y
)
{
if
(
is.null
(
dim
(
y
))
){
## y is not matrix like
lapply
(
x
,
function
(
xx
)
{
xx
*
y
})
# If any of them is a list: do recursive calls
if
(
class
(
x
)[
1
]
==
"list"
){
return
(
flattenlist
(
lapply
(
x
,
"%**%"
,
y
=
y
)))
}
else
if
(
class
(
y
)[
1
]
==
"list"
){
return
(
flattenlist
(
lapply
(
y
,
"%**%"
,
y
=
x
)))
}
# Do the multiplication
# If either is just a vector
if
(
is.null
(
dim
(
x
))
|
is.null
(
dim
(
y
))){
return
(
x
*
y
)
}
else
{
## y is matrix like
lapply
(
x
,
function
(
xx
)
{
## Check if different horizon k columns
colmatch
<-
TRUE
if
(
ncol
(
xx
)
!=
ncol
(
y
))
{
colmatch
<-
FALSE
}
else
if
(
any
(
nams
(
xx
)
!=
nams
(
y
))){
colmatch
<-
FALSE
}
if
(
!
colmatch
){
## Not same columns, take only the k in both
nms
<-
nams
(
xx
)[
nams
(
xx
)
%in%
nams
(
y
)]
xx
<-
xx
[,
nms
]
y
<-
y
[,
nms
]
}
## Now multiply
val
<-
xx
*
y
## Must be data.frame
if
(
is.null
(
dim
(
val
))
){
val
<-
data.frame
(
val
)
nams
(
val
)
<-
nms
}
return
(
val
)
})
# Both are matrices
# Check if they have different horizon k columns
colmatch
<-
TRUE
if
(
ncol
(
x
)
!=
ncol
(
y
))
{
colmatch
<-
FALSE
}
else
if
(
any
(
nams
(
x
)
!=
nams
(
y
))){
colmatch
<-
FALSE
}
if
(
!
colmatch
){
# Not same columns, take only the k in both
nms
<-
nams
(
x
)[
nams
(
x
)
%in%
nams
(
y
)]
x
<-
x
[,
nms
]
y
<-
y
[,
nms
]
}
# Now multiply
val
<-
x
*
y
# Must be data.frame
if
(
is.null
(
dim
(
val
))
){
val
<-
data.frame
(
val
)
nams
(
val
)
<-
nms
}
return
(
val
)
}
}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment