• QR Code (size=2)
• QR Code (size=3)
• QR Code (size=4)
• QR Code (size=5)
• QR Code (size=6)

12.9 21 12 13 11 8 7 18 12 20 1 2011 149 68 1.8
12.2 22 8 8 19 18 20 23 20 19 1 2011 139 39 2.1
12.8 22 11 14 16 12 9 22 14 18 1 2011 148 32 2.2
7.4 18 13 16 24 24 19 22 25 24 1 2011 158 62 2.3
6.7 23 11 14 15 16 12 19 15 20 1 2011 128 33 2.1
12.6 12 10 13 17 19 16 25 20 20 1 2011 224 52 2.7
14.8 20 7 15 19 16 17 28 21 24 1 2011 159 62 2.1
13.3 22 10 13 19 15 9 16 15 21 1 2011 105 77 2.4
11.1 21 15 20 28 28 28 28 28 28 1 2011 159 76 2.9
8.2 19 12 17 26 21 20 21 11 10 1 2011 167 41 2.2
11.4 22 12 15 15 18 16 22 22 22 1 2011 165 48 2.1
6.4 15 10 16 26 22 22 24 22 19 1 2011 159 63 2.2
10.6 20 10 12 16 19 17 24 27 27 1 2011 119 30 2.2
12 19 14 17 24 22 12 26 24 23 1 2011 176 78 2.7
6.3 18 6 11 25 25 18 28 23 24 1 2011 54 19 1.9
11.3 15 12 16 22 20 20 24 24 24 0 2011 91 31 2
11.9 20 14 16 15 16 12 20 21 25 1 2011 163 66 2.5
9.3 21 11 15 21 19 16 26 20 24 1 2011 124 35 2.2
9.6 21 8 13 22 18 16 21 19 21 0 2011 137 42 2.3
10 15 12 14 27 26 21 28 25 28 1 2011 121 45 1.9
6.4 16 15 19 26 24 15 27 16 28 1 2011 153 21 2.1
13.8 23 13 16 26 20 17 23 24 22 1 2011 148 25 3.5
10.8 21 11 17 22 19 17 24 21 26 1 2011 221 44 2.1
13.8 18 12 10 21 19 17 24 22 26 1 2011 188 69 2.3
11.7 25 7 15 22 23 18 22 25 21 1 2011 149 54 2.3
10.9 9 11 14 20 18 15 21 23 26 1 2011 244 74 2.2
16.1 30 7 14 21 16 20 25 20 23 0 2011 148 80 3.5
13.4 20 12 16 20 18 13 20 21 20 0 2011 92 42 1.9
9.9 23 12 15 22 21 21 21 22 24 1 2011 150 61 1.9
11.5 16 13 17 21 20 12 26 25 25 1 2011 153 41 1.9
8.3 16 9 14 8 15 6 23 23 24 1 2011 94 46 1.9
11.7 19 11 16 22 19 13 21 19 20 1 2011 156 39 2.1
9 25 12 15 20 19 19 27 21 24 1 2011 132 34 2
9.7 18 15 16 24 7 12 25 19 25 1 2011 161 51 3.2
10.8 23 12 16 17 20 14 23 25 23 1 2011 105 42 2.3
10.3 21 6 10 20 20 13 25 16 21 1 2011 97 31 2.5
10.4 10 5 8 23 19 12 23 24 23 1 2011 151 39 1.8
12.7 14 13 17 20 19 17 19 24 21 0 2011 131 20 2.4
9.3 22 11 14 22 20 19 22 18 18 1 2011 166 49 2.8
11.8 26 6 10 19 18 10 24 28 24 1 2011 157 53 2.3
5.9 23 12 14 15 14 10 19 15 18 1 2011 111 31 2
11.4 23 10 12 20 17 11 21 17 21 1 2011 145 39 2.5
13 24 6 16 22 17 11 27 18 23 1 2011 162 54 2.3
10.8 24 12 16 17 8 10 25 26 25 1 2011 163 49 1.8
12.3 18 11 16 14 9 7 25 18 22 0 2011 59 34 1.9
11.3 23 6 8 24 22 22 23 22 22 1 2011 187 46 2.6
11.8 15 12 16 17 20 12 17 19 23 1 2011 109 55 2
7.9 19 12 15 23 20 18 28 17 24 0 2011 90 42 2.6
12.7 16 8 8 25 22 20 25 26 25 1 2011 105 50 1.6
12.3 25 10 13 16 22 9 20 21 22 0 2011 83 13 2.2
11.6 23 11 14 18 22 16 25 26 24 0 2011 116 37 2.1
6.7 17 7 13 20 16 14 21 21 21 0 2011 42 25 1.8
10.9 19 12 16 18 14 11 24 12 24 1 2011 148 30 1.8
12.1 21 13 19 23 24 20 28 20 25 0 2011 155 28 1.9
13.3 18 14 19 24 21 17 20 20 23 1 2011 125 45 2.4
10.1 27 12 14 23 20 14 19 24 27 1 2011 116 35 1.9
5.7 21 6 15 13 20 8 24 24 27 0 2011 128 28 2
14.3 13 14 13 20 18 16 21 22 23 1 2011 138 41 2.1
8 8 10 10 20 14 11 24 21 18 0 2011 49 6 1.7
13.3 29 12 16 19 19 10 23 20 20 0 2011 96 45 1.9
9.3 28 11 15 22 24 15 18 23 23 1 2011 164 73 2.1
12.5 23 10 11 22 19 15 27 19 24 1 2011 162 17 2.4
7.6 21 7 9 15 16 10 25 24 26 1 2011 99 40 1.8
15.9 19 12 16 17 16 10 20 21 20 1 2011 202 64 2.3
9.2 19 7 12 19 16 18 21 16 23 1 2011 186 37 2.1
9.1 20 12 12 20 14 10 23 17 22 0 2011 66 25 2
11.1 18 12 14 22 22 22 27 23 23 1 2011 183 65 2.8
13 19 10 14 21 21 16 24 20 17 1 2011 214 100 2
14.5 17 10 13 21 15 10 27 19 20 1 2011 188 28 2.7
12.2 19 12 15 16 14 7 24 18 22 0 2011 104 35 2.1
12.3 25 12 17 20 15 16 23 18 18 1 2011 177 56 2.9
11.4 19 12 14 21 14 16 24 21 19 1 2011 126 29 2
8.8 22 8 11 20 20 16 21 20 19 0 2011 76 43 1.8
14.6 23 10 9 23 21 22 23 17 16 0 2011 99 59 2.6
12.6 14 5 7 18 14 5 27 25 26 1 2011 139 50 2.1
13 16 10 15 16 16 10 25 17 25 1 2011 162 59 2.3
12.6 24 12 12 17 13 8 19 17 23 0 2011 108 27 2.2
13.2 20 11 15 24 26 16 24 24 18 1 2011 159 61 2
9.9 12 9 14 13 13 8 25 21 22 0 2011 74 28 2.2
7.7 24 12 16 19 18 16 23 22 26 1 2011 110 51 2.1
10.5 22 11 14 20 15 14 23 18 25 0 2011 96 35 2.1
13.4 12 10 13 22 18 15 25 22 26 0 2011 116 29 1.9
10.9 22 12 16 19 21 9 26 20 26 0 2011 87 48 2
4.3 20 10 13 21 17 21 26 21 24 0 2011 97 25 1.7
10.3 10 9 16 15 18 7 16 21 22 0 2011 127 44 2.2
11.8 23 11 16 21 20 17 23 20 21 0 2011 106 64 2.2
11.2 17 12 16 24 18 18 26 18 22 0 2011 80 32 2.3
11.4 22 7 10 22 25 16 25 25 28 0 2011 74 20 2.4
8.6 24 11 12 20 20 16 23 23 22 0 2011 91 28 2.1
13.2 18 12 12 21 19 14 26 21 26 0 2011 133 34 1.9
12.6 21 6 12 19 18 15 22 20 20 0 2011 74 31 1.7
5.6 20 9 12 14 12 8 20 21 24 0 2011 114 26 1.8
9.9 20 15 19 25 22 22 27 20 21 0 2011 140 58 1.5
8.8 22 10 14 11 16 5 20 22 23 0 2011 95 23 1.9
7.7 19 11 13 17 18 13 22 15 23 0 2011 98 21 1.9
9 20 12 16 22 23 22 24 24 23 0 2011 121 21 1.7
7.3 26 12 15 20 20 18 21 22 22 0 2011 126 33 1.9
11.4 23 12 12 22 20 15 24 21 23 0 2011 98 16 1.9
13.6 24 11 8 15 16 11 26 17 21 0 2011 95 20 1.8
7.9 21 9 10 23 22 19 24 23 27 0 2011 110 37 2.4
10.7 21 11 16 20 19 19 24 22 23 0 2011 70 35 1.8
10.3 19 12 16 22 23 21 27 23 26 0 2011 102 33 1.9
8.3 8 12 10 16 6 4 25 16 27 0 2011 86 27 1.8
9.6 17 14 18 25 19 17 27 18 27 0 2011 130 41 2.1
14.2 20 8 12 18 24 10 19 25 23 0 2011 96 40 1.9
8.5 11 10 16 19 19 13 22 18 23 0 2011 102 35 2.2
13.5 8 9 10 25 15 15 22 14 23 0 2011 100 28 2
4.9 15 10 14 21 18 11 25 20 28 0 2011 94 32 1.7
6.4 18 9 12 22 18 20 23 19 24 0 2011 52 22 1.7
9.6 18 10 11 21 22 13 24 18 20 0 2011 98 44 1.8
11.6 19 12 15 22 23 18 24 22 23 0 2011 118 27 1.9
11.1 19 11 7 23 18 20 23 21 22 0 2011 99 17 1.8
4.35 23 9 16 20 17 15 22 14 15 1 2012 48 12 1
12.7 22 11 16 6 6 4 24 5 27 1 2012 50 45 1
18.1 21 12 16 15 22 9 19 25 23 1 2012 150 37 4
17.85 25 12 16 18 20 18 25 21 23 1 2012 154 37 4
16.6 30 7 12 24 16 12 26 11 20 0 2012 109 108 3
12.6 17 12 15 22 16 17 18 20 18 0 2012 68 10 2
17.1 27 12 14 21 17 12 24 9 22 1 2012 194 68 4
19.1 23 12 15 23 20 16 28 15 20 1 2012 158 72 4
16.1 23 10 16 20 23 17 23 23 21 1 2012 159 143 4
13.35 18 15 13 20 18 14 19 21 25 1 2012 67 9 2
18.4 18 10 10 18 13 13 19 9 19 1 2012 147 55 4
14.7 23 15 17 25 22 20 27 24 25 1 2012 39 17 1
10.6 19 10 15 16 20 16 24 16 24 1 2012 100 37 3
12.6 15 15 18 20 20 15 26 20 22 1 2012 111 27 3
16.2 20 9 16 14 13 10 21 15 28 1 2012 138 37 4
13.6 16 15 20 22 16 16 25 18 22 1 2012 101 58 3
18.9 24 12 16 26 25 21 28 22 21 0 2012 131 66 4
14.1 25 13 17 20 16 15 19 21 23 1 2012 101 21 3
14.5 25 12 16 17 15 16 20 21 19 1 2012 114 19 3
16.15 19 12 15 22 19 19 26 21 21 1 2012 165 78 4
14.75 19 8 13 22 19 9 27 20 25 1 2012 114 35 3
14.8 16 9 16 20 24 19 23 24 23 1 2012 111 48 3
12.45 19 15 16 17 9 7 18 15 28 1 2012 75 27 2
12.65 19 12 16 22 22 23 23 24 14 1 2012 82 43 2
17.35 23 12 17 17 15 14 21 18 23 1 2012 121 30 3
8.6 21 15 20 22 22 10 23 24 24 1 2012 32 25 1
18.4 22 11 14 21 22 16 22 24 25 1 2012 150 69 4
16.1 19 12 17 25 24 12 21 15 15 1 2012 117 72 3
11.6 20 6 6 11 12 10 14 19 23 0 2012 71 23 2
17.75 20 14 16 19 21 7 24 20 26 1 2012 165 13 4
15.25 3 12 15 24 25 20 26 26 21 1 2012 154 61 4
17.65 23 12 16 17 26 9 24 26 26 1 2012 126 43 4
16.35 23 12 16 22 21 12 22 23 23 1 2012 149 51 4
17.65 20 11 14 17 14 10 20 13 15 1 2012 145 67 4
13.6 15 12 16 26 28 19 20 16 16 1 2012 120 36 3
14.35 16 12 16 20 21 11 18 22 20 1 2012 109 44 3
14.75 7 12 16 19 16 15 18 21 20 1 2012 132 45 4
18.25 24 12 14 21 16 14 25 11 21 1 2012 172 34 4
9.9 17 8 14 24 25 11 28 23 28 1 2012 169 36 4
16 24 8 16 21 21 14 23 18 19 1 2012 114 72 3
18.25 24 12 16 19 22 15 20 19 21 1 2012 156 39 4
16.85 19 12 15 13 9 7 22 15 22 1 2012 172 43 4
14.6 25 11 16 24 20 22 27 8 27 0 2012 68 25 2
13.85 20 10 16 28 19 19 24 15 20 0 2012 89 56 2
18.95 28 11 18 27 24 22 23 21 17 1 2012 167 80 4
15.6 23 12 15 22 22 11 20 25 26 1 2012 113 40 3
14.85 27 13 16 23 22 19 22 14 21 0 2012 115 73 3
11.75 18 12 16 19 12 9 21 21 24 0 2012 78 34 2
18.45 28 12 16 18 17 11 24 18 21 0 2012 118 72 3
15.9 21 10 17 23 18 17 26 18 25 0 2012 87 42 2
17.1 19 10 14 21 10 12 24 12 22 1 2012 173 61 4
16.1 23 11 18 22 22 17 18 24 17 1 2012 2 23 1
19.9 27 8 9 17 24 10 17 17 14 0 2012 162 74 4
10.95 22 12 15 15 18 17 23 20 23 0 2012 49 16 1
18.45 28 9 14 21 18 13 21 24 28 0 2012 122 66 4
15.1 25 12 15 20 23 11 21 22 24 0 2012 96 9 3
15 21 9 13 26 21 19 24 15 22 0 2012 100 41 3
11.35 22 11 16 19 21 21 22 22 24 0 2012 82 57 2
15.95 28 15 20 28 28 24 24 26 25 0 2012 100 48 3
18.1 20 8 14 21 17 13 24 17 21 0 2012 115 51 3
14.6 29 8 12 19 21 16 24 23 22 0 2012 141 53 4
15.4 25 11 15 22 21 13 23 19 16 1 2012 165 29 4
15.4 25 11 15 21 20 15 21 21 18 1 2012 165 29 4
17.6 20 11 15 20 18 15 24 23 27 0 2012 110 55 3
13.35 20 13 16 19 17 11 19 19 17 1 2012 118 54 3
19.1 16 7 11 11 7 7 19 18 25 1 2012 158 43 4
15.35 20 12 16 17 17 13 23 16 24 0 2012 146 51 4
7.6 20 8 7 19 14 13 25 23 21 1 2012 49 20 1
13.4 23 8 11 20 18 12 24 13 21 0 2012 90 79 2
13.9 18 4 9 17 14 8 21 18 19 0 2012 121 39 3
19.1 25 11 15 21 23 7 18 23 27 1 2012 155 61 4
15.25 18 10 16 21 20 17 23 21 28 0 2012 104 55 3
12.9 19 7 14 12 14 9 20 23 19 0 2012 147 30 4
16.1 25 12 15 23 17 18 23 16 23 0 2012 110 55 3
17.35 25 11 13 22 21 17 23 17 25 0 2012 108 22 3
13.15 25 9 13 22 23 17 23 20 26 0 2012 113 37 3
12.15 24 10 12 21 24 18 23 18 25 0 2012 115 2 3
12.6 19 8 16 20 21 12 27 20 25 0 2012 61 38 1
10.35 26 8 14 18 14 14 19 19 24 0 2012 60 27 1
15.4 10 11 16 21 24 22 25 26 24 0 2012 109 56 3
9.6 17 12 14 24 16 19 25 9 24 0 2012 68 25 2
18.2 13 10 15 22 21 21 21 23 22 0 2012 111 39 3
13.6 17 10 10 20 8 10 25 9 21 0 2012 77 33 2
14.85 30 12 16 17 17 16 17 13 17 0 2012 73 43 2
14.75 25 8 14 19 18 11 22 27 23 1 2012 151 57 4
14.1 4 11 16 16 17 15 23 22 17 0 2012 89 43 2
14.9 16 8 12 19 16 12 27 12 25 0 2012 78 23 2
16.25 21 10 16 23 22 21 27 18 19 0 2012 110 44 3
19.25 23 14 16 8 17 22 5 6 8 1 2012 220 54 4
13.6 22 9 15 22 21 20 19 17 14 0 2012 65 28 2
13.6 17 9 14 23 20 15 24 22 22 1 2012 141 36 4
15.65 20 10 16 15 20 9 23 22 25 0 2012 117 39 3
12.75 20 13 11 17 19 15 28 23 28 1 2012 122 16 4
14.6 22 12 15 21 8 14 25 19 25 0 2012 63 23 2
9.85 16 13 18 25 19 11 27 20 24 1 2012 44 40 1
12.65 23 8 13 18 11 9 16 17 15 0 2012 52 24 1
19.2 0 3 7 20 13 12 25 24 24 0 2012 131 78 4
16.6 18 8 7 21 18 11 26 20 28 0 2012 101 57 3
11.2 25 12 17 21 19 14 24 18 24 0 2012 42 37 1
15.25 23 11 18 24 23 10 23 23 25 1 2012 152 27 4
11.9 12 9 15 22 20 18 24 27 23 1 2012 107 61 3
13.2 18 12 8 22 22 11 27 25 26 0 2012 77 27 2
16.35 24 12 13 23 19 14 25 24 26 1 2012 154 69 4
12.4 11 12 13 17 16 16 19 12 22 1 2012 103 34 3
15.85 18 10 15 15 11 11 19 16 25 0 2012 96 44 3
18.15 23 13 18 22 21 16 24 24 22 1 2012 175 34 4
11.15 24 9 16 19 14 13 20 23 26 0 2012 57 39 1
15.65 29 12 14 18 21 12 21 24 20 0 2012 112 51 3
17.75 18 11 15 21 20 17 28 24 26 1 2012 143 34 4
7.65 15 14 19 20 21 23 26 26 26 0 2012 49 31 1
12.35 29 11 16 19 20 14 19 19 21 1 2012 110 13 3
15.6 16 9 12 19 19 10 23 28 21 1 2012 131 12 4
19.3 19 12 16 16 19 16 23 23 24 1 2012 167 51 4
15.2 22 8 11 18 18 11 21 21 21 0 2012 56 24 1
17.1 16 15 16 23 20 16 26 19 18 1 2012 137 19 4
15.6 23 12 15 22 21 19 25 23 23 0 2012 86 30 2
18.4 23 14 19 23 22 17 25 23 26 1 2012 121 81 3
19.05 19 12 15 20 19 12 24 20 23 1 2012 149 42 4
18.55 4 9 14 24 23 17 23 18 25 1 2012 168 22 4
19.1 20 9 14 25 16 11 22 20 20 1 2012 140 85 4
13.1 24 13 17 25 23 19 27 28 25 0 2012 88 27 2
12.85 20 13 16 20 18 12 26 21 26 1 2012 168 25 4
9.5 4 15 20 23 23 8 23 25 19 1 2012 94 22 2
4.5 24 11 16 21 20 17 22 18 21 1 2012 51 19 1
11.85 22 7 9 23 20 13 26 24 23 0 2012 48 14 1
13.6 16 10 13 23 23 17 22 28 24 1 2012 145 45 4
11.7 3 11 15 11 13 7 17 9 6 1 2012 66 45 2
12.4 15 14 19 21 21 23 25 22 22 0 2012 85 28 2
13.35 24 14 16 27 26 18 22 26 21 1 2012 109 51 3
11.4 17 13 17 19 18 13 28 28 28 0 2012 63 41 2
14.9 20 12 16 21 19 17 22 18 24 0 2012 102 31 3
19.9 27 8 9 16 18 13 21 23 14 0 2012 162 74 4
11.2 26 13 11 21 18 8 24 15 20 0 2012 86 19 2
14.6 23 9 14 22 19 16 26 24 28 0 2012 114 51 3
17.6 17 12 19 16 13 14 26 12 19 1 2012 164 73 4
14.05 20 13 13 18 10 13 24 12 24 1 2012 119 24 3
16.1 22 11 14 23 21 19 27 20 21 1 2012 126 61 4
13.35 19 11 15 24 24 15 22 25 21 1 2012 132 23 4
11.85 24 13 15 20 21 15 23 24 26 1 2012 142 14 4
11.95 19 12 14 20 23 8 22 23 24 1 2012 83 54 2
14.75 23 12 16 18 18 14 23 18 26 0 2012 94 51 2
15.15 15 10 17 4 11 7 15 20 25 0 2012 81 62 2
13.2 27 9 12 14 16 11 20 22 23 1 2012 166 36 4
16.85 26 10 15 22 20 17 22 20 24 0 2012 110 59 3
7.85 22 13 17 17 20 19 25 25 24 0 2012 64 24 2
7.7 22 13 15 23 26 17 27 28 26 1 2012 93 26 2
12.6 18 9 10 20 21 12 24 25 23 0 2012 104 54 3
7.85 15 11 16 18 12 12 21 14 20 0 2012 105 39 3
10.95 22 12 15 19 15 18 17 16 16 0 2012 49 16 1
12.35 27 8 11 20 18 16 26 24 24 0 2012 88 36 2
9.95 10 12 16 15 14 15 20 13 20 0 2012 95 31 2
14.9 20 12 16 24 18 20 22 19 23 0 2012 102 31 3
16.65 17 12 16 21 16 16 24 18 23 0 2012 99 42 3
13.4 23 9 14 19 19 12 23 16 18 0 2012 63 39 2
13.95 19 12 14 19 7 10 22 8 21 0 2012 76 25 2
15.7 13 12 16 27 21 28 28 27 25 0 2012 109 31 3
16.85 27 11 16 23 24 19 21 23 23 0 2012 117 38 3
10.95 23 12 18 23 21 18 24 20 26 0 2012 57 31 1
15.35 16 6 14 20 20 19 28 20 26 0 2012 120 17 3
12.2 25 7 20 17 22 8 25 26 24 0 2012 73 22 2
15.1 2 10 15 21 17 17 24 23 23 0 2012 91 55 2
17.75 26 12 16 23 19 16 24 24 21 0 2012 108 62 3
15.2 20 10 16 22 20 18 21 21 23 0 2012 105 51 3
14.6 23 12 16 16 16 12 20 15 20 1 2012 117 30 3
16.65 22 9 12 20 20 17 26 22 23 0 2012 119 49 3
8.1 24 3 8 16 16 13 16 25 24 0 2012 31 16 1

