Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Armin Rauschenberger
joinet
Commits
a79a8bca
Commit
a79a8bca
authored
Jan 18, 2019
by
Armin Rauschenberger
Browse files
automation
parent
258b4761
Changes
2
Expand all
Hide whitespace changes
Inline
Side-by-side
.Rhistory
0 → 100644
View file @
a79a8bca
This diff is collapsed.
Click to expand it.
R/functions.R
View file @
a79a8bca
...
...
@@ -303,17 +303,22 @@ plot.cornet <- function(x,...){
graphics
::
par
(
xaxs
=
"i"
,
yaxs
=
"i"
)
graphics
::
plot.window
(
xlim
=
c
(
1-0.5
,
nsigma
+0.5
),
ylim
=
c
(
1-0.5
,
npi
+0.5
))
s
el
<-
which
(
x
$
sigma
==
x
$
sigma.min
)
graphics
::
axis
(
side
=
1
,
at
=
c
(
1
,
s
el
,
nsigma
),
labels
=
signif
(
x
$
sigma
[
c
(
1
,
s
el
,
nsigma
)],
digits
=
2
))
s
sigma
<-
which
(
x
$
sigma
==
x
$
sigma.min
)
graphics
::
axis
(
side
=
1
,
at
=
c
(
1
,
s
sigma
,
nsigma
),
labels
=
signif
(
x
$
sigma
[
c
(
1
,
s
sigma
,
nsigma
)],
digits
=
2
))
s
el
<-
which
(
x
$
pi
==
x
$
pi.min
)
graphics
::
axis
(
side
=
2
,
at
=
c
(
1
,
s
el
,
npi
),
labels
=
signif
(
x
$
pi
[
c
(
1
,
s
el
,
npi
)],
digits
=
2
))
s
pi
<-
which
(
x
$
pi
==
x
$
pi.min
)
graphics
::
axis
(
side
=
2
,
at
=
c
(
1
,
s
pi
,
npi
),
labels
=
signif
(
x
$
pi
[
c
(
1
,
s
pi
,
npi
)],
digits
=
2
))
graphics
::
title
(
xlab
=
expression
(
sigma
),
ylab
=
expression
(
pi
))
#graphics::.filled.contour(x=seq_along(x$sigma),y=seq_along(x$pi),z=x$cvm,levels=levels,col=col)
graphics
::
image
(
x
=
seq_along
(
x
$
sigma
),
y
=
seq_along
(
x
$
pi
),
z
=
x
$
cvm
,
breaks
=
levels
,
col
=
col
,
add
=
TRUE
)
graphics
::
box
()
#graphics::abline(v=ssigma,lty=2,col="grey")
#graphics::abline(h=spi,lty=2,col="grey")
graphics
::
points
(
x
=
ssigma
,
y
=
spi
,
pch
=
4
,
col
=
"black"
,
cex
=
1
)
}
#' @export
...
...
@@ -552,6 +557,19 @@ predict.cornet <- function(object,newx,type="probability",...){
return
(
list
(
y
=
y
,
X
=
X
))
}
#--- start trial ---
if
(
FALSE
){
n
<-
1000
y_hat
<-
runif
(
n
)
y
<-
y_hat
>
0.9
y
<-
rbinom
(
n
=
n
,
size
=
1
,
prob
=
0.5
)
foldid
<-
rep
(
1
:
10
,
length.out
=
n
)
.loss
(
y
=
y
,
fit
=
y_hat
,
family
=
"binomial"
,
type.measure
=
"auc"
,
foldid
=
foldid
)
}
#--- end trial ---
# Correct this function in the palasso package (search twice for "# typo").
.loss
<-
function
(
y
,
fit
,
family
,
type.measure
,
foldid
=
NULL
){
if
(
!
is.list
(
fit
))
{
...
...
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