Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
R
R - Mortality Tables
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
10
Issues
10
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
R
R - Mortality Tables
Commits
775ff4df
Commit
775ff4df
authored
May 19, 2018
by
Reinhold Kainhofer
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Implement a custom version of rbind that allows non-matching columns (filled with NA by default)
parent
947298d2
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
25 additions
and
7 deletions
+25
-7
R/makeQxDataFrame.R
R/makeQxDataFrame.R
+25
-7
No files found.
R/makeQxDataFrame.R
View file @
775ff4df
...
...
@@ -25,6 +25,7 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
if
(
is.null
(
data
))
return
(
data.frame
(
x
=
double
(),
y
=
double
(),
group
=
character
()))
reference_ages
=
NULL
;
# browser()
if
(
missing
(
Period
))
{
# If reference is given, normalize all probabilities by that table!
...
...
@@ -35,9 +36,9 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
data
=
lapply
(
data
,
function
(
t
)
{
normalize_deathProbabilities
(
if
(
is.data.frame
(
t
@
data
$
dim
)
||
is.list
(
t
@
data
$
dim
))
{
cbind
(
x
=
ages
(
t
),
y
=
`names<-`
(
deathProbabilities
(
t
,
YOB
=
YOB
),
NULL
),
group
=
t
@
name
,
as.data.frame
(
t
@
data
$
dim
))
data.frame
(
x
=
ages
(
t
),
y
=
`names<-`
(
deathProbabilities
(
t
,
YOB
=
YOB
),
NULL
),
group
=
t
@
name
,
as.data.frame
(
t
@
data
$
dim
))
}
else
{
cbind
(
x
=
ages
(
t
),
y
=
`names<-`
(
deathProbabilities
(
t
,
YOB
=
YOB
),
NULL
),
group
=
t
@
name
)
data.frame
(
x
=
ages
(
t
),
y
=
`names<-`
(
deathProbabilities
(
t
,
YOB
=
YOB
),
NULL
),
group
=
t
@
name
)
},
reference
=
reference
,
referenceAges
=
reference_ages
)
...
...
@@ -49,16 +50,19 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
}
data
=
lapply
(
data
,
function
(
t
)
{
normalize_deathProbabilities
(
ifelse
(
is.data.frame
(
t
@
data
$
dim
)
||
is.list
(
t
@
data
$
dim
),
cbind
(
x
=
ages
(
t
),
y
=
`names<-`
(
periodDeathProbabilities
(
t
,
Period
=
Period
),
NULL
),
group
=
t
@
name
,
as.data.frame
(
t
@
data
$
dim
)),
cbind
(
x
=
ages
(
t
),
y
=
`names<-`
(
periodDeathProbabilities
(
t
,
Period
=
Period
),
NULL
),
group
=
t
@
name
)
),
if
(
is.data.frame
(
t
@
data
$
dim
)
||
is.list
(
t
@
data
$
dim
))
{
data.frame
(
x
=
ages
(
t
),
y
=
`names<-`
(
periodDeathProbabilities
(
t
,
Period
=
Period
),
NULL
),
group
=
t
@
name
,
as.data.frame
(
t
@
data
$
dim
))
}
else
{
data.frame
(
x
=
ages
(
t
),
y
=
`names<-`
(
periodDeathProbabilities
(
t
,
Period
=
Period
),
NULL
),
group
=
t
@
name
)
},
reference
=
reference
,
referenceAges
=
reference_ages
)
});
}
data
<-
as.data.frame
(
do.call
(
"rbind"
,
data
))
names
(
data
)
=
NULL
data
<-
as.data.frame
(
do.call
(
"rbind.expand"
,
data
))
data
}
...
...
@@ -85,3 +89,17 @@ normalize_deathProbabilities = function(data, reference = NULL, referenceAges =
data
}
rbind.expand
=
function
(
df1
,
df2
,
...
,
fill
=
NA
)
{
# browser()
if
(
missing
(
df2
)
||
is.null
(
df2
))
return
(
df1
)
df2.clmiss
=
setdiff
(
colnames
(
df1
),
colnames
(
df2
))
df1.clmiss
=
setdiff
(
colnames
(
df2
),
colnames
(
df1
))
df1
[
df1.clmiss
]
=
fill
df2
[
df2.clmiss
]
=
fill
rbind.expand
(
rbind
(
df1
,
df2
),
...
,
fill
=
fill
)
}
Write
Preview
Markdown
is supported
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