← Back to branch summary

~l3on/ubuntu/precise/rkward/rebuild1

« back to all changes in this revision

Viewing changes to rkward/plugins/analysis/time_series/hp_filter.php

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Friedrichsmeier
  • Date: 2008-04-20 21:30:00 UTC
  • mfrom: (1.2.2 upstream) (3.1.9 hardy)
  • Revision ID: james.westby@ubuntu.com-20080420213000-fs4i8efmfc793bnn
http://bugs.debian.org/475175
http://bugs.debian.org/463348
http://bugs.debian.org/475982
new upstream release
closes: #475175
closes: #463348
closes: #475982

Show diffs side-by-side

added added

removed removed

Lines of Context:
rkward/plugins/analysis/time_series/hp_filter.php
 
1
<?
 
2
function preprocess () {
 
3
}
 
4
 
 
5
function calculate () {
 
6
}
 
7
 
 
8
function printout () {
 
9
        if (getRK_val("custom") == 0)
 
10
                $lambda = getRK_val ("lambda");
 
11
        else
 
12
                $lambda = getRK_val ("clambda");
 
13
?>
 
14
rk.header ("Hodrick-Prescott Filter", parameters=list("Lambda", <? echo $lambda; ?>))
 
15
x <- get("<? getRK("x"); ?>", envir=globalenv())
 
16
lambda <- <? echo $lambda . "\n"; ?>
 
17
nas <- 0
 
18
for (i in 1:length(x)) {
 
19
        if (is.na(x[i])) {
 
20
                nas <- nas + 1
 
21
        }
 
22
}
 
23
if (nas == 0) {
 
24
        i <- diag(length(x))
 
25
        trend <- solve(i + lambda * crossprod(diff(i, lag=1, d=2)), x) # The HP Filter itself. Thanks to Grant V. Farnsworth
 
26
        cycle <- x - trend
 
27
        if (is.ts(x)) {
 
28
                trend <- ts(trend,start(x),frequency=frequency(x))
 
29
                cycle <- ts(cycle,start(x),frequency=frequency(x))
 
30
        }
 
31
<?
 
32
        if (getRK_val("create_trend") == 1) {
 
33
?>
 
34
        assign("<? getRK("trend_name"); ?>", trend, envir=globalenv())
 
35
<?
 
36
        } 
 
37
        if (getRK_val("create_cycle") == 1) {
 
38
?>
 
39
        assign("<? getRK("cycle_name"); ?>", cycle, envir=globalenv())
 
40
<?
 
41
        }
 
42
 
 
43
        if (getRK_val("series_col.color") != "" & getRK_val("trend_col.color") != "")
 
44
                $upcol = ", col=c(\"" . getRK_val("series_col.color") . "\", \"" . getRK_val("trend_col.color") . "\")";
 
45
        elseif (getRK_val("series_col.color") != "")
 
46
                $upcol = ", col=c(\"" . getRK_val("series_col.color") . "\", \"black\")";
 
47
        elseif (getRK_val("trend_col.color") != "")
 
48
                $upcol = ", col=c(\"black\", \"" . getRK_val("trend_col.color") . "\")";
 
49
        else
 
50
                $upcol = "";
 
51
 
 
52
        if (getRK_val("series_lty") != "" & getRK_val("trend_lty") != "")
 
53
                $uplty = ", lty=c(\"" . getRK_val("series_lty") . "\", \"" . getRK_val("trend_lty") . "\")";
 
54
        elseif (getRK_val("series_lty") != "")
 
55
                $uplty = ", lty=c(\"" . getRK_val("series_lty") . "\", \"solid\")";
 
56
        elseif (getRK_val("trend_lty") != "")
 
57
                $uplty = ", lty=c(\"solid\", \"" . getRK_val("trend_lty") . "\")";
 
58
        else
 
59
                $uplty = "";
 
60
 
 
61
        if (getRK_val("uplab.text") == "")
 
62
                $uplab = "\"" . getRK_val("x") . ", Trend\"";
 
63
        else
 
64
                if (getRK_val("uplabisquote") == 1)             
 
65
                        $uplab = "\"" . getRK_val("uplab") . "\"";
 
66
                else
 
67
                        $uplab = getRK_val("uplab");
 
68
?>
 
69
        rk.graph.on ()
 
70
        try({
 
71
                par(mfrow=c(<?if (getRK_val("plot_cycle") == 1) echo 2; else echo 1;?>,1),mar=c(2,4,2,2)+0.1)
 
72
                plot.ts(cbind(x, trend), ylab=<? echo $uplab; echo $upcol; ?>,lwd=c(<? getRK("series_lwd"); ?>,<? getRK("trend_lwd"); ?>)<? echo $uplty; ?>, plot.type="single")
 
73
<?
 
74
        if (getRK_val("plot_cycle") == 1) {
 
75
                if (getRK_val("downlab.text") == "") 
 
76
                        $downlab = "\"Cycle\"";
 
77
                else
 
78
                        if (getRK_val("downlabisquote") == 1)   
 
79
                                $downlab = "\"" . getRK_val("downlab") . "\"";
 
80
                        else
 
81
                                $downlab = getRK_val("downlab");
 
82
?>
 
83
                plot.ts(cycle, ylab=<? echo $downlab; if (getRK_val("cycle_col.color") != "") echo ", col=\"" . getRK_val("cycle_col.color") . "\""; ?>, lwd=<? getRK("cycle_lwd"); if (getRK_val("cycle_lty") != "") echo ", lty=\"" . getRK_val("cycle_lty") . "\""; ?>)
 
84
<?
 
85
        }
 
86
?>
 
87
        })
 
88
        rk.graph.off ()
 
89
}
 
90
else {
 
91
        warning("The series provided contains missing values")
 
92
}
 
93
<?
 
94
}
 
95
?>