library(lattice)
library(lmtest)
library(car)
library(MASS)
n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test
mywarning <- ''
par1 <- as.numeric(par1)
if(is.na(par1)) {
par1 <- 1
mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.'
}
if (par4=='') par4 <- 0
par4 <- as.numeric(par4)
if (par5=='') par5 <- 0
par5 <- as.numeric(par5)
x <- na.omit(t(y))
k <- length(x[1,])
n <- length(x[,1])
x1 <- cbind(x[,par1], x[,1:k!=par1])
mycolnames <- c(colnames(x)[par1], colnames(x)[1:k!=par1])
colnames(x1) <- mycolnames #colnames(x)[par1]
x <- x1
if (par3 == 'First Differences'){
(n <- n -1)
x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep='')))
for (i in 1:n) {
for (j in 1:k) {
x2[i,j] <- x[i+1,j] - x[i,j]
}
}
x <- x2
}
if (par3 == 'Seasonal Differences (s=12)'){
(n <- n - 12)
x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B12)',colnames(x),sep='')))
for (i in 1:n) {
for (j in 1:k) {
x2[i,j] <- x[i+12,j] - x[i,j]
}
}
x <- x2
}
if (par3 == 'First and Seasonal Differences (s=12)'){
(n <- n -1)
x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep='')))
for (i in 1:n) {
for (j in 1:k) {
x2[i,j] <- x[i+1,j] - x[i,j]
}
}
x <- x2
(n <- n - 12)
x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B12)',colnames(x),sep='')))
for (i in 1:n) {
for (j in 1:k) {
x2[i,j] <- x[i+12,j] - x[i,j]
}
}
x <- x2
}
if(par4 > 0) {
x2 <- array(0, dim=c(n-par4,par4), dimnames=list(1:(n-par4), paste(colnames(x)[par1],'(t-',1:par4,')',sep='')))
for (i in 1:(n-par4)) {
for (j in 1:par4) {
x2[i,j] <- x[i+par4-j,par1]
}
}
x <- cbind(x[(par4+1):n,], x2)
n <- n - par4
}
if(par5 > 0) {
x2 <- array(0, dim=c(n-par5*12,par5), dimnames=list(1:(n-par5*12), paste(colnames(x)[par1],'(t-',1:par5,'s)',sep='')))
for (i in 1:(n-par5*12)) {
for (j in 1:par5) {
x2[i,j] <- x[i+par5*12-j*12,par1]
}
}
x <- cbind(x[(par5*12+1):n,], x2)
n <- n - par5*12
}
if (par2 == 'Include Monthly Dummies'){
x2 <- array(0, dim=c(n,11), dimnames=list(1:n, paste('M', seq(1:11), sep ='')))
for (i in 1:11){
x2[seq(i,n,12),i] <- 1
}
x <- cbind(x, x2)
}
if (par2 == 'Include Quarterly Dummies'){
x2 <- array(0, dim=c(n,3), dimnames=list(1:n, paste('Q', seq(1:3), sep ='')))
for (i in 1:3){
x2[seq(i,n,4),i] <- 1
}
x <- cbind(x, x2)
}
(k <- length(x[n,]))
if (par3 == 'Linear Trend'){
x <- cbind(x, c(1:n))
colnames(x)[k+1] <- 't'
}
print(x)
(k <- length(x[n,]))
head(x)
df <- as.data.frame(x)
(mylm <- lm(df))
(mysum <- summary(mylm))
if (n > n25) {
kp3 <- k + 3
nmkm3 <- n - k - 3
gqarr <- array(NA, dim=c(nmkm3-kp3+1,3))
numgqtests <- 0
numsignificant1 <- 0
numsignificant5 <- 0
numsignificant10 <- 0
for (mypoint in kp3:nmkm3) {
j <- 0
numgqtests <- numgqtests + 1
for (myalt in c('greater', 'two.sided', 'less')) {
j <- j + 1
gqarr[mypoint-kp3+1,j] <- gqtest(mylm, point=mypoint, alternative=myalt)$p.value
}
if (gqarr[mypoint-kp3+1,2] < 0.01) numsignificant1 <- numsignificant1 + 1
if (gqarr[mypoint-kp3+1,2] < 0.05) numsignificant5 <- numsignificant5 + 1
if (gqarr[mypoint-kp3+1,2] < 0.10) numsignificant10 <- numsignificant10 + 1
}
gqarr
}
bitmap(file='test0.png')
plot(x[,1], type='l', main='Actuals and Interpolation', ylab='value of Actuals and Interpolation (dots)', xlab='time or index')
points(x[,1]-mysum$resid)
grid()
dev.off()
bitmap(file='test1.png')
plot(mysum$resid, type='b', pch=19, main='Residuals', ylab='value of Residuals', xlab='time or index')
grid()
dev.off()
bitmap(file='test2.png')
sresid <- studres(mylm)
hist(sresid, freq=FALSE, main='Distribution of Studentized Residuals')
xfit<-seq(min(sresid),max(sresid),length=40)
yfit<-dnorm(xfit)
lines(xfit, yfit)
grid()
dev.off()
bitmap(file='test3.png')
densityplot(~mysum$resid,col='black',main='Residual Density Plot', xlab='values of Residuals')
dev.off()
bitmap(file='test4.png')
qqPlot(mylm, main='QQ Plot')
grid()
dev.off()
(myerror <- as.ts(mysum$resid))
bitmap(file='test5.png')
dum <- cbind(lag(myerror,k=1),myerror)
dum
dum1 <- dum[2:length(myerror),]
dum1
z <- as.data.frame(dum1)
print(z)
plot(z,main=paste('Residual Lag plot, lowess, and regression line'), ylab='values of Residuals', xlab='lagged values of Residuals')
lines(lowess(z))
abline(lm(z))
grid()
dev.off()
bitmap(file='test6.png')
acf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Autocorrelation Function')
grid()
dev.off()
bitmap(file='test7.png')
pacf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Partial Autocorrelation Function')
grid()
dev.off()
bitmap(file='test8.png')
opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
plot(mylm, las = 1, sub='Residual Diagnostics')
par(opar)
dev.off()
if (n > n25) {
bitmap(file='test9.png')
plot(kp3:nmkm3,gqarr[,2], main='Goldfeld-Quandt test',ylab='2-sided p-value',xlab='breakpoint')
grid()
dev.off()
}
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Estimated Regression Equation', 1, TRUE)
a<-table.row.end(a)
myeq <- colnames(x)[1]
myeq <- paste(myeq, '[t] = ', sep='')
for (i in 1:k){
if (mysum$coefficients[i,1] > 0) myeq <- paste(myeq, '+', '')
myeq <- paste(myeq, signif(mysum$coefficients[i,1],6), sep=' ')
if (rownames(mysum$coefficients)[i] != '(Intercept)') {
myeq <- paste(myeq, rownames(mysum$coefficients)[i], sep='')
if (rownames(mysum$coefficients)[i] != 't') myeq <- paste(myeq, '[t]', sep='')
}
}
myeq <- paste(myeq, ' + e[t]')
a<-table.row.start(a)
a<-table.element(a, myeq)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, mywarning)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable1.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Multiple Linear Regression - Ordinary Least Squares', 6, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Variable',header=TRUE)
a<-table.element(a,'Parameter',header=TRUE)
a<-table.element(a,'S.D.',header=TRUE)
a<-table.element(a,'T-STAT
H0: parameter = 0',header=TRUE)
a<-table.element(a,'2-tail p-value',header=TRUE)
a<-table.element(a,'1-tail p-value',header=TRUE)
a<-table.row.end(a)
for (i in 1:k){
a<-table.row.start(a)
a<-table.element(a,rownames(mysum$coefficients)[i],header=TRUE)
a<-table.element(a,formatC(signif(mysum$coefficients[i,1],5),format='g',flag='+'))
a<-table.element(a,formatC(signif(mysum$coefficients[i,2],5),format='g',flag=' '))
a<-table.element(a,formatC(signif(mysum$coefficients[i,3],4),format='e',flag='+'))
a<-table.element(a,formatC(signif(mysum$coefficients[i,4],4),format='g',flag=' '))
a<-table.element(a,formatC(signif(mysum$coefficients[i,4]/2,4),format='g',flag=' '))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable2.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Regression Statistics', 2, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Multiple R',1,TRUE)
a<-table.element(a,formatC(signif(sqrt(mysum$r.squared),6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'R-squared',1,TRUE)
a<-table.element(a,formatC(signif(mysum$r.squared,6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Adjusted R-squared',1,TRUE)
a<-table.element(a,formatC(signif(mysum$adj.r.squared,6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (value)',1,TRUE)
a<-table.element(a,formatC(signif(mysum$fstatistic[1],6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE)
a<-table.element(a, signif(mysum$fstatistic[2],6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE)
a<-table.element(a, signif(mysum$fstatistic[3],6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'p-value',1,TRUE)
a<-table.element(a,formatC(signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Residual Statistics', 2, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Residual Standard Deviation',1,TRUE)
a<-table.element(a,formatC(signif(mysum$sigma,6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Sum Squared Residuals',1,TRUE)
a<-table.element(a,formatC(signif(sum(myerror*myerror),6),format='g',flag=' '))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable3.tab')
myr <- as.numeric(mysum$resid)
myr
if(n < 200) {
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Actuals, Interpolation, and Residuals', 4, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Time or Index', 1, TRUE)
a<-table.element(a, 'Actuals', 1, TRUE)
a<-table.element(a, 'Interpolation
Forecast', 1, TRUE)
a<-table.element(a, 'Residuals
Prediction Error', 1, TRUE)
a<-table.row.end(a)
for (i in 1:n) {
a<-table.row.start(a)
a<-table.element(a,i, 1, TRUE)
a<-table.element(a,formatC(signif(x[i],6),format='g',flag=' '))
a<-table.element(a,formatC(signif(x[i]-mysum$resid[i],6),format='g',flag=' '))
a<-table.element(a,formatC(signif(mysum$resid[i],6),format='g',flag=' '))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable4.tab')
if (n > n25) {
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Goldfeld-Quandt test for Heteroskedasticity',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'p-values',header=TRUE)
a<-table.element(a,'Alternative Hypothesis',3,header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'breakpoint index',header=TRUE)
a<-table.element(a,'greater',header=TRUE)
a<-table.element(a,'2-sided',header=TRUE)
a<-table.element(a,'less',header=TRUE)
a<-table.row.end(a)
for (mypoint in kp3:nmkm3) {
a<-table.row.start(a)
a<-table.element(a,mypoint,header=TRUE)
a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,1],6),format='g',flag=' '))
a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,2],6),format='g',flag=' '))
a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,3],6),format='g',flag=' '))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable5.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Meta Analysis of Goldfeld-Quandt test for Heteroskedasticity',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Description',header=TRUE)
a<-table.element(a,'# significant tests',header=TRUE)
a<-table.element(a,'% significant tests',header=TRUE)
a<-table.element(a,'OK/NOK',header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'1% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant1,6))
a<-table.element(a,formatC(signif(numsignificant1/numgqtests,6),format='g',flag=' '))
if (numsignificant1/numgqtests < 0.01) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'5% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant5,6))
a<-table.element(a,signif(numsignificant5/numgqtests,6))
if (numsignificant5/numgqtests < 0.05) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'10% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant10,6))
a<-table.element(a,signif(numsignificant10/numgqtests,6))
if (numsignificant10/numgqtests < 0.1) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable6.tab')
}
}
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of fitted values',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
reset_test_fitted <- resettest(mylm,power=2:3,type='fitted')
a<-table.element(a,paste('
',RC.texteval('reset_test_fitted'),'
',sep=''))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of regressors',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
reset_test_regressors <- resettest(mylm,power=2:3,type='regressor')
a<-table.element(a,paste('
',RC.texteval('reset_test_regressors'),'
',sep=''))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of principal components',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
reset_test_principal_components <- resettest(mylm,power=2:3,type='princomp')
a<-table.element(a,paste('
',RC.texteval('reset_test_principal_components'),'
',sep=''))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable8.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Variance Inflation Factors (Multicollinearity)',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
vif <- vif(mylm)
a<-table.element(a,paste('
',RC.texteval('vif'),'
',sep=''))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable9.tab')