Calculation Methods Book With R

EXCEL SOLVER, LINGO, AND THE
MATHEMATICAL MODELING
LANGUAGE R

$
.
.
EXCEL
SOLVER, LINGO, AND THE MATHEMATICAL MODELING
LANGUAGE R .
" " "
Excel, SIMAN, Arena and General Purpose Simulation System
) "(GPSS WORLD Excel and Vensim

.

.
Excel

. EXCEL
SOLVER .

LINGO .R

.

http://www.abarry.ws/books/CalculationMethodsBookWithR.pdf
.
.

1431
2010
............................................................................................... :
................................................................................... :
........................................................................................ :
..................................................... EXCEL
........................................... EXCEL
..............................................................................
...............................................................................
.....................................................................
.......................................... EXCEL
Curve Fitting and Parameters Estimation
The Solution of Ordinary Differential
........................................................................................ Equations
....................................... Monte Carlo Integration
...................................................................................... :
EXCEL SOLVER .......................
:1 ..............................................................
:2 ........................................................
:3 ....................................... Integer Programming
:4 ..............................................................
:5 ...........................Transportation Problem
:6 ................................. Assignment Problem
:7 .............................................................
:8 ..................................Shortes Path Problem
:9 ............................ Maximal Flow Problem
.................................................................................... :
........................................ LINGO
..............................................................................................
.................................................... The Objective Function
.............................................................................. Constraints
...............................................................................
......................................................................................
.............................................................................
..........................................................................................
.........................................................................................
.....................................................................................
................................................................................... :
........................................... LINGO
3
4
6
6
6
6
6
7
9
13
22
26
30
30
30
36
41
44
50
55
59
64
75
82
82
82
83
84
85
86
86
87
89
91
92
92
:1 ..........................................................................
:2 ..............................................................................
:3 .............................................................................
:4 .................................................................................
:5 .........................................................................
:6 .....................................................................
:7 ....................................................................
:8 ..............................................................................
:9 ............................................................................
:10 ................................................................
................................................................................... :
.................................................................. R
.......................................................................... ........... Rglpk
: 1 .........................................................................
:2 ..............................................................................
.................................................................................... linprog
............................................................................................... :1
................................................................................... lpSolve
............................................................................................... :1
............................................................................................... :2
...............................................................
...................................................................................
............................................................................................... :3
...............................................................................
......................................................................................
......................................................................................
: ........................................................ R
92
94
96
98
100
103
107
111
115
118
129
129
129
130
130
131
132
132
133
134
135
136
137
139
140
142
144
..............................................................
.............................................................................................
235
258

:EXCEL
EXCEL
:
(1
)f ( x + h) f ( x h
) + O ( h2
2h
(2
= )f ( x
) f ( x + 2h ) + 6 f ( x + h ) 3 f ( x ) 2 f ( x h
) + O ( h3
6h
= )f ( x
(3
) + O ( h4
) 2 f ( x + 2h ) + 16 f ( x + h ) 16 f ( x h ) + 2 f ( x 2h
= )f ( x
24h
:
(1
)f ( x + h) 2 f ( x ) + f ( x h
) + O ( h2
h2
= ) f ( x
(2
) + O ( h2
)f ( x + h) 2 f ( x ) + f ( x h
h2
= ) f ( x
(3
) f ( x + 2h ) + 16 f ( x + h ) 30 f ( x ) + 16 f ( x h ) f ( x 2h
) + O ( h4
12h 2
q > 0 ) g ( h ) O ( h q h = 0 C D
= ) f ( x
h D ) g ( h ) C h q ) sin ( h ) = h + O ( h3 ) ( cos ( h ) = 1 + O ( h 2
:
j = 0, 1, 2,...
+ O ( h k n +1 ) ,
) ( jh
)( x
)n
!n
(f
= ) f ( x + jh
n=0
:
f ( x ) = e x = 0 . h = 0.1
x
:
h = 0.01, 0.001 .
:
) f ( x ) ( n
) pn1 ( x:
k
) ( x x0
) ( x0
)k
!k
(f
n 1
= ) pn 1 ( x
k =0
. :
) (f
j
p j ( x ) = p j 1 ( x ) +
) ( x x0
!j
j
:
) f ( x ) = sin ( x . x0 = 1
:
)p0 ( x ) = f ( x0 ) = sin (1
)p1 ( x ) = p0 ( x ) + f ( x0 )( x x0 ) = sin (1) + cos (1)( x 1
1
1
2
2
)f ( x0 )( x x0 ) = sin (1) + cos (1)( x 1) sin (1)( x 1
2
2
)1 ( 3
1
1
3
2
3
)p3 ( x ) = p2 ( x ) + f ( x0 )( x x0 ) = sin (1) + cos (1)( x 1) sin (1)( x 1) cos (1)( x 1
6
2
6
p2 ( x ) = p1 ( x ) +
:
f ( x ) = e x . x0 = 0
EXCEL
b
a f ( x ) dx ] [ a, b N > 1
. a = x0 , x1 ,..., xN = b
h > 0 xk +1 = xk + h xk
) f k = f ( xk .
(1 :
h
h3
+
,
=
f
f
error
) f (
)( 0 1
2
12
x1
f ( x )dx
x0
(2 :
5
h
h
) ( f 0 + 4 f1 + f 2 ) , error = f ( 4) (
3
90
f ( x )dx
x2
x0
3
(3
8
3h
)3h5 ( 4
) f (
( f 0 + 3 f1 + 3 f 2 + f3 ) , error =
8
80
f ( x )dx
x3
x0
(4 :
7
2h
) 8h ( 6
) f (
( 7 f0 + 32 f 2 + 32 f3 + 7 f 4 ) , error =
45
945
f ( x )dx
x4
x0
:
ba
= h = xi +1 xi xk +1 = xk + h

N
) f k = f ( xk
.
(1 :
f
( b a ) h f
f
f ( x ) dx h 0 + f1 + + f N 1 + N , error =
) (
2
12
2
2
(2 :
h
+ ( f 1 + f1 + f N 1 f N +1 ) ,
24
fN
2
+ + f N 1 +
f
f ( x ) dx h 2 + f
b
)11( b a ) h 4 ( 4
error =
) f (
720
(3 :
+ 4 ( f1 + f 3 + + f M 2 ) + 2 ( f 2 + f 4 + + f M 1 ) + f M ,
ba
= h
, M = 2N
M
( ) ,
)4
(f
h
f ( x ) dx 3 f
b
b a ) h4
(
error =
180
:
:
10sin (1 0.1x ) dx
10
45.96977
:
ba
,
N
=h
f ( x ) dx h f ( x ) + f ( x ) + + f ( x ) ,
N
x j = a + j h,
2
j = 1, 2,..., N
:
ba
,
N
=h
1
1
f ( x ) dx h 2 f ( x ) + f ( x ) + + f ( x ) + 2 f ( x ) ,
b
N 1
j = 0,1, 2,..., N
x j = a + jh,
M:
h
) ) f ( x ) dx 3 [ f ( x ) + 4 ( f ( x ) + f ( x ) + + f ( x
+ 2 ( f ( x ) + f ( x ) + + f ( x ) ) + f ( x )],
b
M 1
M 2
j = 0,1, 2,..., M
:
EXCEL
10
ba
, x j = a + jh,
M
= M = 2N , h
11
12
Curve Fitting and Parameters

Estimation:
1984 1994
1994
1993
1992
1991
1990
1989
1988
1987
1986
1985
49.5
50.0
46.5
29.0
17.0
13.0
7.0
7.5
4.0
2.5
1984
Year
Market 3.0
Value
S :
13
a
,t 0
1 + be ct
= ) x (t
a b c
:
1984 )
( a = 10 b = 50 c = 1 Market Value Fit
.
14
15
a = 40 b = 100 c = 1
E13 Solver :
16
) $E$13 ( Min
$F$15:$F$17 Solve
:
.
57.76
,t 0
1 + 138.3e 0.729t
17
= ) x (t
ax
bx
a b
18
a (e
= )f ( x
Solver :
.
: .
19
20
21
The Solution of Ordinary Differential :

Equations
:
y ( x ) = f ( x, y ( x ) ) ,
y ( x0 ) = y0
Initial Value Problem

. y j = y ( x j ) x0 [ x0 , b]
Eulers Formula ( 1
k1 = f ( x j , y j )
h
h
k2 = f x j + , y j + k1
2
2
y j +1 = y j + h k2
Heun Method ( 2
k1 = f ( x j , y j )
2
2
k2 = f x j + h, y j + h k1
3
3
3
1
y j +1 = y j + h k1 + k 2
4
4
Runge-Kutta Formula -( 3
k1 = f ( x j , y j )
1
1
k2 = f x j + h, y j + h k1
2
2
1
1
k3 = f x j + h, y j + h k2
2
2
k 4 = f ( x j + h, y j + h k 3 )
y j +1 = y j +
h
( k1 + 2k2 + 2k3 + k4 )
6
:
2
y = x + y ,
y ( 0) = 0
. [0,1]
22
23
24
25
: Monte Carlo Integration

) ( :
b
I = f ( x ) dx
a
) f (x
) (b a
i =1
xi . N
) (.
:
:
1
f ( x, y ) dxdy
1 1
1, x + y 1
f ( x, y ) =
0, otherwise
2
1, x + y 1
f ( x, y ) =
0, otherwise
2
:
4
x dx
= ) f (x
26
f ( x , y ),
i
i =1
4
N
:
-1 n x 1 , x 2 ,..., x n ) x i ~ U ( 0, 4 . i
1 n
1 n
. f = f (x i ) = x i
n i =1
n i =1
-2
-3
b
f ( x ) dx (b a ) f
x dx ( 4 0) f = 4f
a
) (x i
1 n
2
, f = f
n i =1
) (
f 2 f
n
) error (b a
Excel :
-1 A1 n 1 1500 . A2-A1501
-2 B1 x B2 ))( =4*(RAND .B1501
-3 C1 ) f(x C2 ). =SQRT(B2
-4 D1 fHat D2 ).=AVERAGE(C:C
-5 E1 Integration E2 .=4*D2
-6 .
4
-1
1+ x 2
= ) f ( x ]. x [ 0,1
-2 f ( x ) = x + x ]. x [ 0,1
f ( x , y ) = 4 x 2 y 2 :
y 2 ) dy dx
( (4 x
4
27
-1 n ) x , y , x , y ,..., ( x n , y n
) ( 1 1 ) ( 2 2 4
y i ~ U 0, 5 4 . i
1 n
1 n
2
2
-2 ) . f = f ( x i , y i ) = (4 x i y i
n i =1
n i =1
x i ~ U 0, 5
-3
d
f ( x , y ) dydx (b a ) (d c ) f
25
5
5
y 2 )dydx 0 0 f = f
16
4
4
(4 x
4
) (x i , y i
1 n
f
n i =1
= , f 2
) (
f 2 f
n
) error (b a ) (d c
Excel :
-1 A1 n 1 1500 . A2-A1501
-2 B1 x B2 ))( =(5/4)*(RAND .B1501
-3 C1 y C2 ))( =(5/4)*(RAND .C1501
-4 D1 ) f(x D2 . =4-B2*B2-C2*C2
-5 E1 fHat E2 ).=AVERAGE(D:D
-6 E1 Integration E2 .=(5/4)*(5/4)*D2
-7 .
:
2
2
-1 f ( x , y ) = 4 x y ]. x [ 0,5 4] , y [ 0,5 4
-2 f (x , y , z ) = 4 x 2 y 2 z 2
28
) )
y 2 z 2 ) dz dy dx
(4 x
( (
11 10
9 10
=. 2.9634
-3 f ( x , y , z ,u ) = 5 x 2 y 2 z 2 u 2
y 2 z 2 u 2 ) du dz dy dx
) )
( ( (5 x
11 10
9 10
0
45
=. 2.99663
:
1 z 2 2
e

2
= ) f (z ]. z [ 4,0
Excel
: ) P ( z < 0 ) z N ( 0,1
) ( ,0
) . z 4
(.
29

EXCEL SOLVER :
EXCEL SOLVER
.
.
:1
:
S Z 12
. 1000 40
. 700 .
350 .
:
Production Time
(min.) per Dozen
3
4
)Plastic (lb.
per Dozen
2
1
Profit per
Dozen
$8
$5
Product
S
Z
Max 8 x1 + 5 x2
2 x1 + x2 1000
3 x1 + 4 x2 2400
x1 + x2 700
x1 x2 350
x1 , x2 0
30
St
:EXCEL SOLVER
:
D4 :
)=SUMPRODUCT($B$2:$C$2,B4:C4
D5:D8:
31
D4
Options
32
Assume Linear Model Assume Non-Negative OK

Solve
: Solver
33
Reports :
34
: .
35
:2
:
EXCEL SOLVER :
Minimize 0.6 X 1 + 0.5 X 2

20 X 1 + 50 X 2 100
25 X 1 + 25 X 2 100
50 X 1 + 10 X 2 100
X1, X 2 0
:
:
D4 Solver :
36
ST
37
38
: .
39
Excel Solver :
Minimize 18 x1 + 22 x2 + 10 x3 + 12 x4 + 10 x5 + 9 x6 + 40 x7 + 16 x8 + 50 x9 + 7 x10
subject to
90 x1 + 110 x2 + 100 x3 + 90 x4 + 75 x5 + 35 x6 + 65 x7 + 100 x8 + 120 x9 + 65 x10
6 x1 +
4 x2 +
2 x3 +
20 x1 + 48 x2 + 12 x3 +
3 x4 +
x5 +
8 x4 + 30 x5 +
3 x1 +
4 x 2 + 5 x3 +
6 x 4 + 7 x5 +
5 x1 +
2 x2 +
4 x4 +
3 x3 +
2 x 2 + 2 x3 +
x7 +
x7 +
3 x9 + 26 x10 400
9 x8 +
x7 +
2 x 4 + 5 x5 +
270 x5 +
x10 5
52 x7 + 250 x8 +
2 x6 +
x9 + 3 x10 20
3x10 12
3 x6 +
8 x6 +
4 x8 +
12 x8
x10 20
30
xi 0
40
420
:3
Integer Programming
:
Max. 12000 X 1 + 20000 X 2
St.
2 X1 +
6 X 2 27
X2 2
3X1 +
X 2 19
X 1 , X 2 0 and integers
41
Use Automatic Scaling

.
:
42
: .
: .
Minimize 8 x1 + 10 x2 + 7 x3 + 6 x4 + 11x5 + 9 x6
Subject to
12 x1 + 9 x2 + 25 x3 + 20 x4 + 17 x5 + 13x6 60
35 x1 + 42 x2 + 18 x3 + 31x4 + 56 x5 + 49 x6 150
37 x1 + 53 x2 + 28 x3 + 24 x4 + 29 x5 + 20 x6 125
0 x1 , x2 1
43
:4
:
:
Warehoise
D1=1100
W1
35
Plant
S1=1200
P1
37
30
D2=400
W2
4
4 0 40
S2=1000
P2
42
32
15
S3=800
P3
D3=750
W3
2
20 5
28
D4=750
W4

Min ( Total Shipping Cost )
St :
Amount shipped from each source Supply at that source
Amount received at each destination = Demand at that destination
No negative shipments
j = 1, 2,3, 4 i = 1, 2,3 X ij
:
Min 35 X 11 + 20 X 12 + 40 X 13 + 32 X 14 + 37 X 21 + 40 X 22 + 42 X 23 + 25 X 24 + 40 X 31 + 15 X 32 + 20 X 33 + 28 X 34
St
X 11 +
X 12 +
X 13 +
X 14
1200
X 21 +
X 22 +
X 23 +
X 24
1000
X 31 +
X 11
+
X 12
X 21
+
+
X 13
X 22
X 14
X 23
+
X ij 0,
for all i and j
44
X 32
X 34 800
=400
+
X 24
X 33 +
=1100
+
X 32 +
X 31
X 33
=750
+ X 34 = 750
Solver
45
46
47
48
: .
49
:5
Transportation Problem
.

:
Distribution
Distribution
Distribution Center 3
Center 1
Center 2
Plant A
4
6
4
Plant B
6
5
2
. 60
40 .

:
:
50
SOLVER :
Solve
51
52
53
54
: .
55
:6
)( Assignment Problem
200
50 . 5
)( :
Freestyle
Breaststroke Butterfly
Backstroke
29.2
26.4
29.6
28.5
31.1
43.4
33.1
42.2
34.7
41.8
37.7
32.9
33.8
37
35.4
33.3
28.5
38.9
30.4
33.6
4 .
56
A
B
C
D
E
SOLVER :
57
Solve
58
: .
59
:7
:Assignment Problem
:
Inspection Area
Assembly
A
B
C
D
E
Line
1
10
4
6
10
12
2
11
7
7
9
14
3
13
8
12
14
15
4
14
16
13
17
17
5
19
11
17
20
19

.
:
60
SOLVER :
61
Solve
62
63
:8
:Shortest Path Problem
) 1 ( ) 12
( .
599
180
7
49
691
0
4 2
432
44
0
4
5
34
554
6
893
43
2
1
62
280
577
8
9
50
0
29
10
6
11
403
12
314
11
64
Min 599 x1,2 + 180 x1,3 + 497 x1,4 + 691x2,5 + 420 x2,6 +
432 x3,4 + 893x3,7 + 345 x4,6 + 440 x5,6 + 554 x5,9 +
432 x6,8 + 621x6,9 + 280 x7,8 + 500 x7,10 + 577 x8,9 +
290 x8,10 + 268 x9,12 + 116 x10,11 + 403x10,12 + 314 x11,12
ST
x1,2 + x1,3 + x1,4 = 1

x2,5 + x2,6 x1,2 = 0
x3,4 + x3,7 x1,3 = 0
x4,6 x1,4 x3,4 = 0
x5,6 + x5,9 x2,5 = 0
x6,8 + x6,9 x2,6 x4,6 x5,6 = 0
x7,8 + x7,10 x3,7 = 0
x8,9 + x8,10 x6,8 x7,8 = 0
x9,12 x9,5 x6,9 x8,9 = 0
x10,11 + x10,12 x7,10 x8,10 = 0
x11,12 x10,11 = 0
x9,12 x10,12 x11,12 = 0
All
xi , j ' s = 0 or 1

65
Solver
66
Microsoft Excel 11.0 Answer Report

Worksheet: [Shortest Path.xls]Sheet1
Report Created: 11/24/2006 10:19:42 AM
Target Cell (Min)

Cell
$O$29
Name
Original
Value
0
Final Value
1731
67
Adjustable Cells
Cell
$B$3
$C$3
$D$3
$E$3
$F$3
$G$3
$H$3
$I$3
$J$3
$K$3
$L$3
$M$3
$B$4
$C$4
$D$4
$E$4
$F$4
$G$4
$H$4
$I$4
$J$4
$K$4
$L$4
$M$4
$B$5
$C$5
$D$5
$E$5
$F$5
$G$5
$H$5
$I$5
$J$5
$K$5
$L$5
$M$5
$B$6
$C$6
$D$6
$E$6
$F$6
$G$6
$H$6
$I$6
Name
Original
Value
Final Value
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
2.22045E-16
1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
1
0
0
68
$J$6
$K$6
$L$6
$M$6
$B$7
$C$7
$D$7
$E$7
$F$7
$G$7
$H$7
$I$7
$J$7
$K$7
$L$7
$M$7
$B$8
$C$8
$D$8
$E$8
$F$8
$G$8
$H$8
$I$8
$J$8
$K$8
$L$8
$M$8
$B$9
$C$9
$D$9
$E$9
$F$9
$G$9
$H$9
$I$9
$J$9
$K$9
$L$9
$M$9
$B$10
$C$10
$D$10
$E$10
$F$10
$G$10
$H$10
$I$10
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
0
0
0
0
0
0
0
0
0
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
69
$J$10
$K$10
$L$10
$M$10
$B$11
$C$11
$D$11
$E$11
$F$11
$G$11
$H$11
$I$11
$J$11
$K$11
$L$11
$M$11
$B$12
$C$12
$D$12
$E$12
$F$12
$G$12
$H$12
$I$12
$J$12
$K$12
$L$12
$M$12
$B$13
$C$13
$D$13
$E$13
$F$13
$G$13
$H$13
$I$13
$J$13
$K$13
$L$13
$M$13
$B$14
$C$14
$D$14
$E$14
$F$14
$G$14
$H$14
$I$14
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
0
0
0
0
0
0
0
0
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
70
$J$14
$K$14
$L$14
$M$14
Constraints
Cell
Name
$O$3
0
0
0
0
Cell Value
0
0
0
0
Formula
$O$3<=$Q$3
$O$4
$O$4=$Q$4
$O$5
$O$5=$Q$5
$O$6
$O$6=$Q$6
$O$7
$O$7=$Q$7
$O$8
$O$8=$Q$8
$O$9
$O$9=$Q$9
$O$10
$O$10=$Q$10
$O$11
$O$11=$Q$11
$O$12
$O$12=$Q$12
$O$13
$O$13=$Q$13
$O$14
$B$3
$C$3
$D$3
$E$3
$F$3
$G$3
$H$3
$I$3
$J$3
$K$3
$L$3
$M$3
$B$4
$C$4
$D$4
$E$4
$F$4
$G$4
$H$4
$I$4
-1
0
0
2.22045E-16
1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$O$14=$Q$14
$B$3=binary
$C$3=binary
$D$3=binary
$E$3=binary
$F$3=binary
$G$3=binary
$H$3=binary
$I$3=binary
$J$3=binary
$K$3=binary
$L$3=binary
$M$3=binary
$B$4=binary
$C$4=binary
$D$4=binary
$E$4=binary
$F$4=binary
$G$4=binary
$H$4=binary
$I$4=binary
71
Status
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Slack
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$J$4
$K$4
$L$4
$M$4
$B$5
$C$5
$D$5
$E$5
$F$5
$G$5
$H$5
$I$5
$J$5
$K$5
$L$5
$M$5
$B$6
$C$6
$D$6
$E$6
$F$6
$G$6
$H$6
$I$6
$J$6
$K$6
$L$6
$M$6
$B$7
$C$7
$D$7
$E$7
$F$7
$G$7
$H$7
$I$7
$J$7
$K$7
$L$7
$M$7
$B$8
$C$8
$D$8
$E$8
$F$8
$G$8
$H$8
$I$8
0
0
0
0
0
0
0
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$J$4=binary
$K$4=binary
$L$4=binary
$M$4=binary
$B$5=binary
$C$5=binary
$D$5=binary
$E$5=binary
$F$5=binary
$G$5=binary
$H$5=binary
$I$5=binary
$J$5=binary
$K$5=binary
$L$5=binary
$M$5=binary
$B$6=binary
$C$6=binary
$D$6=binary
$E$6=binary
$F$6=binary
$G$6=binary
$H$6=binary
$I$6=binary
$J$6=binary
$K$6=binary
$L$6=binary
$M$6=binary
$B$7=binary
$C$7=binary
$D$7=binary
$E$7=binary
$F$7=binary
$G$7=binary
$H$7=binary
$I$7=binary
$J$7=binary
$K$7=binary
$L$7=binary
$M$7=binary
$B$8=binary
$C$8=binary
$D$8=binary
$E$8=binary
$F$8=binary
$G$8=binary
$H$8=binary
$I$8=binary
72
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$J$8
$K$8
$L$8
$M$8
$B$9
$C$9
$D$9
$E$9
$F$9
$G$9
$H$9
$I$9
$J$9
$K$9
$L$9
$M$9
$B$10
$C$10
$D$10
$E$10
$F$10
$G$10
$H$10
$I$10
$J$10
$K$10
$L$10
$M$10
$B$11
$C$11
$D$11
$E$11
$F$11
$G$11
$H$11
$I$11
$J$11
$K$11
$L$11
$M$11
$B$12
$C$12
$D$12
$E$12
$F$12
$G$12
$H$12
$I$12
1
0
0
0
0
0
0
0
0
0
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
0
0
0
0
0
0
0
0
$J$8=binary
$K$8=binary
$L$8=binary
$M$8=binary
$B$9=binary
$C$9=binary
$D$9=binary
$E$9=binary
$F$9=binary
$G$9=binary
$H$9=binary
$I$9=binary
$J$9=binary
$K$9=binary
$L$9=binary
$M$9=binary
$B$10=binary
$C$10=binary
$D$10=binary
$E$10=binary
$F$10=binary
$G$10=binary
$H$10=binary
$I$10=binary
$J$10=binary
$K$10=binary
$L$10=binary
$M$10=binary
$B$11=binary
$C$11=binary
$D$11=binary
$E$11=binary
$F$11=binary
$G$11=binary
$H$11=binary
$I$11=binary
$J$11=binary
$K$11=binary
$L$11=binary
$M$11=binary
$B$12=binary
$C$12=binary
$D$12=binary
$E$12=binary
$F$12=binary
$G$12=binary
$H$12=binary
$I$12=binary
73
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$J$12
$K$12
$L$12
$M$12
$B$13
$C$13
$D$13
$E$13
$F$13
$G$13
$H$13
$I$13
$J$13
$K$13
$L$13
$M$13
$B$14
$C$14
$D$14
$E$14
$F$14
$G$14
$H$14
$I$14
$J$14
$K$14
$L$14
$M$14
0
0
0
2.22045E-16
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
$J$12=binary
$K$12=binary
$L$12=binary
$M$12=binary
$B$13=binary
$C$13=binary
$D$13=binary
$E$13=binary
$F$13=binary
$G$13=binary
$H$13=binary
$I$13=binary
$J$13=binary
$K$13=binary
$L$13=binary
$M$13=binary
$B$14=binary
$C$14=binary
$D$14=binary
$E$14=binary
$F$14=binary
$G$14=binary
$H$14=binary
$I$14=binary
$J$14=binary
$K$14=binary
$L$14=binary
$M$14=binary
74
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
Binding
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
:9
:Maximal Flow Problem

Source
1
10
10
12
4
12
2
4
2
Tank
) 1000/(
7
0
0
0
7
8
2
0
6
0
6
4
3
2
0
0
5
0
0
12
0
0
2
0
4
0
8
0
0
0
3
0
TO
3
10
1
0
0
0
4
0
.
:
75
2
10
0
1
0
0
0
0
1
0
0
0
0
0
0
0
1
2
3
4
5
6
7
F
R
O
M

Max
x1,2 + x1,3
St
x2,3 + x2,4 + x2,6 x1,2 x3,2 = 0
x3,2 + x3,5 + x3,6 x1,3 x2,3 x6,3 = 0
x4,6 + x4,7 x2,4 x6,4 = 0
x5,6 + x5,7 x3,5 x6,5 = 0
x6,3 + x6,4 + x6,5 + x6,7 x2,6 x3,6 x4,6 x5,6 = 0
x1,2 10
x1,3 10
x2,3 1
x2,4 8
x2,6 6
x3,2 1
x3,5 12
x3,6 4
x4,6 3
x4,7 7
x5,6 2
x5,7 8
x6,3 4
x6,4 3
x6,5 2
x6,7 2
All
xi , j ' s 0
76

77
Solver
78
Microsoft Excel 11.0 Answer Report

Worksheet: [Maximal Flow.xls]Sheet1
Report Created: 11/24/2006 10:38:48 AM
Target Cell (Max)

Cell
$C$21
Name
Original
Value
0
Final Value
17
Adjustable Cells
Cell
$B$3
$C$3
$D$3
$E$3
$F$3
$G$3
$H$3
$B$4
$C$4
$D$4
$E$4
$F$4
$G$4
Name
Original
Value
Final Value
0
0
0
0
0
0
0
0
0
0
0
0
0
0
9
8
0
0
0
0
0
0
0
7
0
2
79
$H$4
$B$5
$C$5
$D$5
$E$5
$F$5
$G$5
$H$5
$B$6
$C$6
$D$6
$E$6
$F$6
$G$6
$H$6
$B$7
$C$7
$D$7
$E$7
$F$7
$G$7
$H$7
$B$8
$C$8
$D$8
$E$8
$F$8
$G$8
$H$8
$B$9
$C$9
$D$9
$E$9
$F$9
$G$9
$H$9
Constraints
Cell
Name
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
Cell Value
0
0
0
0
0
8
0
0
0
0
0
0
0
0
7
0
0
0
0
0
0
8
0
0
0
0
0
0
2
0
0
0
0
0
0
0
Formula
$I$4
$I$4=$K$4
$I$5
$I$5=$K$5
$I$6
$I$6=$K$6
$I$7
$I$8
0
0
$I$7=$K$7
$I$8=$K$8
80
Status
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Slack
0
0
0
0
0
$I$9
$I$9<=$K$9
$I$10
$I$10<=$K$10
$I$11<=$K$11
$I$12
$I$12<=$K$12
$I$13
$I$13<=$K$13
$I$14
$I$14<=$K$14
$I$15
$I$15<=$K$15
$I$16
$I$16<=$K$16
$I$17
$I$18
0
7
$I$17<=$K$17
$I$18<=$K$18
$I$19
$I$20
0
8
$I$19<=$K$19
$I$20<=$K$20
$I$21
$I$21<=$K$21
$I$22
$I$22<=$K$22
$I$23
$I$24
0
2
$I$23<=$K$23
$I$24<=$K$24
$I$11
81
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Not
Binding
Binding
Not
Binding
Binding
Not
Binding
Not
Binding
Not
Binding
Binding
1
2
1
1
4
1
4
4
3
0
2
0
4
3
2
0

LINGO
:
6 8 .
)( .

.
:
WH8
V8
WH5
V7
WH4
V6
WH3
V4
V5
WH2
V3
WH1
V2
V1
48 .
.
:
:
-1 :
Widgets On Hand
60
55
51
43
41
52
Warehouse
1
2
3
4
5
6
Widget Demand
35
37
22
32
41
32
43
38
Vendor
1
2
3
4
5
6
7
8
-2 :
82
-3 :
V8
9
2
3
1
5
3
V7
5
8
3
7
6
4
V6
2
5
4
2
2
1
V5
4
8
7
9
7
8
V4
7
3
9
3
5
2
V3
6
5
1
7
9
2
V1
6
4
5
7
2
5
V2
2
9
2
6
3
5
WH1
WH2
WH3
WH4
WH5
WH6
: The Objective Function

.
) x ( i, j i j
:
Minimize
6 x (1,1) + 2 x (1, 2 ) + 6 x (1,3) + 7 x (1, 4 ) + 4 x (1,5 ) + 2 x (1, 6 ) + 5 x (1, 7 ) + 9 x (1,8 ) +
4 x ( 2,1) + 9 x ( 2, 2 ) + 5 x ( 2,3) + 3x ( 2, 4 ) + 8 x ( 2, 5 ) + 5 x ( 2, 6 ) + 8 x ( 2, 7 ) + 2 x ( 2,8 ) +

5 x ( 3,1) + 2 x ( 3, 2 ) + x ( 3, 3) + 9 x ( 3, 4 ) + 7 x ( 3,5 ) + 4 x ( 3, 6 ) + 3x ( 3, 7 ) + 3x ( 3,8 ) +
7 x ( 4,1) + 6 x ( 4, 2 ) + 7 x ( 4,3) + 3x ( 4, 4 ) + 9 x ( 4,5 ) + 2 x ( 4, 6 ) + 7 x ( 4, 7 ) + x ( 4,8 ) +
2 x ( 5,1) + 3 x ( 5, 2 ) + 9 x ( 5,3) + 5 x ( 5, 4 ) + 7 x ( 5,5 ) + 2 x ( 5, 6 ) + 6 x ( 5, 7 ) + 5 x ( 5,8 ) +
) 5 x ( 6,1) + 5 x ( 6, 2 ) + 2 x ( 6,3) + 2 x ( 6, 4 ) + 8 x ( 6, 5 ) + x ( 6, 6 ) + 4 x ( 6, 7 ) + 3 x ( 6,8
6 8

.
:
8
) c x ( i, j
ij
Mimize
i =1 j =1
cij i . j
LINGO
:
;))MIN = @SUM(LINKS(I,J): COST(I,J)*VOLUME(I,J
) VOLUME(I,J i j ) COST(I,J
i j )LINKS(I,J
. LINGO
83
Math Notation
LINGO Syntax
= MIN
@SUM(LINKS(I,J):
Minimize
8
j =1
i =1
)COST(I,J
cij
)VOLUME(I,J
) x ( i, j
:Constraints
Constraints .

Demand Constraints Capacity
Constraints .

35
x (1,1) + x ( 2,1) + x ( 3,1) + x ( 4,1) + x ( 5,1) + x ( 6,1) = 35

x (1, 2 ) + x ( 2, 2 ) + x ( 3, 2 ) + x ( 4, 2 ) + x ( 5, 2 ) + x ( 6, 2 ) = 37
x (1,3) + x ( 2,3) + x ( 3,3) + x ( 4,3) + x ( 5,3) + x ( 6,3) = 22

x (1, 4 ) + x ( 2, 4 ) + x ( 3, 4 ) + x ( 4, 4 ) + x ( 5, 4 ) + x ( 6, 4 ) = 32
x (1,5 ) + x ( 2,5 ) + x ( 3,5 ) + x ( 4,5 ) + x ( 5,5 ) + x ( 6,5 ) = 41

x (1, 6 ) + x ( 2, 6 ) + x ( 3, 6 ) + x ( 4, 6 ) + x ( 5, 6 ) + x ( 6, 6 ) = 32
x (1, 7 ) + x ( 2, 7 ) + x ( 3, 7 ) + x ( 4, 7 ) + x ( 5, 7 ) + x ( 6, 7 ) = 43
x (1,8 ) + x ( 2,8 ) + x ( 3,8 ) + x ( 4,8 ) + x ( 5,8 ) + x ( 6,8 ) = 38
.
:
6
x ( i, j ) = d , j = 1, 2,...,8
j
i =1
d j . j
LINGO
@FOR(VENDORS(J):
;))@SUM(WAREHOUSES(I): VOLUME(I,J)) = DEMAND(J
LINGO )
( . VENDORS
VOLUME WAREHOUSES
DEMAND . .
:
84
)
)
Math Notation
LINGO Syntax
@FOR(VENDORS(J):
j = 1, 2,...,8
@SUM(WAREHOUSES(I):
6
i=1
)VOLUME(I,J
) x ( i, j
=
)DEMAND(J
dj
x ( i, j ) p , i = 1, 2,..., 6
j
j =1
p j ). j 8 (
LINGO
@FOR( WAREHOUSES( I):
;))@SUM( VENDORS( J): VOLUME( I, J)) <= CAPACITY( I
WAREHOUSES VOLUME VENDORS

CAPACITY .
LINGO:
MODEL:
MIN = @SUM( LINKS( I, J):
;))COST( I, J) * VOLUME( I, J
@FOR( VENDORS( J):
;))@SUM( WAREHOUSES( I): VOLUME( I, J)) = DEMAND( J
END
Model: WIDGETS
Sets Section
Data Section :
:

.
.
LINGO
.
Keyword SETS
ENDSETS . LINGO
) Set Looping Functions ( @FOR
.
:
-1 Warehouses
85
-2 Vendors
-3 Shipping Arcs
LINGO :
SETS:
;WAREHOUSES / WH1 WH2 WH3 WH4 WH5 WH6/: CAPACITY
VENDORS / V1 V2 V3 V4 V5 V6 V7 V8/
;: DEMAND
;LINKS( WAREHOUSES, VENDORS): COST, VOLUME
ENDSETS
SETS WAREHOUSES
WH2,,WH6 Attribute . CAPACITY
VENDORS V1,V2,,V8 . DEMAND
LINKS 48 COST VOLUME .
Syntax
) LINKS( WAREHOUSES, VENDORS LINGO LINKS
WAREHOUSES VENDORS LINGO 48
) (WAREHOUSES, VENDORS . LINKS
WH1,
:
:
DATA:
;CAPACITY = 60 55 51 43 41 52
;DEMAND = 35 37 22 32 41 32 43 38
COST = 6 2 6 7 4 2 5 9
4 9 5 3 8 5 8 2
5 2 1 9 7 4 3 3
7 6 7 3 9 2 7 1
2 3 9 5 7 2 6 5
;5 5 2 2 8 1 4 3
ENDDATA
DATA ENDDATA
. CAPACITY WAREHOUSES DEMAND VENDORS
. COST LINKS
LINGO :
COST(WH1,V1), COST(WH1,V2), COST(WH1,V3),,COST(WH1,V8),
COST(WH2,V1), COST(WH2,V2), COST(WH2,V3),,COST(WH2,V8),
)COST(WH6,V1), COST(WH6,V2 ), COST(WH6,V3),,COST(WH6,V8

EXCEL .
:
MODEL:
;! A 6 Warehouse 8 Vendor Transportation Problem
86
SETS:
WAREHOUSES / WH1 WH2 WH3 WH4 WH5 WH6/: CAPACITY;
: DEMAND;
LINKS( WAREHOUSES, VENDORS): COST, VOLUME;
ENDSETS
! The objective;
MIN = @SUM( LINKS( I, J):
COST( I, J) * VOLUME( I, J));
! The demand constraints;
@FOR( VENDORS( J):
@SUM( WAREHOUSES( I): VOLUME( I, J)) =
DEMAND( J));
! The capacity constraints;
@SUM( VENDORS( J): VOLUME( I, J)) <=
CAPACITY( I));
! Here is the data;
DATA:
CAPACITY = 60 55 51 43 41 52;
DEMAND = 35 37 22 32 41 32 43 38;
COST = 6 2 6 7 4 2 5 9
4 9 5 3 8 5 8 2
5 2 1 9 7 4 3 3
7 6 7 3 9 2 7 1
2 3 9 5 7 2 6 5
5 5 2 2 8 1 4 3;
ENDDATA
END
Comments
!
:
Global optimal solution found at step:
Objective value:
Variable
CAPACITY( WH1)
CAPACITY( WH2)
CAPACITY( WH3)
CAPACITY( WH4)
CAPACITY( WH5)
CAPACITY( WH6)
DEMAND( V1)
DEMAND( V2)
DEMAND( V3)
DEMAND( V4)
DEMAND( V5)
DEMAND( V6)
DEMAND( V7)
DEMAND( V8)
COST( WH1, V1)
COST( WH1, V2)
20
664.0000
Value
60.00000
55.00000
51.00000
43.00000
41.00000
52.00000
35.00000
37.00000
22.00000
32.00000
41.00000
32.00000
43.00000
38.00000
6.000000
2.000000
87
Reduced Cost
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
WH1,
WH1,
WH1,
WH1,
WH1,
WH1,
WH2,
WH2,
WH2,
WH2,
WH2,
WH2,
WH2,
WH2,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
WH1,
WH1,
WH1,
WH1,
WH1,
WH1,
WH1,
WH1,
WH2,
WH2,
WH2,
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
6.000000
7.000000
4.000000
2.000000
5.000000
9.000000
4.000000
9.000000
5.000000
3.000000
8.000000
5.000000
8.000000
2.000000
5.000000
2.000000
1.000000
9.000000
7.000000
4.000000
3.000000
3.000000
7.000000
6.000000
7.000000
3.000000
9.000000
2.000000
7.000000
1.000000
2.000000
3.000000
9.000000
5.000000
7.000000
2.000000
6.000000
5.000000
5.000000
5.000000
2.000000
2.000000
8.000000
1.000000
4.000000
3.000000
0.0000000
19.00000
0.0000000
0.0000000
41.00000
0.0000000
0.0000000
0.0000000
1.000000
0.0000000
0.0000000
88
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
5.000000
0.0000000
5.000000
7.000000
0.0000000
2.000000
2.000000
10.00000
0.0000000
4.000000
1.000000
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
WH2,
WH2,
WH2,
WH2,
WH2,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH3,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH4,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH5,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
WH6,
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
V1)
V2)
V3)
V4)
V5)
V6)
V7)
V8)
32.00000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
11.00000
0.0000000
0.0000000
0.0000000
0.0000000
40.00000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
5.000000
0.0000000
38.00000
34.00000
7.000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
22.00000
0.0000000
0.0000000
27.00000
3.000000
0.0000000
Row
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Slack or Surplus
664.0000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
22.00000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
1.000000
2.000000
2.000000
0.0000000
4.000000
0.0000000
0.0000000
9.000000
3.000000
4.000000
0.0000000
4.000000
4.000000
2.000000
4.000000
1.000000
3.000000
0.0000000
2.000000
0.0000000
0.0000000
0.0000000
7.000000
4.000000
2.000000
1.000000
2.000000
5.000000
3.000000
2.000000
0.0000000
1.000000
3.000000
0.0000000
0.0000000
3.000000
Dual Price
1.000000
-4.000000
-5.000000
-4.000000
-3.000000
-7.000000
-3.000000
-6.000000
-2.000000
3.000000
0.0000000
3.000000
1.000000
2.000000
2.000000
89
LINGO

. :
LINGO By Default

.
]
[ LINGO ][A Z
] [0 9 ] _ [ 32.
:
[OBJECTIVE] MIN = X; -1 OBJECTIVE .
-2
]@FOR( LINKS( I, J): [DEMAND_ROW
;))@SUM( SOURCES( I): SHIP( I, J)) >= DEMAND( J
DEMAND_ROW .

MODEL:
;! A 6 Warehouse 8 Vendor Transportation Problem
SETS:
;WAREHOUSES / WH1 WH2 WH3 WH4 WH5 WH6/: CAPACITY
;: DEMAND
;LINKS( WAREHOUSES, VENDORS): COST, VOLUME
ENDSETS
;! The objective
[OBJECTIVE] MIN = @SUM( LINKS( I, J):
;))COST( I, J) * VOLUME( I, J
;! The demand constraints
]@FOR( VENDORS( J): [DEMAND_ROW
;))@SUM( WAREHOUSES( I): VOLUME( I, J)) = DEMAND( J
;! The capacity constraints
]@FOR( WAREHOUSES( I): [CAPACITY_ROW
;! Here is the data
DATA:
;CAPACITY = 60 55 51 43 41 52
;DEMAND = 35 37 22 32 41 32 43 38
COST = 6 2 6 7 4 2 5 9
4 9 5 3 8 5 8 2
5 2 1 9 7 4 3 3
7 6 7 3 9 2 7 1
2 3 9 5 7 2 6 5
;5 5 2 2 8 1 4 3
ENDDATA
END
:
Dual Price
Slack or Surplus
90
Row
OBJECTIVE
DEMAND_ROW( V1)
DEMAND_ROW( V2)
DEMAND_ROW( V3)
DEMAND_ROW( V4)
DEMAND_ROW( V5)
DEMAND_ROW( V6)
DEMAND_ROW( V7)
DEMAND_ROW( V8)
CAPACITY_ROW( WH1)
CAPACITY_ROW( WH2)
CAPACITY_ROW( WH3)
CAPACITY_ROW( WH4)
CAPACITY_ROW( WH5)
CAPACITY_ROW( WH6)
664.0000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
22.00000
0.0000000
0.0000000
0.0000000
0.0000000
1.000000
-4.000000
-5.000000
-4.000000
-3.000000
-7.000000
-3.000000
-6.000000
-2.000000
3.000000
0.000000
3.000000
1.000000
2.000000
2.000000
:

: );( TITLE MODEL:
MODEL:
TITLE Widgets;
! A 6 Warehouse 8 Vendor Transportation Problem;
SETS:
WAREHOUSES / WH1 WH2 WH3 WH4 WH5 WH6/: CAPACITY;
.
.
91

: LINGO
.
:1
LINGO
Max 8 x1 + 5 x2
2 x1 + x2 1000
3 x1 + 4 x2 2400
x1 + x2 700
x1 x2 350
x1 , x2 0
:
S
C2
C1
1000
R1
2400
R2
700
R3
350
-1
R4
92
St
:
Global optimal solution found at iteration:
3
Objective value:
4360.000
Variable
Value
Reduced Cost
S( R1)
1000.000
0.000000
S( R2)
2400.000
0.000000
S( R3)
700.0000
0.000000
S( R4)
350.0000
0.000000
P( C1)
8.000000
0.000000
P( C2)
5.000000
0.000000
DV( C1)
320.0000
0.000000
DV( C2)
360.0000
0.000000
COEF( R1, C1)
2.000000
0.000000
COEF( R1, C2)
1.000000
0.000000
COEF( R2, C1)
3.000000
0.000000
COEF( R2, C2)
4.000000
0.000000
COEF( R3, C1)
1.000000
0.000000
COEF( R3, C2)
1.000000
0.000000
COEF( R4, C1)
1.000000
0.000000
COEF( R4, C2)
-1.000000
0.000000
Row
Slack or Surplus
Dual Price
1
4360.000
1.000000
2
0.000000
3.40000
3
0.000000
0.4000000
4
20.00000
0.000000
5
390.0000
0.000000
93
:2
: LINGO
Minimize 0.6 X 1 + 0.5 X 2

ST
20 X 1 + 50 X 2 100
25 X 1 + 25 X 2 100
50 X 1 + 10 X 2 100
X1, X 2 0
:
S
C2
C1
100
50
20
R1
100
25
25
R2
100
10
50
R3
0.5
0.6
94
:
3
Objective value:
2.150000
Variable
Value
Reduced Cost
S( R1)
100.0000
0.000000
S( R2)
100.0000
0.000000
S( R3)
100.0000
0.000000
P( C1)
0.6000000
0.000000
P( C2)
0.5000000
0.000000
DV( C1)
1.500000
0.000000
DV( C2)
2.500000
0.000000
COEF( R1, C1)
20.00000
0.000000
COEF( R1, C2)
50.00000
0.000000
COEF( R2, C1)
25.00000
0.000000
COEF( R2, C2)
25.00000
0.000000
COEF( R3, C1)
50.00000
0.000000
COEF( R3, C2)
10.00000
0.000000
Row
Slack or Surplus
Dual Price
1
2.150000
-1.000000
2
55.00000
0.000000
3
0.000000
-0.1900000E-01
4
0.000000
-0.2500000E-02
95
:3
: LINGO
Max. 12000 X 1 + 20000 X 2

6 X 2 27
St.
2 X1 +
X2 2
3 X1 +
X 2 19
X 1 , X 2 0 and integers
:
GS
LS
C2
C1
24
LR1
19
LR2
GR1
20000
12000
96
:
0
Objective value:
108000.0
Variable
Value
Reduced Cost
LS( LR1)
27.00000
0.000000
LS( LR2)
19.00000
0.000000
GS( GR1)
2.000000
0.000000
P( C1)
12000.00
0.000000
P( C2)
20000.00
0.000000
DV( C1)
4.000000
-12000.00
DV( C2)
3.000000
-20000.00
CO1( LR1, C1)
2.000000
0.000000
CO1( LR1, C2)
6.000000
0.000000
CO1( LR2, C1)
3.000000
0.000000
CO1( LR2, C2)
1.000000
0.000000
CO2( GR1, C1)
0.000000
0.000000
CO2( GR1, C2)
1.000000
0.000000
Row
Slack or Surplus
Dual Price
1
108000.0
1.000000
2
1.000000
0.000000
3
4.000000
0.000000
4
1.000000
0.000000
97
:4
: LINGO
Warehoise
D1=1100
W1
35
Plant
S1=1200
P1
37
30
D2=400
W2
40
40 40
S2=1000
P2
42
32
15
D3=750
W3
2
20 5
S3=800
P3
28
D4=750
W4
LP
Min 35 X 11 + 30 X 12 + 40 X 13 + 32 X 14 + 37 X 21 + 40 X 22 + 42 X 23 + 25 X 24 + 40 X 31 + 15 X 32 + 20 X 33 + 28 X 34
St
X 11 +
X 12 +
X 13 +
X 14
1200
X 21 +
X 22 +
X 23 +
X 24
1000
X 31 +
X 11
X 21
X 12
+
+ X 22
X 13
X 23
X 14
+
X ij 0,
X 33 +
X 34 800
X 31
=1100
+
X 32 +
X 32
=400
+ X 33
X 24
=750
+ X 34 = 750
for all i and j
98
DM
C1 C2 C3 C4 C5 C6 C7 C8 C9 C10 C11 C12 SPL

1
1200
1
1000
1 800
1100
1
1
750
SR2
SR3
400
750
SR1 1 1
DR1 1
1
1
1
1
DR2
DR3
DR4
CST 35 30 40 32 37 40 42 25 40 15 20 28
:
: .
99
:5
: LINGO

:
Assembly
Line
1
2
3
4
5
Inspection Area
A
B
C
10
11
13
14
19
10
9
14
17
20
12
14
15
17
19
4
7
8
16
11
6
7
12
13
17
LP
Min 10 X 1 A + 4 X 1B + 6 X 1C + 10 X 1D + 12 X 1E +
11X 2 A + 7 X 2 B + 7 X 2C + 9 X 2 D + 14 X 2 E +
13 X 3 A + 8 X 3 B + 12 X 3C + 14 X 3 D + 15 X 3 E +
14 X 4 A + 16 X 4 B + 13 X 4C + 17 X 4 D + 17 X 4 E +
19 X 5 A + 11X 5 B + 17 X 5C + 20 X 5 D + 19 X 5 E
St
X1A +
X 1B +
X 1C +
X 1D +X 1E =1
X2A +
X 2B +
X 2C +
X 2 D + X 2 E =1
X 3A +
X 3B +
X 3C +
X 3D + X 3E = 1
X4A +
X 4B +
X 4C +
X 4D + X 4E = 1
X5A +
X 5B +
X 5C +
X 5D + X 5E = 1
X1A +
X2A +
X 3 A + X 4 A + X 5 A =1
X 1B +
X 2B +
X 3 B + X 4 B + X 5 B =1
X 1C +
X 2C +
X 3C + X 4C + X 5C =1
X 1D +
X 2D +
X 3 D + X 4 D + X 5 D =1
X 1E +
X 2E +
X 3 E + X 4 E + X 5 E =1
X ij 0,
for all i and j

100
101
: .
: LINGO LINDO WinQSB Excel SOLVER
.
102
:6
) 1 ( ) 12 ( .
599
180
49
691
420
432
44
0
4
5
34
893
554
2
43
1
62
280
577
8
9
0
50
0
29
10
6
11
403
12
314
11
F ( i ) = MIN D ( i, j ) + F ( j )
j
) F(i i ) D(i,j i
. j i
103
i i
.
:
104
:
Feasible solution found at iteration:
0
Variable
F( 1)
F( 2)
F( 3)
F( 4)
F( 5)
F( 6)
F( 7)
F( 8)
F( 9)
F( 10)
F( 11)
F( 12)
D( 1, 2)
D( 1, 3)
D( 1, 4)
D( 2, 5)
D( 2, 6)
D( 3, 4)
D( 3, 7)
D( 4, 6)
D( 5, 6)
D( 5, 9)
D( 6, 8)
D( 6, 9)
D( 7, 8)
D( 7, 10)
D( 8, 9)
D( 8, 10)
D( 9, 12)
D( 10, 11)
D( 10, 12)
D( 11, 12)
Row
1
2
3
4
5
6
7
8
9
10
11
12
105
Value
1731.000
1309.000
1666.000
1234.000
822.0000
889.0000
903.0000
693.0000
268.0000
403.0000
314.0000
0.000000
599.0000
180.0000
497.0000
691.0000
420.0000
432.0000
893.0000
345.0000
440.0000
554.0000
432.0000
621.0000
280.0000
500.0000
577.0000
290.0000
268.0000
116.0000
403.0000
314.0000
Slack or Surplus
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
:1
1 11 :
8
7
11
10
1
6
:2
Excel Solver .
106
5
2
6
4
1
3
:7

Source
1
10
10
12
4
12
2
4
2
Tank
) 1000/(
7
7
8
2
6
6
4
3
2
4
8
TO
3
10
1
12
2
2
10
1
107
1
1
2
3
4
5
6
7
F
R
O
M
:
! Max flow Problem;
! Given upper limits on the flow on each arc, find the maximum
flow from node 1 to node 7;
MODEL:
SETS:
NODE : ;
ARC( NODE, NODE):
UPPERLIM, ! The distance matrix;
X; ! X( I, J) = 1 if we use ARC I, J;
ENDSETS
DATA:
NODE = 1
2
3
4
5
6
7;! UPPERLIM matrix;
UPPERLIM = 0
10 10 0
0
0
0 ! 1;
0
0
1
8
0
6
0 ! 2;
0
1
0
0
12 4
0 ! 3;
0
0
0
0
0
3
7 ! 4;
0
0
0
0
0
2
8 ! 5;
0
0
4
3
2
0
2 ! 6;
0
0
0
0
0
0
0;! 7;
ENDDATA
!------------------------------------------------------------;
N = @SIZE( NODE);
! Maximize the flow into the last NODE;
MAX = @SUM( NODE( I)| I #LT# N : X( I, N));
! Upper limit on flow on each arc;
@FOR( ARC( I, J):
@BND( 0, X( I, J), UPPERLIM( I, J));
);
! For NODE K, except first and last, ... ;
@FOR( NODE( K)| K #GT# 1 #AND# K #LT# N:
! Inflow = outflow;
@SUM( NODE( I)| I #NE# K: X( I, K)) =
@SUM( NODE( J)| J #NE# K: X( K, J));
);
END
:
Global optimal solution found.
Objective value:
Total solver iterations:
17.00000
7
Variable
N
UPPERLIM( 1, 1)
UPPERLIM( 1, 2)
UPPERLIM( 1, 3)
UPPERLIM( 1, 4)
UPPERLIM( 1, 5)
UPPERLIM( 1, 6)
UPPERLIM( 1, 7)
UPPERLIM( 2, 1)
UPPERLIM( 2, 2)
Value
7.000000
0.000000
10.00000
10.00000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
108
Reduced Cost
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
UPPERLIM(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
2,
2,
2,
2,
2,
3,
3,
3,
3,
3,
3,
3,
4,
4,
4,
4,
4,
4,
4,
5,
5,
5,
5,
5,
5,
5,
6,
6,
6,
6,
6,
6,
6,
7,
7,
7,
7,
7,
7,
7,
1,
1,
1,
1,
1,
1,
1,
2,
2,
2,
2,
2,
2,
2,
3,
3,
3,
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
1.000000
8.000000
0.000000
6.000000
0.000000
0.000000
1.000000
0.000000
0.000000
12.00000
4.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
3.000000
7.000000
0.000000
0.000000
0.000000
0.000000
0.000000
2.000000
8.000000
0.000000
0.000000
4.000000
3.000000
2.000000
0.000000
2.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
7.000000
10.00000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
4.000000
0.000000
4.000000
0.000000
0.000000
1.000000
0.000000
109
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
X(
3,
3,
3,
3,
4,
4,
4,
4,
4,
4,
4,
5,
5,
5,
5,
5,
5,
5,
6,
6,
6,
6,
6,
6,
6,
7,
7,
7,
7,
7,
7,
7,
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
1)
2)
3)
4)
5)
6)
7)
0.000000
6.000000
3.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
7.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
8.000000
0.000000
0.000000
0.000000
3.000000
2.000000
0.000000
2.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
Row
1
2
3
4
5
6
7
Slack or Surplus
0.000000
17.00000
0.000000
0.000000
0.000000
0.000000
0.000000
110
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
-1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
Dual Price
0.000000
1.000000
0.000000
0.000000
0.000000
0.000000
0.000000
:8

MODEL:
TITLE Linear Regression with one independent variable;
!For this model we wish to
predict Y with the equation: Y(i) = CONS + SLOPE * X(i);
SETS:
! The OBS set contains the data points for X and Y;
OBS/1..15/:
Y,
X;
OBSN( OBS): XS, YS;
ENDSETS
DATA:
Y =
4360 4590 4520 4770 4760 5070 5230 5080 5550 5390 5670 5490 5810
6060 5940;
X =
1310 1313 1320 1322 1338 1340 1347 1355 1360 1364 1373 1376 1384
1395 1400;
ENDDATA
NK = @SIZE( OBS);
XBAR = @SUM( OBS: X)/ NK;
YBAR = @SUM( OBS: Y)/ NK;
@FOR( OBS( I):
XS( I) = X( I) - XBAR;
YS( I) = Y( I) - YBAR;
@FREE( XS(I)); @FREE( YS( I));
);
XYBAR = @SUM( OBSN: XS * YS);
XXBAR = @SUM( OBSN: XS * XS);
YYBAR = @SUM( OBSN: YS * YS);
SLOPE = XYBAR/ XXBAR;
CONS = YBAR - SLOPE * XBAR;
RESID = @SUM( OBSN: ( YS - SLOPE * XS)^2);
RSQRU = 1 - RESID/ YYBAR;
RSQRA = 1 - ( RESID/ YYBAR) * ( NK - 1)/( NK - 2);
@FREE( CONS); @FREE( SLOPE);
END
111
:
Feasible solution found.
Model Title: Linear Regression with one independent variable

Variable
NK
XBAR
YBAR
XYBAR
XXBAR
YYBAR
SLOPE
CONS
RESID
RSQRU
RSQRA
Y( 1)
Y( 2)
Y( 3)
Y( 4)
Y( 5)
Y( 6)
Y( 7)
Y( 8)
Y( 9)
Y( 10)
Y( 11)
Y( 12)
Y( 13)
Y( 14)
Y( 15)
X( 1)
X( 2)
X( 3)
X( 4)
X( 5)
X( 6)
X( 7)
X( 8)
X( 9)
X( 10)
X( 11)
X( 12)
X( 13)
X( 14)
X( 15)
XS( 1)
XS( 2)
XS( 3)
XS( 4)
XS( 5)
XS( 6)
XS( 7)
XS( 8)
112
Value
15.00000
1353.133
5219.333
214541.3
11965.73
4068093.
17.92964
-19041.86
221443.7
0.9455657
0.9413785
4360.000
4590.000
4520.000
4770.000
4760.000
5070.000
5230.000
5080.000
5550.000
5390.000
5670.000
5490.000
5810.000
6060.000
5940.000
1310.000
1313.000
1320.000
1322.000
1338.000
1340.000
1347.000
1355.000
1360.000
1364.000
1373.000
1376.000
1384.000
1395.000
1400.000
-43.13333
-40.13333
-33.13333
-31.13333
-15.13333
-13.13333
-6.133333
1.866667
XS( 9)
XS( 10)
XS( 11)
XS( 12)
XS( 13)
XS( 14)
XS( 15)
YS( 1)
YS( 2)
YS( 3)
YS( 4)
YS( 5)
YS( 6)
YS( 7)
YS( 8)
YS( 9)
YS( 10)
YS( 11)
YS( 12)
YS( 13)
YS( 14)
YS( 15)
Row
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
113
6.866667
10.86667
19.86667
22.86667
30.86667
41.86667
46.86667
-859.3333
-629.3333
-699.3333
-449.3333
-459.3333
-149.3333
10.66667
-139.3333
330.6667
170.6667
450.6667
270.6667
590.6667
840.6667
720.6667
Slack or Surplus
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
34
35
36
37
38
39
40
41
114
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
:9
:Knapsack problem
) (
.

.
15 . :
Rating
2
9
3
8
10
6
4
10
Item
Weight
Ant Repellent
1
Pepsi
3
Blanket
4
Meat
3
Cakes
3
Football
1
Salad
5
Watermelon
10
----------------------------Sum
30
.
MODEL:
SETS:
ITEMS / ANT_REPEL, PEPSI, BLANKET,
MEAT, CAKES, FOOTBALL, SALAD,
WATERMELON/:
;INCLUDE, WEIGHT, RATING
ENDSETS
DATA:
= WEIGHT RATING
1
2
3
9
4
3
3
8
115
3
10
1
6
5
4
10
10;
KNAPSACK_CAPACITY = 15;
ENDDATA
MAX = @SUM( ITEMS: RATING * INCLUDE);
@SUM( ITEMS: WEIGHT * INCLUDE) <=
KNAPSACK_CAPACITY;
@FOR( ITEMS: @BIN( INCLUDE));
END
MODEL:
SETS:
ITEMS :
INCLUDE, WEIGHT, RATING;
ENDSETS
DATA:
ITEMS =Bread, Juice, Blanket, Meat,
Cake, Ball, Salad, Watermelon;
WEIGHT RATING =
1
2
3
9
4
3
3
8
3
10
1
6
5
4
10
10;
KNAPSACK_CAPACITY = 15;
ENDDATA
MAX = @SUM( ITEMS: RATING * INCLUDE);
@SUM( ITEMS: WEIGHT * INCLUDE) <=
KNAPSACK_CAPACITY;
@FOR( ITEMS: @BIN( INCLUDE));
END
:
Objective value:
38.00000
116
Extended solver steps:

0
0
Variable
KNAPSACK_CAPACITY
INCLUDE( BREAD)
INCLUDE( JUICE)
INCLUDE( BLANKET)
INCLUDE( MEAT)
INCLUDE( CAKE)
INCLUDE( BALL)
INCLUDE( SALAD)
INCLUDE( WATERMELON)
WEIGHT( BREAD)
WEIGHT( JUICE)
WEIGHT( BLANKET)
WEIGHT( MEAT)
WEIGHT( CAKE)
WEIGHT( BALL)
WEIGHT( SALAD)
WEIGHT( WATERMELON)
RATING( BREAD)
RATING( JUICE)
RATING( BLANKET)
RATING( MEAT)
RATING( CAKE)
RATING( BALL)
RATING( SALAD)
RATING( WATERMELON)
Row
1
2
Value
15.00000
1.000000
1.000000
1.000000
1.000000
1.000000
1.000000
0.000000
0.000000
1.000000
3.000000
4.000000
3.000000
3.000000
1.000000
5.000000
10.00000
2.000000
9.000000
3.000000
8.000000
10.00000
6.000000
4.000000
10.00000
Slack or Surplus
38.00000
0.000000
117
Reduced Cost
0.000000
-2.000000
-9.000000
-3.000000
-8.000000
-10.00000
-6.000000
-4.000000
-10.00000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
Dual Price
1.000000
0.000000
:10
:Markov chain model
e = 1 P = = { 1 , 2 , , n }
:
0.75
0.4
P=
0.1
0.2
0.1 0.05 0.1
0.2 0.1 0.3

0.2 0.4 0.3
0.2 0.3 0.3
:
MODEL:
SETS:
STATE/ A B C D/: SPROB;
SXS( STATE, STATE): TPROB;
ENDSETS
DATA:
TPROB = .75
.4
.1
.2
ENDDATA
.1
.2
.2
.2
.05
.1
.4
.3
.1000001
.3
.3
.3;
@FOR( STATE( J)| J #LT# @SIZE( STATE):

SPROB( J) = @SUM( SXS( I, J): SPROB( I) *
TPROB( I, J))
);
@SUM( STATE: SPROB) = 1;
END

:
@FOR( STATE( I):
@WARN( 'Probabilities in a row must sum to 1.',
@ABS( 1 - @SUM( SXS( I, K): TPROB( I, K)))
#GT# .000001);
);
:
Feasible solution found.
118
119
Variable
SPROB( A)
SPROB( B)
SPROB( C)
SPROB( D)
TPROB( A, A)
TPROB( A, B)
TPROB( A, C)
TPROB( A, D)
TPROB( B, A)
TPROB( B, B)
TPROB( B, C)
TPROB( B, D)
TPROB( C, A)
TPROB( C, B)
TPROB( C, C)
TPROB( C, D)
TPROB( D, A)
TPROB( D, B)
TPROB( D, C)
TPROB( D, D)
Value
0.4750000
0.1525000
0.1675000
0.2050000
0.7500000
0.1000000
0.5000000E-01
0.1000000
0.4000000
0.2000000
0.1000000
0.3000000
0.1000000
0.2000000
0.4000000
0.3000000
0.2000000
0.2000000
0.3000000
0.3000000
Row
1
2
3
4
Slack or Surplus
0.000000
0.000000
0.000000
0.000000
LINGO :

LINGO
*.ldt LINGO
Excel Oracle Access.
: *.ldt
WIDGETS2.LDT \C:\LINGO7
@FILE:
WIDGETS2.LDT :
;!List of warehouses
~ WH1 WH2 WH3 WH4 WH5 WH6
;!List of vendors
~ V1 V2 V3 V4 V5 V6 V7 V8
;!Warehouse capacities
~ 60 55 51 43 41 52
;!Vendor requirements
~ 35 37 22 32 41 32 43 38
;!Unit shipping costs
6 2 6 7 4 2 5 9
4 9 5 3 8 5 8 2
5 2 1 9 7 4 3 3
120
7 6 7 3 9 2 7 1
2 3 9 5 7 2 6 5
5 5 2 2 8 1 4 3
)~ (
@FILE .
@TEXT
VOLUME
;@TEXT('WIDGET2OUT.TXT')= VOLUME

0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
40.000000
0.0000000
0.0000000
0.0000000
0.0000000
22.000000
3.0000000
0.0000000
0.0000000
32.000000
0.0000000
0.0000000
0.0000000
0.0000000
38.000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
41.000000
1.0000000
0.0000000
0.0000000
0.0000000
0.0000000
0.0000000
34.000000
0.0000000
0.0000000
0.0000000
19.000000
0.0000000
0.0000000
0.0000000
11.000000
0.0000000
0.0000000
5.0000000
7.0000000
0.0000000
0.0000000
27.000000
:
1 11 :
8
7
11
10
5
2
1
6
6
4
1
3
C:\\DATA\net1.ldt
. C:\\DATA\net1out.txt
121
LINGO :Excel
Excel:
122
Insert Name Define
123
) =Sheet1!$C$4:$J$9 (.
:
124
WIDGETSXL.XLS \C:\LINGO7
WIDGETSXL.XLS
VOLUME .
LINGO Excel
125
LINGO Excel
126
:1
LINGO . Excel
Max 8 x1 + 5 x2
2 x1 + x2 1000
3 x1 + 4 x2 2400
x1 + x2 700
x1 x2 350
x1 , x2 0
127
St
Excel or433exp01.xls
: .
:
LINGO
128
LINGO
MODEL:
SETS:
PLANTS: CAPACITY;
CUSTOMERS : DEMAND;
LINKS(PLANTS, CUSTOMERS): COST, VOLUME;
ENDSETS
MIN = @SUM(LINKS(I, J):
COST(I, J) * VOLUME(I, J));
@FOR(CUSTOMERS(J):@SUM(PLANTS(I):VOLUME(I, J)) = DEMAND(J));
@FOR(PLANTS(I):@SUM(CUSTOMERS(J): VOLUME(I, J))<= CAPACITY(I));
DATA:
PLANTS, CUSTOMERS, CAPACITY, DEMAND, COST =@OLE();
@OLE()= VOLUME;
ENDDATA
END

PLANTS, CUSTOMERS, CAPACITY, DEMAND, COST =@OLE();

@OLE()= VOLUME;
129

Objective value:
Infeasibilities:
664.0000
0.000000
15
Export Summary Report

--------------------Transfer Method:
OLE BASED
Workbook:
Book1.xls
Ranges Specified:
1
VOLUME
Ranges Found:
1
Range Size Mismatches:
0
Values Transferred:
48
Variable
CAPACITY( P1)
CAPACITY( P2)
CAPACITY( P3)
CAPACITY( P4)
CAPACITY( P5)
CAPACITY( P6)
DEMAND( C1)
DEMAND( C2)
DEMAND( C3)
DEMAND( C4)
DEMAND( C5)
DEMAND( C6)
DEMAND( C7)
DEMAND( C8)
COST( P1, C1)
COST( P1, C2)
COST( P1, C3)
Value
60.00000
55.00000
51.00000
43.00000
41.00000
52.00000
35.00000
37.00000
22.00000
32.00000
41.00000
32.00000
43.00000
38.00000
6.000000
2.000000
6.000000
130
Reduced Cost
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
COST(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
P1,
P1,
P1,
P1,
P1,
P2,
P2,
P2,
P2,
P2,
P2,
P2,
P2,
P3,
P3,
P3,
P3,
P3,
P3,
P3,
P3,
P4,
P4,
P4,
P4,
P4,
P4,
P4,
P4,
P5,
P5,
P5,
P5,
P5,
P5,
P5,
P5,
P6,
P6,
P6,
P6,
P6,
P6,
P6,
P6,
P1,
P1,
P1,
P1,
P1,
P1,
P1,
P1,
P2,
P2,
P2,
P2,
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
7.000000
4.000000
2.000000
5.000000
9.000000
4.000000
9.000000
5.000000
3.000000
8.000000
5.000000
8.000000
2.000000
5.000000
2.000000
1.000000
9.000000
7.000000
4.000000
3.000000
3.000000
7.000000
6.000000
7.000000
3.000000
9.000000
2.000000
7.000000
1.000000
2.000000
3.000000
9.000000
5.000000
7.000000
2.000000
6.000000
5.000000
5.000000
5.000000
2.000000
2.000000
8.000000
1.000000
4.000000
3.000000
0.000000
19.00000
0.000000
0.000000
41.00000
0.000000
0.000000
0.000000
1.000000
0.000000
0.000000
32.00000
131
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
5.000000
0.000000
5.000000
7.000000
0.000000
2.000000
2.000000
10.00000
0.000000
4.000000
1.000000
0.000000
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
VOLUME(
P2,
P2,
P2,
P2,
P3,
P3,
P3,
P3,
P3,
P3,
P3,
P3,
P4,
P4,
P4,
P4,
P4,
P4,
P4,
P4,
P5,
P5,
P5,
P5,
P5,
P5,
P5,
P5,
P6,
P6,
P6,
P6,
P6,
P6,
P6,
P6,
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
C1)
C2)
C3)
C4)
C5)
C6)
C7)
C8)
0.000000
0.000000
0.000000
0.000000
0.000000
11.00000
0.000000
0.000000
0.000000
0.000000
40.00000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
5.000000
0.000000
38.00000
34.00000
7.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
22.00000
0.000000
0.000000
27.00000
3.000000
0.000000
Row
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Slack or Surplus
664.0000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
22.00000
0.000000
0.000000
0.000000
0.000000
132
1.000000
2.000000
2.000000
0.000000
4.000000
0.000000
0.000000
9.000000
3.000000
4.000000
0.000000
4.000000
4.000000
2.000000
4.000000
1.000000
3.000000
0.000000
2.000000
0.000000
0.000000
0.000000
7.000000
4.000000
2.000000
1.000000
2.000000
5.000000
3.000000
2.000000
0.000000
1.000000
3.000000
0.000000
0.000000
3.000000
Dual Price
-1.000000
-4.000000
-5.000000
-4.000000
-3.000000
-7.000000
-3.000000
-6.000000
-2.000000
3.000000
0.000000
3.000000
1.000000
2.000000
2.000000
:Database
Excel
Database
Management Systems (DBMS)
LINGO .
) Open Database Connectivity (ODBC) Driver
.( DBMS
DBMS LINGO @ ODBC
.WINDOWS
SAMPLES\TRANDB.LG4
MODEL:
! A 3 Plant, 4 Customer Transportation Problem;
! Data is retrieved from an ODBC link. You *MUST*
use the ODBC Administrator to register one of the
supplied databases under the name "Transportation"
in order to get this model to run. Refer to Chapter
10 for more details.;
TITLE Transportation;
SETS:
PLANTS: CAPACITY;
CUSTOMERS: DEMAND;
ARCS( PLANTS, CUSTOMERS): COST, VOLUME;
ENDSETS
! The objective;
[OBJ] MIN = @SUM( ARCS: COST * VOLUME);
! The demand constraints;
@FOR( CUSTOMERS( C):
@SUM( PLANTS( P): VOLUME( P, C)) >= DEMAND( C));
! The supply constraints;
@FOR( PLANTS( P):
@SUM( CUSTOMERS( C): VOLUME( P, C)) <= CAPACITY( P));
DATA:
! Import the data via ODBC;
PLANTS, CAPACITY
= @ODBC();
CUSTOMERS, DEMAND
= @ODBC();
ARCS, COST
= @ODBC();
! Export the solution via ODBC;
@ODBC() = VOLUME;
ENDDATA
END
133
@ODBC
ODBC .
ODBC .LINGO
ODBC :
-1 DBMS .ODBC Driver
-2 ).ODBC Adminstrator (ODBCA
ODBC
Windows Access Oracle:
-1 Control Panel Adminstrative Tools Data Sources
): (ODBC
134
Add
) Microsoft Access Driver(*.mdb Finish

135
Transportation
) ( Select
) LINGO11 (
136
Samples
TRANDB.mbd OK
137
OK OK
.
Access
138
Arcs
Customers
139
Plants
LINGO
140
:
Objective value:
Infeasibilities:
161.0000
0.000000
6
Export Summary Report

--------------------Transfer Method:
ODBC BASED
ODBC Data Source:
Transportation
Data Table Name:
ARCS
Columns Specified:
1
VOLUME
LINGO Column Length:
12
Database Column Length:
12
Model Title: Transportation
Variable
CAPACITY( PLANT1)
CAPACITY( PLANT2)
CAPACITY( PLANT3)
DEMAND( CUST1)
DEMAND( CUST2)
DEMAND( CUST3)
DEMAND( CUST4)
COST( PLANT1, CUST1)
VOLUME( PLANT1, CUST1)
Row
OBJ
2
Value
30.00000
25.00000
21.00000
15.00000
17.00000
22.00000
12.00000
6.000000
2.000000
6.000000
7.000000
4.000000
9.000000
5.000000
3.000000
8.000000
8.000000
1.000000
5.000000
2.000000
17.00000
1.000000
0.000000
13.00000
0.000000
0.000000
12.00000
0.000000
0.000000
21.00000
0.000000
Slack or Surplus
161.0000
0.000000
141
Reduced Cost
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
0.000000
2.000000
0.000000
9.000000
1.000000
0.000000
7.000000
11.00000
0.000000
5.000000
Dual Price
-1.000000
-6.000000
-2.000000
-6.000000
-5.000000
0.000000
2.000000
5.000000
3
4
5
6
7
8
0.000000
0.000000
0.000000
10.00000
0.000000
0.000000
Access
142
4 3 . 200
50 :
-1 Remove
143
Yes
144
145
) ( .
146
:Access
147
148
149
150

:R
.R 144 :
-1
Create a function from a formula
: makeFun
makeFun(object, ...)
var = val ... . object
.
Examples
library(mosaic)
f <- makeFun( sin(x^2 * b) ~ x & y & a); f
g <- makeFun( sin(x^2 * b) ~ x & y & a, a=2 ); g
h <- makeFun( a * sin(x^2 * b) ~ b & y, a=2, y=3); h
model <- lm(wage ~ poly(exper,degree=2), data=CPS85)
fit <- makeFun(model)
xyplot(wage ~ exper, data=CPS85)
plotFun(fit(exper) ~ exper, add=TRUE)
model <- glm(wage ~ poly(exper,degree=2), data=CPS85,
family=gaussian)
151
model <- nls( wage ~ A + B * exper + C * exper^2,

data=CPS85, start=list(A=1,B=1,C=1) )
-2
Numerical Derivatives
. numD
:
numD(formula, ..., .hstep = NULL, add.h.control = FALSE)
setInterval(C, wrt, h)
setCorners(C, var1, var2, h)
dfdx(.function, .wrt, .hstep)
d2fdxdy(.function, .var1, .var2, .hstep)
d2fdx2(.function, .wrt, .hstep)
numerical.first.partial(f, wrt, h, av)
numerical.second.partial(f, wrt, h, av)
numerical.mixed.partial(f, var1, var2, h, av)
:
152
Arguments
formula
. ...
. .hstep
. add.h.control
Examples
library(mosaic)
g = numD( a*x^2 + x*y ~ x, a=1)
g(x=2,y=10)
gg = numD( a*x^2 + x*y ~ x&x, a=1)
gg(x=2,y=10)
ggg = numD( a*x^2 + x*y ~ x&y, a=1)
ggg(x=2,y=10)
h = numD( g(x=x,y=y,a=a) ~ y, a=1)
h(x=2,y=10)
f = numD( sin(x)~x, add.h.control=TRUE)
plotFun( f(3,.hstep=h)~h, hlim=range(.00000001,.000001))
ladd( panel.abline(cos(3),0))
153
-3
Numerical Differentiation
fderiv 1 4
.Finite Difference
:
)fderiv(f, x, n = 1, h = 0, method="central", ...
:
f .
x .
n 1 . 4
h ) 0 (.
method :
central, forward, or backward.
... .
Examples
)library(pracma
## Not run:
f <- sin
)xs <- seq(-pi, pi, length.out = 100
)ys <- f(xs
)"y1 <- fderiv(f, xs, n = 1, method = "backward
)"y2 <- fderiv(f, xs, n = 2, method = "backward
154
y3 <- fderiv(f, xs, n = 3, method = "backward")

y4 <- fderiv(f, xs, n = 4, method = "backward")
plot(xs, ys, type = "l", col = "gray", lwd = 2,
xlab = "", ylab = "", main = "Sinus and its
Derivatives")
lines(xs, y1, col=1, lty=2)
grid()
## End(Not run)
-4
Numerical integration
:
1- Euler
2- Runge-Kutta 4th order
3- Monte Carlo
4- RK4 with discontinuities
5- Ramos method.
:
euler(x0, t, f, p, dt)
RK4(x0, t, f, p, dt)
rnum(x0, t, f, p, dt, n)
RK4D(x0, t, f, p, dt, g, tz)
ramos(x0, t, f, p, dt)
X )( euler
dX/dt = f(t,p,X)
155
RK4 RK 4
)dX/dt = f(t,p,X
.
rnum .euler
RK4D .
ramos .
:
x0
initial condition
t
times for output
f )
right hand side of ODE
p.
dt .
n .
g .
tz .
156
Examples
library(seem)
# Euler
model <- list(f=expon)
t <- seq(0,10,1); dt <- 0.001
p <- 0.1; X0 <- 1
X <- euler(X0, t, model$f, p, dt)
# Runge-Kutta
t <- seq(0,10,1); dt <- 0.001
p <- 0.1; X0 <- 1
X <- RK4(X0, t, model$f, p, dt)
# Stochastic
t <- seq(0,10,1); dt <- 0.001
p <- c(0.1,0.01); X0 <- 1
X <- rnum(X0, t, model$f, p, dt,n=20)
# RK4 with discontinuities
model <- list(f=expon,z=expon.z,g=expon.g)
t <- seq(0,100,1); dt <- 0.01
p <- c(0.02,10,0,-10); X0 <- 100
X <- RK4D(X0, t, model$f, p, dt, model$g, model$z(t,p,X))
-5
Derivative and Anti-derivative operators
: .
D(formula, ..., .hstep = NULL, add.h.control = FALSE)
antiD(formula, ..., lower.bound = 0,force.numeric = FALSE)
157
= makeAntiDfun(.function, .wrt, from,.tol

).Machine$double.eps^0.25
= numerical.integration(f, wrt, av, args, vi.from, ciName
)"C", .tol
:
formula.
... .
.hstep .
add.h.control .
lower.bound .
force.numeric TRUE
.symbolic integral
.function .
.wrt .
from .
f.
wrt .
av .
args .
.tol .
Examples
)library(mosaic
)D(sin(t) ~ t
) D(A*sin(t) ~ t
D(A*sin(2*pi*t/P) ~ t, A=2, P=10) # default values for
parameters.
158
f <- D(A*x^3 ~ x + x, A=1) # 2nd order partial -- note,

it's a function of x
f(x=2)
f(x=2,A=10) # override default value of parameter A
g <- D(f(x=t, A=1)^2 ~ t)
# note: it's a function of t
g(t=1)
gg <- D(f(x=t, A=B)^2 ~ t, B=10)
# note: it's a function
of t and B
gg(t=1)
gg(t=1, B=100)
f <- makeFun(x^2~x)
D(f(cos(z))~z) #will look in user functions also
antiD( a*x^2 ~ x)
antiD( A/x~x )
F <- antiD( A*exp(-k*t^2 ) ~ t, A=1, k=0.1)
F(t=Inf)
one = makeFun(1~x&y)
by.x = antiD( one(x=x, y=y) ~x)
by.xy = antiD(by.x(x=sqrt(1-y^2), y=y)~y)
4*by.xy(y=1) #area of quarter circle
-6
Symbolic Derivatives
: .
symbolicD(formula, ..., .order = NULL)
:
. formula
. ...
. .order
159
Examples
library(mosaic)
symbolicD( a*x^2 ~ x)
symbolicD( a*x^2 ~ x&x)
symbolicD( a*sin(x)~x, .order=4)
symbolicD( a*x^2*y+b*y ~ x, a=10, b=100 )
-7
Plotting mathematical expressions
: plotFun
plotFun(object, ..., add = FALSE, xlim = NULL,
ylim = NULL, npts = NULL, ylab = NULL, xlab = NULL,
zlab = NULL, filled = TRUE, levels = NULL,
nlevels = 10, labels = TRUE, surface = FALSE,
groups = NULL, col.regions = topo.colors, type = "l",
alpha = NULL)
:
. object
. TRUE add
. xlim
. ylim
. npts
. xlab
. ylab
.surface-plot zlab
. col
160
. filled
. levels
. nlevels
. FALES labels
. surface
. col.regions
. type
. ) ( 1 )( 0 alpha
.Lattice graphics groups
. ...
Examples
library(mosaic)
plotFun( a*sin(x^2)~x, xlim=range(-5,5), a=2 )
plotFun( u^2 ~ u, ulim=c(-4,4) )
plotFun( y^2 ~ y, ylim=c(-2,20), y.lim=c(-4,4) )
plotFun( x^2 -3 ~ x, xlim=c(-4,4), grid=TRUE )
ladd( panel.abline(h=0,v=0,col='gray50') )
plotFun( (x^2 -3) * (x^2 > 3) ~ x, type='h', alpha=.1,
lwd=4, col='lightblue', add=TRUE )
plotFun( sin(x) ~ x,
groups=cut(x, findZeros(sin(x) ~ x, within=10)$x),
col=c('blue','green'), lty=2, lwd=3, xlim=c(-10,10) )
plotFun( sin(2*pi*x/P)*exp(-k*t)~x+t,k=2,P=.3)
f <- rfun( ~ u & v )
plotFun( f(u=u,v=v) ~ u & v, u.lim=range(-3,3),
v.lim=range(-3,3) )
plotFun( u^2 + v < 3 ~ u & v, add=TRUE, npts=200 )
161
model <- lm(wage ~ poly(exper,degree=2), data=CPS85)

plotFun(fit(exper) ~ exper, add=TRUE, lwd=8)
plotFun(fit, add=TRUE, lwd=2, col='white')
plotFun( sin(k*x)~x, k=0.01 )
162
:R
R
.
' Package 'Rglpk R GNU Linear
Programing Kit GLPK
.
' Package 'lpSolve
.
' Package 'linprog
.Simplex Algorithm
: Rglpk :
= Rglpk_solve_LP(obj, mat, dir, rhs, types = NULL, max
)FALSE, bounds = NULL, verbose = FALSE
:
obj .
mat .
dir ">"."==" or ,"=<" ,"<" ,"=>" ,
rhs .
types " "B " "C ""I
"."C
max TRUE maximize
FALSE .minimize
bounds NULL upper lower
indices 0 .
verbose solver
.FALSE
:
optimal solution :
solution .optimal coefficients
objval .
status 0 .
.
163
:1
Max 8 x1 + 5 x2
St
2 x1 + x2 1000
3 x1 + 4 x2 2400
x1 + x2 700
x1 x2 350
x1 , x2 0
> library(Rglpk)
> obj <- c(8, 5)
> mat <- matrix (c(2,1,3,4,1,1,1,-1),nrow=4,byrow=TRUE)
> dir <- c("<=", "<=", "<=", "<=")
> rhs <- c(1000,2400,700,350)
> Rglpk_solve_LP(obj, mat, dir, rhs, max = TRUE)
$optimum
[1] 4360
$solution
[1] 320 360
$status
[1] 0
:2
Max. 12000 X1 + 20000 X 2

St.
2 X1 +
6 X 2 27
X2 2
3 X1 +
X 2 19
X1, X 2 0 and integers
> library(Rglpk)
> obj <- c(12000,20000)
> mat <- matrix (c(2,6,0,1,3,1),nrow=3,byrow=TRUE)
> dir <- c("<=", ">=", "<=")
> rhs <- c(27,2,19)
> s1 <- Rglpk_solve_LP(obj, mat, dir, rhs, types = "I", max
= TRUE)
> print(s1)
$optimum
[1] 108000
164
$solution
[1] 4 3
$status
[1] 0
>
linprog

minimize : cx,
subject to Ax b, x 0
:
solveLP( cvec, bvec, Amat, maximum=FALSE, maxiter=1000,
) zero=1e-10, lpSolve=FALSE, verbose=FALSE
:
cvec c n.
bvec b m.
Amat A .m x n
maximum .
maxiter .
zero .
lpSolve ' 'lpSolve . .
verbose .
.
:1
) library( linprog
)cvec <- c(8,5
)bvec <- c(1000,2400,700,350
)) Amat <- rbind( c( 2, 1),c( 3,4 ),c( 1, 1 ), c( 1, -1
) res <- solveLP( cvec, bvec, Amat, TRUE
) print.solveLP( res
>
>
>
>
>
>
Results of Linear Programming / Linear Optimization
165
Objective function (Maximum):

[1] 4360
Iterations in phase 1: 0
Iterations in phase 2: 3
Basic Variables
opt
1
320
2
360
S 3 20
S 4 390
Constraints
max actual diff dual price dual.reg
1 1000
1000
0
3.4
400
2 2400
2400
0
0.4
650
3 700
680
20
0.0
20
4 350
-40 390
0.0
390
All Variables (including slack variables)
opt c
min c
max c marg. marg.reg.
1
320 8 3.750000 10.00000
NA
NA
2
360 5 4.000000 10.66667
NA
NA
S 1
0 0
NA
NA -3.4
400
S 2
0 0
NA
NA -0.4
650
S 3 20 0
NA 2.00000
0.0
20
S 4 390 0 -0.666667 2.42857
0.0
390
lpSolve
:
lp (direction = "min", objective.in, const.mat, const.dir,
const.rhs, transpose.constraints = TRUE, int.vec,
presolve=0, compute.sens=0, binary.vec, all.int=FALSE,
all.bin=FALSE, scale = 196, dense.const, num.bin.solns=1,
use.rw=FALSE)
:
. ) ( direction
. objective.in
166
const.mat
) .( transpose.constraints = FALSE
const.dir ) "=" "=<" "<"
">" "==" "=>"(.
const.rhs .
transpose.constraints const.mat
transpose .

.transpose.constraints = FALSE
int.vec indices .
presolve .0
compute.sens 0 .
binary.vec indices .
all.int . .FALSE :
all.bin . .FALSE :
scale ) ( 196
0 .
dense.const array .
. const.mat
num.bin.solns . all.bin = TRUE
.
use.rw TRUE num.bin.solns >1 .
:
.lp.object :
:1
)> library(lpSolve
)> f.obj <- c(8, 5
)> f.con <- matrix (c(2,1,3,4,1,1,1,-1),nrow=4,byrow=TRUE
)"=<"> f.dir <- c("<=","<=","<=",
)> f.rhs <- c(1000,2400,700,350
)> s1 <- lp ("max", f.obj, f.con, f.dir, f.rhs
> lp ("max", f.obj, f.con, f.dir, f.rhs)$solution
[1] 320 360
)> print(s1
Success: the objective function is 4360
>
167
max : x1 + 9 x2 + x3
s.t : x1 + 2 x2 + 3 x3 9
3 x1 + 2 x2 + 2 x3 15
> library(lpSolve)
> f.obj <- c(1, 9, 3)
> f.con <- matrix (c(1, 2, 3, 3, 2, 2), nrow=2, byrow=TRUE)
> f.dir <- c("<=", "<=")
> f.rhs <- c(9, 15)
> lp ("max", f.obj, f.con, f.dir, f.rhs)
Success: the objective function is 40.5
> lp ("max", f.obj, f.con, f.dir, f.rhs)$solution
[1] 0.0 4.5 0.0
:
> lp ("max", f.obj, f.con, f.dir, f.rhs,
compute.sens=TRUE)$sens.coef.from
[1] -1e+30 2e+00 -1e+30
compute.sens=TRUE)$sens.coef.to
[1] 4.50e+00 1.00e+30 1.35e+01
compute.sens=TRUE)$duals
[1]
4.5
0.0 -3.5
0.0 -10.5
compute.sens=TRUE)$duals.from
[1] 0e+00 -1e+30 -1e+30 -1e+30 -6e+00
compute.sens=TRUE)$duals.to
[1] 1.5e+01 1.0e+30 3.0e+00 1.0e+30 3.0e+00
:
> lp ("max", f.obj, f.con, f.dir, f.rhs, int.vec=1:3)
int.vec=1:3)$solution
[1] 1 4 0
> lp ("max", f.obj, f.con, f.dir, f.rhs, int.vec=1:3,
compute.sens=TRUE)$duals
[1] 1 0 0 7 0
168

lp.assign (cost.mat, direction = "min", presolve = 0,
)compute.sens = 0
:
cost.mat ij i .j
direction 1 " "min "."max
presolve .
compute.sens
.
.lp.object :
:
:
1
7 2 9
3 8 8
2 10 2
7
2
7
> assign.costs <- matrix (c(2, 7, 7, 2, 7, 7, 3, 2, 7, 2,

)8,10, 1, 9, 8, 2), 4, 4
> assign.costs
][,1] [,2] [,3] [,4
][1,
2
7
7
1
][2,
7
7
2
9
][3,
7
3
8
8
][4,
2
2
10
2
> lp.assign (assign.costs)$solution
][,1] [,2] [,3] [,4
][1,
0
0
0
1
][2,
0
0
1
0
][3,
0
1
0
0
][4,
1
0
0
0
>
lp.object LP lp . :
direction .
169
x.count .
objective .
const.count .
constraint .
int.count .
int.vec .
objval .
solution .
num.bin.solns .
status = 0 =2 .
:
:
lp.transport (cost.mat, direction="min", row.signs,
row.rhs, col.signs, col.rhs, presolve=0, compute.sens=0,
) )integers = 1:(nc*nr
:
cost.mat ij i .j
direction 1 " "min "."max
row.signs :
"=>" ">" "==" "=" "=<" "<".
row.rhs .
col.signs :
"=>" ">" "==" "=" "=<" "<".
col.rhs .
presolve .0
compute.sens 0 .
integers i i
. .
.lp.object :
:
)library(lpSolve
)costs <- matrix(10000,8,5
costs[4,1] <- costs[-4,5] <- 0
costs[1,2] <- costs[2,3] <- costs[3,4] <- 7
costs[1,3] <- costs[2,4] <- 7.7
170
>
>
>
>
>
> costs[5,1] <- costs[7,3] <- 8

> costs[1,4] <- 8.4
> costs[6,2] <- 9
> costs[8,4] <- 10
> costs[4,2:4] <- c(.7, 1.4, 2.1)
> row.signs <- rep ("<", 8)
> row.rhs <- c(200, 300, 350, 200, 100, 50, 100, 150)
> col.signs <- rep (">", 5)
> col.rhs <- c(250, 100, 400, 500, 200)
> lp.transport (costs, "min", row.signs, row.rhs,
col.signs, col.rhs)
col.signs, col.rhs)$solution
[,1] [,2] [,3] [,4] [,5]
[1,]
0 100 100
0
0
[2,]
0
0 200 100
0
[3,]
0
0
0 350
0
[4,] 200
0
0
0
0
[5,]
50
0
0
0
50
[6,]
0
0
0
0
50
[7,]
0
0 100
0
0
[8,]
0
0
0
50 100
>
. lp.object print.lp
print(x,)
.lp.object x
:3
Min 35 X 11 + 20 X12 + 40 X13 + 32 X 14 + 37 X 21 + 40 X 22 + 42 X 23 + 25 X 24 + 40 X 31 + 15 X 32 + 20 X 33 + 28 X 34
St
X 11 + X 12 + X 13 + X14
1200
X 21 + X 22 + X 23 + X 24
1000
X 31 + X 32 + X 33 + X 34 800
X 11
+ X 21
+ X 31
=1100
X12
+ X 22
+ X 32
=400
X 13
+ X 23
+ X 33
=750
X 14
+ X 24
+ X 34 = 750
X ij 0, for all i and j
35 20 40 32
37 40 42 25
40 15 20 28
171
> library(lpSolve)
> costs <- matrix
(c(35,20,40,32,37,40,42,25,40,15,20,28),nrow=3,byrow=TRUE)
> row.signs <- rep ("<=", 3)
> row.rhs <- c(1200,1000,800)
> col.signs <- rep ("=", 4)
> col.rhs <- c(1100, 400,750, 750)
> s2 <- lp.transport (costs, "min", row.signs, row.rhs,
col.signs, col.rhs)
> s2
> summary(s2)
Length Class Mode
direction
1
-none- numeric
rcount
1
-none- numeric
ccount
1
-none- numeric
costs
13
-none- numeric
rsigns
3
-none- numeric
rrhs
3
-none- numeric
csigns
4
-none- numeric
crhs
4
-none- numeric
objval
1
-none- numeric
int.count
1
-none- numeric
integers
12
-none- numeric
solution
12
-none- numeric
presolve
1
-none- numeric
compute.sens
1
-none- numeric
sens.coef.from 12
-none- numeric
sens.coef.to
12
-none- numeric
duals
12
-none- numeric
duals.from
12
-none- numeric
duals.to
12
-none- numeric
status
1
-none- numeric
> s2[12]
$solution
[,1] [,2] [,3] [,4]
[1,] 850 350
0
0
[2,] 250
0
0 750
[3,]
0
50 750
0
>
> library(Rglpk)
> obj <- c(35,20,40,32,37,40,42,25,40,15,20,28)
> mat <- matrix (c(1,1,1,1,0,0,0,0,0,0,0,0,
+ 0,0,0,0,1,1,1,1,0,0,0,0,
+ 0,0,0,0,0,0,0,0,1,1,1,1,
172
+ 1,0,0,0,1,0,0,0,1,0,0,0,
+ 0,1,0,0,0,1,0,0,0,1,0,0,
+ 0,0,1,0,0,0,1,0,0,0,1,0,
+ 0,0,0,1,0,0,0,1,0,0,0,1),nrow=7,byrow=TRUE)
> dir <- c(rep("<=",3),rep("==",4))
> rhs <- c(1200,1000,800,1100,400,750,750)
> s3 <- Rglpk_solve_LP(obj, mat, dir, rhs, types = "I")
> s3
$optimum
[1] 80500
$solution
[1] 850 350
0 250
0 750
50 750
$status
[1] 0
>
> library(lpSolve)
> costs <- matrix
(c(35,20,40,32,37,40,42,25,40,15,20,28),nrow=3,byrow=TRUE)
> row.signs <- rep ("<=", 3)
> row.rhs <- c(1200,1000,800)
> col.signs <- rep ("=", 4)
> col.rhs <- c(1100, 400,750, 750)
> s2 <- lp.transport (costs, "min", row.signs, row.rhs,
col.signs, col.rhs)
> print(s2)
>
Transportation Problem
.

:
Distribution
Distribution
Distribution Center 3
Center 1
Center 2
Plant A
4
6
4
Plant B
6
5
2
60 .
. 40
173

> library(lpSolve)
> costs <- matrix(c(4,6,4,6,5,2),2,3,byrow=TRUE)
> row.signs <- rep ("<=", 2)
> row.rhs <- c(60,60)
> col.signs <- rep ("==", 3)
> col.rhs <- c(40,40,40)
col.signs, col.rhs)
col.signs, col.rhs)$solution
[,1] [,2] [,3]
[1,]
40
20
0
[2,]
0
20
40
>
:Assignment Problem
:
Inspection Area
Assembly
A
B
C
D
E
Line
1
10
4
6
10
12
2
11
7
7
9
14
3
13
8
12
14
15
4
14
16
13
17
17
5
19
11
17
20
19

.
> cost2 <- matrix
(c(10,4,6,10,12,11,7,7,9,14,13,8,12,14,15,14,16,13,17,17,19
,11,17,20,19), 5, 5, byrow=TRUE)
> lp.assign (cost2,direction = "min")$solution
[,1] [,2] [,3] [,4] [,5]
[1,]
0
0
1
0
0
[2,]
0
0
0
1
0
[3,]
0
0
0
0
1
[4,]
1
0
0
0
0
174
[5,]
>
175
:
: x j , ( j = 1,..., n ) . n
1 if object j is selected
xj =
0 otherwise
)w j , ( j = 1,..., n ) j ( )p j , ( j = 1,..., n )
c j (( )
x
n
w x
j
j =1
maximizes
n
p x
j
j =1
maximize
p x
j
j =1
n
subject to
w x
j
j =1
x j = 0 or 1,
j = 1,..., n
:
n=8
p j = (15,100,90,60,40,15,10,1)
w j = ( 2,20,20,30,40,30,60,10 )
c = 102
> library(lpSolve)
> f.obj <- c(15,100,90,60,40,15,10,1)
> f.con <- matrix(c(2,20,20,30,40,30,60,10),1,8,byrow=TRUE)
> f.dir <- c("<=")
> f.rhs <- c(102)
> s1 <- lp ("max", f.obj, f.con, f.dir,
f.rhs,binary.vec=1:8)
> lp ("max", f.obj, f.con, f.dir,
f.rhs,binary.vec=1:8)$solution
176
[1] 1 1 1 1 0 1 0 0
> s1
>
:

.
15 . :
Rating
Weight
Item
Ant Repellent
Pepsi
Blanket
Meat
10
Cakes
Football
Salad
10
10
Watermelon
30
Sum
.
)> library(lpSolve
)> f.obj <- c(2,9,3,8,10,6,4,10
)> f.con <- matrix(c(1,3,4,3,3,1,5,10),1,8,byrow=TRUE
)"=<"(> f.dir <- c
)> f.rhs <- c(15
> s1 <- lp ("max", f.obj, f.con, f.dir,
)f.rhs,binary.vec=1:8
> lp ("max", f.obj, f.con, f.dir,
f.rhs,binary.vec=1:8)$solution
[1] 1 1 1 1 1 1 0 0
> s1
>
177
:R
: Graph Binary relation
Vertex ) ( .Edges
}Vertices = { A, B, C, D, E
Edges = ({A,B}, {A,C}, {B,C}, {C,E}).
undirected
Edges = ({A,B}, {A,C}, {B,C}, {C,E}).
directed
Edges = ({A,B}, {A,C}, {B,C}, {C,E}).
178
igraph R
Graph Theory Network Science
http://igraph.sf.net
:
-1 Vertices .
-2 1 . V
-3 .id
:
}V = {A, B, C, D, E
))E = ((A,B), (A,C), (B,C), (C,E
A = 1, B = 2, C = 3, D = 4, E = 5.
R:
)"install.packages("igraph
)library(igraph
)g <- graph( c(1,2, 1,3, 2,3, 3,5), n=5
)plot(g
179
>
>
>
>
>

) 1 ( ) 12
( .
599
180
7
49
691
420
432
44
0
4
34
5
554
6
893
2
43
62
280
5 7 7
9
0
50
0
29
10
11
403
12
3 1 4
11
R:
1)> library(igraph
> m1 <- matrix(nc=3, byrow=TRUE, c(1,2,599, 1,3,180, 1,4,497,
2,5,691, 2,6,420, 3,4,432, 3,7,893, 4,6,345, 5,6,440, 5,9,554,
6,8,432, 6,9,621, 7,8,280, 7,10,500, 8,9,577, 8,10,290, 9,12,268,
) )10,11,116, 10,12,403, 11,12,314
)> dm <- data.frame(m1
> dm
X1 X2 X3
1
1 2 599
2
1 3 180
3
1 4 497
4
2 5 691
5
2 6 420
6
3 4 432
7
3 7 893
8
4 6 345
9
5 6 440
10 5 9 554
180
11 6 8 432
12 6 9 621
13 7 8 280
14 7 10 500
15 8 9 577
16 8 10 290
17 9 12 268
18 10 11 116
19 10 12 403
20 11 12 314
> mm <- graph.data.frame(dm, directed=TRUE)
> plot(mm)
> shortest.paths(mm)
> get.shortest.paths(mm, 1,12)
2> E <- rbind( c(1,2,599), c(1,3,180), c(1,4,497), c(2,5,691),

c(2,6,420), c(3,4,432), c(3,7,893), c(4,6,345), c(5,6,440),
c(5,9,554), c(6,8,432), c(6,9,621), c(7,8,280), c(7,10,500),
c(8,9,577), c(8,10,290), c(9,12,268), c(10,11,116), c(10,12,403),
c(11,12,314) )
> colnames(E) <- c("from", "to", "distant")
> g1 <- graph.data.frame(as.data.frame(E))
> get.shortest.paths(g1, 1,12)
181

Source
1
10
10
12
4
12
2
4
2
Tank
) 1000/(
7
0
0
0
7
8
2
0
6
0
6
4
3
2
0
0
5
0
0
12
0
0
2
0
4
0
8
0
0
0
3
0
3
10
1
0
0
0
4
0
2
10
0
1
0
0
0
0
1
0
0
0
0
0
0
0
1
2
3
4
5
6
7
TO
F
R
O
M
.
:
> EE <- rbind( c(1,2,10), c(1,3,10), c(2,3,1), c(2,4,8),c(2,6,6),
c(3,2,1), c(3,5,12), c(3,6,4), c(4,6,3), c(4,7,7), c(5,3,12),
))c(5,6,2), c(5,7,8), c(6,3,4), c(6,4,3), c(6,5,2), c(6,7,2
)"> colnames(EE) <- c("from", "to", "flow
))> g2 <- graph.data.frame(as.data.frame(EE
)> plot(g2
182
)> gm <- graph.maxflow(g2, 1, 7

)> summary(gm
Travelling Salesman Problem

.
)> dd <- read.csv(file.choose(), header=F
> dd
V12
V11
V10
V9
V8
905
710
777
863
625 1024
167
912
685
790
876
627 1037
88
870 1265
432 1043 1270
518
679
985
446
848 1343
640 1272
330
782 1064 1304
950
725 1035 1667 1345

936
V7
V6
V5
949 1343
420
358
358
420
848
870
949
395
1343 1265 1343
395
0 1177 1495 1729

561 1204
864
763
957
280
202
0 1649 1488 1402
664 1722 1929
974
V4
V3
V2
V1
79
79
2
3
4
446
782 1177
561
985 1064 1459
679 1304 1729 1204 1649
88
167
627
625
1024 1037
310 1561 1280
974
936 1488
725
330
518
876
863
0 1475 1590
974
664
957 1402
640 1035
432
790
777
10
482
202 1722 1561 1475
763
685 1043 1272 1667
710
11
482
280 1929 1280 1590
864
912 1270
905
12
183
950 1345
> #####
dd is the data in excel file
"true dist.csv"
>colnames(dd)<c("Jeddah","Makkah","Madinah","Riyadh","Dammam","Taif","Abha","Tabuk","
Qasim","Hail","Jizan","Najran")
>row.names(dd)<c("Jeddah","Makkah","Madinah","Riyadh","Dammam","Taif","Abha","Tabuk","
Qasim","Hail","Jizan","Najran")
> dd
Jeddah Makkah Madinah Riyadh Dammam Taif Abha Tabuk Qasim Hail Jizan Najran
Jeddah
79
420
949
1343
167
625
1024
863
777
710
Makkah
79
358
870
1265
88
627
1037
876
790
685
912
Madinah
420
358
848
1343
446
985
679
518
432
1043
1270
395
782 1064
1304
330
640
1272
950
0 1177 1495
1729
725 1035
1667
1345
Riyadh
949
870
848
Dammam
1343
1265
1343
395
Taif
167
88
446
782
1177
561
1204
Abha
625
627
985
1064
1459
561
1649
936
Tabuk
1024
1037
679
1304
1729 1204 1649
974
Qasim
863
876
518
330
725
936 1488
974
Hail
777
790
432
640
1035
957 1402
664
974
Jizan
710
685
1043
1272
1667
763
202
1722
Najran
905
912
1270
950
1345
864
280
1929
905
957
763
864
1488 1402
202
280
664
1722
1929
310
1561
1280
1475
1590
1561 1475
482
1280 1590
482
> ddd <- dist(dd)

> ddd
Jeddah
Qasim
Hail
Makkah
189.9395
Makkah
Madinah
Riyadh
Dammam
Taif
Abha
Tabuk
Jizan
Madinah 1117.7978 1129.7455

Riyadh
2186.0567 2162.9200 1903.1836
Dammam
3105.1282 3105.9369 2861.0322 1419.4531
Taif
436.6864
344.3632 1309.8240 2053.3960 2956.4343
Abha
1844.7927 1879.5875 2576.4809 2694.8759 3200.8066 1713.4255
Tabuk
2752.9571 2824.0988 2068.1908 2709.0635 2822.7596 2913.8809 3498.8182
Qasim
2306.7252 2314.2606 1585.8471 1027.9810 1813.0256 2326.3796 3236.9938 2145.2249
Hail
2080.3048 2105.9399 1325.7617 1690.5189 2220.0318 2184.3697 3061.7165 1511.7205
1211.0314
Jizan
2036.5549 2087.5510 2692.4985 2886.7043 3261.0665 1963.2328
528.8516 3416.8437
3349.7676 3115.7930
Najran
2316.2783 2356.4766 2872.0945 2516.0264 2807.5480 2157.4541
3129.4214 3151.0879
982.0484
> library(TSP)
> tsd <-TSP(ddd)
> tsd
184
866.5212 3545.7572
object of class TSP

12 cities (distance euclidean)
> n_of_cities(tsd)
[1] 12
> labels(tsd)
[1] "Jeddah"
"Tabuk"
"Makkah"
"Qasim"
"Madinah" "Riyadh"
"Hail"
"Jizan"
"Dammam"
"Taif"
"Abha"
"Najran"
> sss <- solve_TSP(tsd)

> sss
object of class TOUR
result of method nearest_insertion for 12 cities
tour length: 15759.64
> ttt <- TOUR(sss)
> ttt
object of class TOUR
result of method nearest_insertion for 12 cities
tour length: 15759.64
> as.integer(ttt)
[1] 12 11
9 10
> labels(ttt)
[1] "Najran"
"Tabuk"
"Jizan"
"Abha"
"Madinah" "Jeddah"
"Dammam"
"Makkah"
>
185
"Riyadh"
"Taif"
"Qasim"
"Hail"
Curve Fitting and Parameters

Estimation:
1984 1994
1994
1993
1992
1991
1990
1989
1988
1987
1986
1985
49.5
50.0
46.5
29.0
17.0
13.0
7.0
7.5
4.0
2.5
Year
1984
Market 3.0
Value
S :
a
,t 0
1 + be ct
186
= ) x (t
a b c
:
1984 )
( a = 10 b = 50 c = 1 Market Value Fit
.
187
188
a = 40 b = 100 c = 1
E13 Solver :
189
Min ) ( $E$13
Solve $F$15:$F$17
:
.
x (t ) =
57.76
,t 0
1 + 138.3e 0.729t
> library(minpack.lm)
> tm = seq(0,10,length=11)
> getPred <- function(parS, xx) parS$a/(1+parS$b*exp(-parS$c*xx))
> yd = c(3.0,2.5,4.0,7.5,7.0,13.0,17.0,29.0,46.5,50.0,49.5)
> residFun <- function(p, observed, xx) observed - getPred(p,xx)
> parStart <- list(a=40,b=50, c=1)
> nls.out <- nls.lm(par=parStart, fn = residFun, observed = yd,xx = tm,
control = nls.lm.control(nprint=1))
It.
0, RSS =
1180.49, Par. =
40
50
1
It.
1, RSS =
577.266, Par. =
40.0868
69.6474
0.866728
190
It.
2, RSS =
274.692, Par. =
47.0803
89.6054
0.704542
It.
3, RSS =
112.953, Par. =
59.7216
98.4505
0.649334
It.
4, RSS =
98.0102, Par. =
56.4299
125.1
0.725997
It.
5, RSS =
95.9791, Par. =
58.3408
127.124
0.711536
It.
6, RSS =
95.8031, Par. =
57.6869
135.903
0.727385
It.
7, RSS =
95.7785, Par. =
57.8297
136.901
0.726888
It.
8, RSS =
95.7766, Par. =
57.758
138.048
0.728667
It.
9, RSS =
95.7764, Par. =
57.7661
138.209
0.728741
It.
10, RSS =
95.7764, Par. =
57.7606
138.317
0.728896
It.
11, RSS =
95.7764, Par. =
57.7609
138.337
0.728912
> plot(tm,yd, main="data",type="l",col=3,lwd=2)
> lines(tm,getPred(as.list(coef(nls.out)), tm), col=2, lwd=2)
> summary(nls.out)
Parameters:
Estimate Std. Error t
a 57.7609
6.1406
b 138.3368
105.2750
c
0.7289
0.1431
--Signif. codes: 0 ***
value
9.406
1.314
5.092
Pr(>|t|)
1.34e-05 ***
0.225255
0.000939 ***
0.001 ** 0.01 * 0.05 . 0.1 1
Residual standard error: 3.46 on 8 degrees of freedom

Number of iterations to termination: 11
Reason for termination: Relative error in the sum of squares is at most
`ftol'.
>
>
191
:
R :
Parameters:
)|Estimate Std. Error t value Pr(>|t
a 57.7609
6.1406
*** 9.406 1.34e-05
b 138.3368
105.2750
1.314 0.225255
c
0.7289
0.1431
*** 5.092 0.000939
192

J
J State
Variables

.
J

.

.
.
J Venture Fund
) Internal Rate of Return (IRR
. J
.
193
:

y
125
117
116
110
107
101
99
95
92
88
85
82
80
76
72
70
68
65
62
59
51
45
41
38
36
35
34
36
36
38
42
x
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
59
61
65
70
73
76
81
86
93
100
103
109
117
194
131
147
163
179
188
200
210
228
245
259
263
50
61
76
93
103
116
130
153
178
199
206
x y
250
200
150
100
50
0
300
250
200
150
100
50
y = a + bx + cx 2
195
a b c . x , y R

y = cx ax +b
a b c . x , y R

:
C2
=$B$45+$B$46*A2+$B$47*B2*B2
F2
)=$C$47*(A2)^($C$45*A2+$C$46
:
196
:R
> jcurve = read.csv("C:/Documents and Settings/amb/Desktop/ts in R/ts
data/j curve data.csv", header=TRUE)
> x =jcurve[,1]
> y =jcurve[,2]
> library(minpack.lm)
> getPred <- function(parS, xx) parS$a+parS$b*xx+ parS$c*xx*xx
> parStart <- list(a=40,b=50, c=1)
> nls.out <- nls.lm(par=parStart, fn = residFun, observed = y ,xx = x,
It.
0, RSS = 3.64588e+10, Par. =
40
50
It.
1, RSS =
7942.28, Par. =
167.652
-2.11772
0.00889644
It.
2, RSS =
7942.28, Par. =
167.652
-2.11772
0.00889644
> plot(x,y,type="l",col=3,lwd=2)
> lines(x,getPred(as.list(coef(nls.out)), x), col=2, lwd=2)
> summary(nls.out)
Parameters:
Estimate Std. Error t value Pr(>|t|)
a
1.677e+02
8.857e+00
18.93
< 2e-16 ***
b -2.118e+00
1.692e-01
-12.52
3.1e-15 ***
5.968e-04
14.91
< 2e-16 ***
8.896e-03
--Signif. codes:
0 *** 0.001 ** 0.01 * 0.05 . 0.1 1

Reason for termination: Relative error between `par' and the solution
is at most `ptol'.
>
197
>
> getPred <- function(parS, xx) parS$c*((xx)^(parS$a*xx+parS$b))
> parStart <- list(a=0.001,b=-2, c=200000)
> nls.out <- nls.lm(par=parStart, fn = residFun, observed = y ,xx = x,
It.
0, RSS =
167377, Par. =
0.001
-2
200000
It.
1, RSS =
78730.8, Par. =
0.0038509
-2.06646
135199
It.
2, RSS =
6700.23, Par. =
0.00366134
-2.14178
173335
It.
3, RSS =
5752.83, Par. =
0.00364086
-2.19055
213088
It.
4, RSS =
5592.78, Par. =
0.00367427
-2.2158
237623
It.
5, RSS =
5579.71, Par. =
0.00367349
-2.21553
238867
198
It.
6, RSS =
5579.71, Par. =
0.00367368
-2.21566
238978
It.
7, RSS =
5579.71, Par. =
0.00367367
-2.21566
238974
> plot(x,y,type="l",col=3,lwd=2)
> lines(x,getPred(as.list(coef(nls.out)), x), col=2, lwd=2)
> summary(nls.out)
Parameters:
Estimate Std. Error t value Pr(>|t|)
a
3.674e-03
17.990
<2e-16 ***
b -2.216e+00
1.477e-01 -14.999
<2e-16 ***
1.297e+05
0.0731 .
2.390e+05
2.042e-04
1.842
--Signif. codes:
0 *** 0.001 ** 0.01 * 0.05 . 0.1 1

Reason for termination: Relative error in the sum of squares is at most
`ftol'.
>
199
200
:
R
:
:
:Objects
R .Objects
: intrinsic attributes
:mode - :
numeric complex logical character
.list
201
:length .
.
. .
Scalar R .1
Atomic Structures
.
.
Identifier .
:

.
moonbase3.sample
3moonbase.sample .moonbase3.sample .
Case Sensitive moon.sample
moon.Sample
c q C D F I .T
.
Data Sets R
.Data Frame
.
.
Non-
intrinsic Attributes:
:names .
. row.names .
:class
data.frame
generic functions
data.frame .

Functions, arguments and return values
202
R calling functions
inputs map output .
R . arguments
.return values
R
.
R
. . function
side-effects
.

Workspace and working directories
R .

.workspace R
working directory .

. R .

Vectors and assignment
command prompt
c() concatenation function syntax:
)c(object1,object2,

)> c(1,2,3
[1] 1 2 3
)"> c("Ali","Bet","Cat
"[1] "Ali" "Bet" "Cat
)
(
<- assignment operator
name <- expression
203
name expression
)> numbers <- c(1,2,3
)"> people <- c("Ali","Bet","Cat
> numbers
[1] 1 2 3
> people
"[1] "Ali" "Bet" "Cat
# R .comment
:
)> c(1,2,3)+c(4,5,6
[1] 5 7 9
> numbers + numbers
[1] 2 4 6
)> numbers - c(8,7.5,-2
[1] -7.0 -5.5 5.0
)> c(1,2,4)*c(1,3,3
[1] 1 6 12
> c(12,12,12)/numbers
[1] 12 6 4
.
: .

)> calc1 <- numbers + c(8,7.5,-2
> calc2 <- calc1 * calc1
> calc1
[1] 9.0 9.5 1.0
> calc2
[1] 81.00 90.25 1.00
> calc1 <- calc1 + calc2
> calc1
[1] 90.00 99.75 2.00
> calc2
[1] 81.00 90.25 1.00
204
R
recycling rule
)<- c(1,2
)<- c(0,0,0,0,0,0
+ small
1 2 1 2
> small
> large
> large
[1] 1 2
:
))(> rm(list=objects
:
5 84.5, 72.6, 75.7, 94.8,
71.3
)> weight <- c(84.5, 72.6, 75.7, 94.8, 71.3
> weight
[1] 84.5 72.6 75.7 94.8 71.3
)> total <- sum(weight
)> numobs <- length(weight
> meanweight <- total/numobs
> meanweight
[1] 79.78
...
)> mean(weight
[1] 79.78
205
:Data Frames
object R
.data set ) (
.experimental unit Syntax

name <- data.frame(variable1, variable2,
)...
$:
name$variable
spreadsheet
)() fix )( (data.entry
.
:
:
86.5 71.8 77.2 84.9 75.4
) (
sheep
)fix(sheep
)> height <- c(86.5, 71.8, 77.2, 84.9, 75.4
)> sheep <- data.frame(weight, height
)> mean(sheep$height
[1] 79.16
)> fix(sheep
130.4, 100.2,
109.4, 140.6, 101.4 :
206
> sheep$backlength <- c(130.4, 100.2, 109.4, 140.6,

)101.4
: .
:

)( summary .
:
)> summary(sheep$weight
Max.
94.80
3rd Qu.
84.50
Mean
79.78
Median
75.70
1st Qu.
72.60
Min.
71.30
)> summary(sheep
backlength
Min. : 100.2
1st Qu. : 101.4
Median : 109.4
Mean : 116.4
3rd Qu. : 130.4
Max. : 140.6
height
Min. : 71.80
1st Qu. : 75.40
Median : 77.20
Mean : 79.16
3rd Qu. : 84.90
Max. : 86.50
weight
Min. : 71.30
1st Qu. : 72.60
Median : 75.70
Mean : 79.78
3rd Qu. : 84.50
Max. : 94.80
)> IQR(sheep$height
[1] 9.5
)> sd(sheep$backlength
[1] 18.15269
:R
.R

:
> ?mean
> ?setwd
> ?t.test
)( help.start
.
207
:Session management and visibility

objects R
workspace
)() object (

)(> objects
"[1] "height" "meanweight" "numobs" "sheep" "total
"[6] "weight
height weight encapsulated

sheep
height weight )(rm

)> rm(height,weight,meanweight,numobs,total
)(> objects
"[1] "sheep
height weight
sheep
> weight
Error: Object "weight" not found
> sheep$weight
[1] 84.5 72.6 75.7 94.8 71.3
encapsulation
cow height weight .
sheep
)( attach
)() detach (
> weight
)> attach(sheep
> weight
[1] 84.5 72.6 75.7 94.8 71.3
208
)(> detach
> weight

folder . Working
directory:
orCourse ) C: (

)"> setwd("C:/orCourse
)( save.image
) .Rdata ( .

)"> save.image("example1.Rdata

)(> dir
)( dir
orCourse example1.Rdata
objects sheep
) objects
)( ( object )
)(.(dir
209
:Importing data
data sets
. .text
. sheep.dat
100 .
.orCourse R
)( .read.table .

C:\Documents and Settings\amb\Desktop
copy C:\Documents and Settings\...\sheep.dat

\paste C:\orCourse
R
)> sheep2 <- read.table("sheep.dat", header=TRUE
header = TRUE
. header = TRUE
.
:A hypothesis test
= 80kg
H 0 : = 80,
H1 : 80.
%5 = 0.05
) t(
)( t.test:
> attach(sheep2) # to make variables accessible
)> t.test(weight, mu=80
One Sample t-test
data: weight
t = 2.1486, df = 99, p-value = 0.03411
alternative hypothesis: true mean is not equal to 80
95 percent confidence interval:
210
80.21048 85.29312
sample estimates:
mean of x
82.7518
) (
H1 : > 80,
H1 : < 80.
)"> t.test(weight, mu=80, alternative="greater

)"> t.test(height, mu=66, alternative="less
:A linear model
) ( )
( )(plot
:
)> plot(height,weight
x .
211
)() lm
(

)> lmres <- lm(weight ~ height
:
weight ~ height .model formula ~
" " described by
.

> R
object )( lm model
object
lmres extractor
.functions
)(
lmres )( summary
)( abline .
> lmres
Call:
)lm(formula = weight ~ height
height
0.8724
Coefficients:
)(Intercept
26.0319
)> summary(lmres
Call:
)lm(formula = weight ~ height
Max
29.1479
3Q
5.6578
Median
-0.1758
Residuals:
Min
1Q
-23.1146 -6.1125
Coefficients:
)|Estimate Std. Error t value Pr(>|t
(Intercept) 26.03185
6.05581
*** 4.299 4.06e-05
height
0.87239
0.09204
*** 9.479 1.64e-15
--212
Signif. codes:
1
0 *** 0.001 ** 0.01 * 0.05 . 0.1

Multiple R-squared: 0.4783,
Adjusted R-squared: 0.473
F-statistic: 89.84 on 1 and 98 DF, p-value: 1.64e-15
213
Quitting and returning to a saved

:workspace
objects

)"> save.image("sheep2.Rdata
)(> quit
R
.Rdata
) .(R
R
)( load
)" > setwd("C:/orCourse
)"> load("sheep2.Rdata
)(> objects
.
:Properties of objects
)( length
)> length(sheep2
[1] 2
)> length(plot
[1] 1
.
. )( mode )(attributes

)> mode(sheep2
"[1] "list
)> attributes(sheep2
$names
"[1] "weight" "height
$class
"[1] "data.frame
$row.names
214
[1] "1" "2" "3" # ... etc to "100"

> mode(plot)
[1] "function"
> attributes(plot)
NULL
> mode(lmres)
[1] "list"
> attributes(lmres)
$names
[1] "coefficients" "residuals" "effects" "rank"
[5] "fitted.values" "assign" "qr" "df.residual"
[9] "xlevels" "call" "terms" "model"
$class
[1] "lm"
data.frame list
.lm

>
1
2
3
.
.
sheep2
weight height
75.19 56.34
101.80 83.57
74.51 56.58
> lmres
Call:
lm(formula = weight ~ height)
Coefficients:
(Intercept)
26.0319
height
0.8724
.
unclass() list R
:
> unclass(sheep2)
215
$weight
[1]
[12]
[23]
[34]
[45]
[56]
[67]
[78]
[89]
[100]
75.19 101.80 74.51

86.97 87.08 83.92
82.41 80.20 73.82
80.21 73.18 108.50
82.77 108.00 97.90
90.13 73.25 77.18
93.84 86.07 95.56
81.95 75.62 99.48
96.47 63.89 87.33
71.90
81.42 83.20
69.00 67.57
64.95 70.64
79.46 76.84
77.99 91.60
95.66 105.70
89.84 55.90
84.30 81.49
81.01 97.90
80.84
81.89
94.60
74.10
97.37
85.66
85.40
79.84
79.97
81.67 90.82 102.51 104.87

98.79 80.74 61.61 84.64
72.08 65.60 97.95 61.97
78.72 59.80 76.92 85.28
78.40 107.93 89.74 83.57
94.22 104.60 72.03 65.99
89.59 72.07 64.76 68.09
72.53 119.50 83.53 70.92
69.10 68.37 71.81 85.68
96.03
72.29
84.81
96.27
65.76
81.16
86.05
58.87
94.27
$height
[1]
[14]
[27]
[40]
[53]
[66]
[79]
[92]
56.34
64.40
64.56
65.30
70.27
61.51
50.03
69.82
83.57
59.20
68.01
57.55
63.01
74.59
60.82
79.17
56.58
54.59
54.76
49.76
40.57
45.81
73.89
57.46
55.60
66.53
62.47
65.82
72.50
82.23
65.74
55.67
73.59
68.67
77.62
70.41
61.38
78.81
60.50
50.15
56.24
68.27
46.20
54.89
60.98
57.40
52.72
78.97
65.93
54.06
58.23
82.67
58.64
61.60
90.05
64.84
70.42
67.66
73.84
70.00
57.91
73.24
54.40
81.64
66.28
60.38
65.58
67.91
81.64
68.65
60.25
49.11
73.99
68.54
88.21
66.26
72.12
51.60
62.46
72.76
62.96
52.42
73.51
84.47
60.55
70.50
69.87
60.48
72.40
73.42
57.33
66.49
45.35
65.33
53.20
60.17
82.56
59.14
74.25
71.46
attr(,"row.names")
[1]
[21]
[41]
[61]
[81]
>
1
21
41
61
81
2
22
42
62
82
3
23
43
63
83
4
24
44
64
84
5
25
45
65
85
6
26
46
66
86
7
27
47
67
87
8
28
48
68
88
9
29
49
69
89
10
30
50
70
90
11
31
51
71
91
12
32
52
72
92
13
33
53
73
93
14
34
54
74
94
15
35
55
75
95
16
36
56
76
96
17
37
57
77
97
18
38
58
78
98
19 20
39 40
59 60
79 80
99 100
> unclass(lmres)
$coefficients
(Intercept)
height
26.0318530
0.8723918
$residuals
1
2
3
4
5
6
0.007594467
2.862366459 -0.881779559
6.883164379 -7.031163636
5.744833644
7
8
9
10
11
12
-1.878642646
3.354318288 18.656020233 14.289879655
6.522921537 -0.015866236
13
14
15
16
17
18
4.054792418
1.706116768 -8.677446007 -6.085719929 -2.182077711 12.851003893
19
20
21
22
23
24
-4.850039398 -11.583352289 -0.417880416 -6.416868300 -3.415585177 -0.757639078
25
26
27
28
29
30
-4.974107478 -7.493095363 -11.713465916
9.236782464 -1.724026530 -14.930167108
31
32
33
34
35
36
4.203097515 -4.366352945
7.978774014 -10.239261579 -10.063305525
5.514468628
37
38
39
40
41
42
7.697370221 -12.353017424 -4.423666028 -4.279035829 -16.437999580
7.477932340
43
44
45
46
47
48
1.827320449
8.813042206
8.852562539
9.847519056 10.800722833 -7.285978359
49
50
51
52
53
54
7.763468068
7.208627706 -11.682857034
9.873482151
2.405177054
2.568741334
55
56
57
58
59
60
4.335212743
0.849743398 -6.329260075 -2.050303365 18.471093386 29.147939381
61
62
63
64
65
66
-11.593917417
5.271252272
4.877213863 -4.016073390 -11.635102501
1.467328995
67
68
69
70
71
72
2.736444590 20.073879847 -2.208628563 -4.945048696 -20.207140814
5.628813735
73
74
75
76
77
78
-0.335826515 -13.851548272 -6.287268524 -10.765174902
2.012817960 -8.856942206
79
80
81
82
83
84
5.942386561 20.389279319 -6.192881168 -1.892888209
1.028444687
0.505652689
216
85
14.909267764
91
-1.042969157
97
-23.114631380
86
10.040034508
92
-5.932246647
98
3.082264387
$effects
(Intercept)
87
88
-7.673457370 -21.651443190
93
94
2.800890265
3.810515680
99
100
-2.983917417
3.024986993
89
8.934526946
95
-5.497903045
90
-1.704819937
96
-1.412300452
height
-827.5180000
-88.1319145
-0.7006440
7.0875994
-7.2544388
5.9340527
-1.9198022
3.2064095
18.6065394
14.0570945
6.3193795
-0.1506989
4.0278978
1.7013328
-8.5586006
-5.8572723
-2.2375022
12.7447011
-4.9468322
-11.3423040
-0.5001706
-6.3260773
-3.5187972
-0.7281873
-4.8856939
-7.2316007
-11.7220539
9.1461711
-1.4996206
-14.8890656
3.8840095
-3.9384340
8.1206810
-10.4684805
-10.0961439
4.9436046
7.9774093
-12.5480005
-4.3278823
-4.3052172
-16.2799256
7.8212127
1.7887761
8.6653711
9.0738777
9.4083679
10.6627995
-7.3742122
7.7144628
6.9872545
-11.9020905
9.4369462
2.2608345
2.5970044
4.8969843
0.6523828
-6.2622439
-1.9737773
18.6032527
29.2974544
-12.0085805
5.0829261
4.3952679
-3.8527690
-11.5148306
1.5312544
2.4893945
20.5110710
-2.6373188
-5.2924288
-20.0455006
5.6905994
-0.5507805
-13.9573755
-5.9877340
-10.6784256
1.9583444
-9.0959088
6.2792477
20.4696094
-6.4232888
-1.9295306
1.1163827
0.7785593
14.2946579
10.2729994
-7.5795756
-21.6101039
8.7847161
-1.2566924
-1.2156039
-6.0658905
2.4449512
3.9707294
-5.2951323
-1.0782923
-23.4658155
3.0670194
-3.3985805
3.3837210
$rank
[1] 2
$fitted.values
1
75.18241
9
83.85398
17
84.07208
25
78.79411
33
76.83123
41
76.23800
49
83.83653
57
79.57926
65
77.62510
73
89.92583
2
98.93763
10
90.58012
18
85.93900
26
72.44310
34
90.44926
42
69.44207
50
90.16137
58
79.23030
66
79.69267
74
85.92155
3
4
75.39178 74.53684
11
12
89.50708 86.98587
19
20
85.59004 73.19335
27
28
82.35347 85.36322
35
36
83.24331 102.98553
43
44
83.45268 87.45696
51
52
90.08286 98.05652
59
60
77.18891 76.55206
67
68
91.10356 65.99612
75
76
71.04727 78.85517
5
90.23116
13
83.02521
21
85.05788
29
73.80403
37
71.76263
45
73.91744
53
87.33482
61
97.25392
69
97.76863
77
84.03718
217
6
75.09517
14
82.21388
22
78.70687
30
80.53017
38
89.19302
46
98.15248
54
81.00126
62
88.94875
70
94.78505
78
90.80694
7
83.54864
15
77.67745
23
85.82559
31
93.74690
39
78.52367
47
87.09928
55
61.42479
63
99.72279
71
76.10714
79
69.67761
8
87.46568
16
73.65572
24
80.95764
32
66.33635
40
82.99904
48
85.27598
56
89.28026
64
76.04607
72
79.77119
80
79.09072
81
90.49288
89
87.53547
97
94.92463
82
83.38289
90
65.59482
98
82.59774
83
78.81156
91
88.37297
99
97.25392
84
85
72.02435 104.59073
92
93
86.94225 95.09911
100
68.87501
$assign
[1] 0 1
$qr
$qr
(Intercept)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
-10.0
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
height
-6.501660e+02
-1.010233e+02
-7.570349e-02
-8.540422e-02
9.267347e-02
-7.906905e-02
1.684939e-02
6.129458e-02
2.031394e-02
9.663295e-02
8.445755e-02
5.585029e-02
1.091017e-02
1.704377e-03
-4.976889e-02
-9.540191e-02
2.278862e-02
4.397184e-02
4.001236e-02
-1.006482e-01
3.397415e-02
-3.808841e-02
4.268501e-02
-1.254976e-02
-3.709854e-02
-1.091611e-01
3.288170e-03
3.743870e-02
-9.371913e-02
-1.740012e-02
1.325652e-01
-1.784520e-01
-5.937063e-02
9.514815e-02
1.338485e-02
2.373925e-01
-1.168821e-01
8.089401e-02
-4.016714e-02
1.061321e-02
-6.610175e-02
-1.432127e-01
1.576054e-02
6.119559e-02
-9.243230e-02
1.825537e-01
5.713712e-02
3.644883e-02
2.011597e-02
9.188157e-02
9.099069e-02
1.814648e-01
5.980977e-02
-1.205482e-02
218
86
73.48997
94
76.15948
87
78.59346
95
74.59790
88
80.52144
96
69.78230
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
0.1
-2.341818e-01
8.188388e-02
-2.818971e-02
-3.214919e-02
-5.531216e-02
-6.253821e-02
1.723580e-01
7.812238e-02
2.003714e-01
-6.827946e-02
-5.036281e-02
-2.690288e-02
1.025722e-01
-1.823125e-01
1.781983e-01
1.443447e-01
-6.758655e-02
-2.601200e-02
8.920892e-02
4.377387e-02
-1.249990e-01
-3.640564e-02
2.239267e-02
9.920662e-02
-1.405400e-01
-3.373299e-02
9.564308e-02
1.496864e-02
-3.690057e-02
-1.139125e-01
2.556061e-01
-9.728267e-02
-3.937525e-02
-1.749911e-02
6.208647e-02
-1.868659e-01
7.158923e-02
5.535536e-02
1.479082e-01
-6.699263e-02
-8.471131e-02
-1.393522e-01
1.459285e-01
6.059807e-03
1.723580e-01
-1.496468e-01
attr(,"assign")
[1] 0 1
$qraux
[1] 1.100000 1.191463
$pivot
[1] 1 2
$tol
[1] 1e-07
$rank
[1] 2
219
attr(,"class")
[1] "qr"
$df.residual
[1] 98
$xlevels
list()
$call
lm(formula = weight ~ height)
$terms
weight ~ height
attr(,"variables")
list(weight, height)
attr(,"factors")
height
weight
0
height
1
attr(,"term.labels")
[1] "height"
attr(,"order")
[1] 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
attr(,"predvars")
list(weight, height)
attr(,"dataClasses")
weight
height
"numeric" "numeric"
$model
weight height
1
2
3
4
75.19
101.80
74.51
81.42
56.34
83.57
56.58
55.60
220
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
83.20
80.84
81.67
90.82
102.51
104.87
96.03
86.97
87.08
83.92
69.00
67.57
81.89
98.79
80.74
61.61
84.64
72.29
82.41
80.20
73.82
64.95
70.64
94.60
72.08
65.60
97.95
61.97
84.81
80.21
73.18
108.50
79.46
76.84
74.10
78.72
59.80
76.92
85.28
96.27
82.77
108.00
97.90
77.99
91.60
97.37
78.40
107.93
89.74
83.57
65.76
90.13
73.25
77.18
95.66
105.70
85.66
94.22
104.60
72.03
65.99
81.16
93.84
86.07
95.56
89.84
55.90
85.40
89.59
72.07
64.76
73.59
56.24
65.93
70.42
66.28
73.99
72.76
69.87
65.33
64.40
59.20
54.59
66.53
68.67
68.27
54.06
67.66
60.38
68.54
62.96
60.48
53.20
64.56
68.01
54.76
62.47
77.62
46.20
58.23
73.84
65.58
88.21
52.42
72.40
60.17
65.30
57.55
49.76
65.82
70.41
54.89
82.67
70.00
67.91
66.26
73.51
73.42
82.56
70.27
63.01
40.57
72.50
61.38
60.98
58.64
57.91
81.64
72.12
84.47
57.33
59.14
61.51
74.59
45.81
82.23
78.81
57.40
61.60
73.24
68.65
51.60
221
60.55
66.49
74.25
50.03
60.82
73.89
65.74
60.50
52.72
90.05
54.40
60.25
62.46
70.50
45.35
71.46
69.82
79.17
57.46
55.67
50.15
78.97
64.84
81.64
49.11
76
68.09
77
86.05
78
81.95
79
75.62
80
99.48
81
84.30
82
81.49
83
79.84
84
72.53
85 119.50
86
83.53
87
70.92
88
58.87
89
96.47
90
63.89
91
87.33
92
81.01
93
97.90
94
79.97
95
69.10
96
68.37
97
71.81
98
85.68
99
94.27
100 71.90
>
) > unclass(lmres sheep2

lmres ) ($model
. )(class
)> class(lmres$model
"[1] "data.frame
mode .
R type
mode .
)( typeof
)( storage.mode:
)> typeof(sheep2
"[1] "list
)> typeof(sheep2$weight
"[1] "double
> z <- 1 + 1i
)> typeof(z
"[1] "complex
)> typeof(plot
"[1] "closure
)> storage.mode(plot
"[1] "function
:
222
> class(lmres$model)
[1] "data.frame"
> names(sheep2)
[1] "weight" "height"
> attributes(lmres)
$names
[1] "coefficients" "residuals"
"rank"
"fitted.values"
[6] "assign"
"qr"
"xlevels"
"call"
[11] "terms"
"model"
"effects"
"df.residual"
$class
[1] "lm"
> lmres$residuals
1
0.007594467
2.862366459 -0.881779559
7.031163636
5.744833644
7
8
9
11
12
-1.878642646
3.354318288 18.656020233
6.522921537 -0.015866236 .
6.883164379
2
6
10
14.289879655
> lmres$effects
(Intercept)
-827.5180000
5.9340527
height
-88.1319145
-0.7006440
7.0875994
-7.2544388
-1.9198022
-0.1506989
3.2064095
18.6065394
14.0570945
6.3193795
4.0278978
12.7447011
1.7013328
-8.5586006
-5.8572723
-2.2375022
> lmres$coefficients
(Intercept)
26.0318530
height
0.8723918
:Named arguments and default values

> setwd("C:/orCourse")
> mkmsc <- read.table("marks.dat", header=TRUE)
> mk2nd <- read.table("marks2.dat", header=TRUE)
223
)> attach(mk2nd
R
)> plot(exam1, exam2
)> plot(exam2, exam1
exam1 x exam 2 y
default .R
named arguments
)> plot(y=exam2, x=exam1
)> plot(x=exam1, y=exam2
.

)t.test(exam1
)t.test(exam1, mu=30
)"t.test(exam1, alternative="greater
)"t.test(exam1, mu=31.5, alternative="less
)t.test(mu=30, exam1
)t.test(x=exam1, mu=30
>
>
>
>
>
>
mu t.test . = alternative
""two.sided
:names
names
. )(names
)> names(mkmsc
"[1] "courseA" "courseB" "courseC
$ - sub-object
)( names -
courseA courseB courseC
or221 or241 or342
224
> names(mkmsc) <- c("or221", "or241", "or342")

> names(mkmsc)
[1] "or221" "or241" "or342"
> mkmsc$or221
[1] 52 71 44 90 23 66
2
> mkmsc$or221 <- mkmsc$or221 + 2
> mkmsc$or221
[1] 54 73 46 92 25 68
225
:Other non-intrinsic attributes

1 2 3
)> row.names(mkmsc
"[1] "1" "2" "3" "4" "5" "6
> row.names(mkmsc) <- c("Ali", "Badr", "Ahmad",
)"+"Bakur", "Saeed", +"Faris
> mkmsc
or221 or241 or342
Ali
54
67
71
Badr
73
80
84
Ahmad
46
55
55
Bakur
92
76
68
Saeed
25
49
52
Faris
68
61
61
>
: R +
.
:Regular sequences

.
:sequence generator
> 1:10
[1] 1 2 3 4 5 6 7 8 9 10
> 10:1
[1] 10 9 8 7 6 5 4 3 2 1
> 2*1:10
[1] 2 4 6 8 10 12 14 16 18 20
> 1:10 + 1:20
[1] 2 4 6 8 10 12 14 16 18 20 12 14 16 18 20 22 24
26 28 30
> 1:10-1
[1] 0 1 2 3 4 5 6 7 8 9
)> 1:(10-1
226
[1] 1 2 3 4 5 6 7 8 9
) ( : .
seq
)seq(from, to, by, length, along
from to by length
.
. along

)> seq(1,10
[1] 1 2 3 4 5 6 7 8 9 10
)> seq(to=10, from=1
[1] 1 2 3 4 5 6 7 8 9 10
)> seq(1,10,by=0.5
[1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5
7.0 7.5 8.0
[16] 8.5 9.0 9.5 10.0
)> seq(1,10,length=19
[1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5
7.0 7.5 8.0
[16] 8.5 9.0 9.5 10.0
)> seq(1,10,length=19,by=0.25
)Error in seq.default(1, 10, length = 19, by = 0.25
:
Too many arguments
)> seq(1,by=2,length=6
[1] 1 3 5 7 9 11
)> seq(to=30,length=13
[1] 18 19 20 21 22 23 24 25 26 27 28 29 30
)> seq(to=30
[1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
20 21 22 23 24 25
[26] 26 27 28 29 30
rep
)> rep(1, times = 3
[1] 1 1 1
)> rep((1:3), each =5
[1] 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3
227
:Logical vectors
R TRUE FALSE
== =! > =>
< =<
& AND | OR ! NOT
)> tf1 <- c(TRUE,TRUE,FALSE,FALSE
)> tf2 <- c(TRUE,FALSE,TRUE,FALSE
> tf1 & tf2
[1] TRUE FALSE FALSE FALSE
> tf1 | tf2
[1] TRUE TRUE TRUE FALSE
)> (tf1 & !tf2) | (!tf1 & tf2
[1] FALSE TRUE TRUE FALSE
Indexing vectors and subset

:selection

] [ subscripting
operator indexing vector
) (
-

)> attach(mkmsc
> or221
[1] 54 73 46 92 25 68
])> or221[c(1,2,6
[1] 54 73 68
]> or221[1:4
[1] 54 73 46 92
])> or221[-(1:4
[1] 25 68
])> or221[seq(6,by=-2
[1] 68 92 73
228
])> or221[rep((1:3),each=2
[1] 54 54 73 73 46 46
]> row.names(mkmsc)[1:3
"[1] "Ali
""Badr" "Ahmad
:
or221 70
or221 65 or241
200
]> or221[or221>70
[1] 73 92
]> or241[or221<65
[1] 67 55 49
]> or342[(or221+or241+or342)<200
[1] 71 55 52 61
]> or342[or221>50 & or241>50 & or342>50
[1] 71 84 68 61

]> row.names(mkmsc)[or221>70
"[1] "Badr" "Bakur
]> row.names(mkmsc)[or241<50 | or221<50 | or342<50
"[1] "Ahmad" "Saeed
> names(mkmsc)[c(sum(or221), sum(or241),
]sum(or342)) > 350
"[1] "or221" "or241" "or342
:Character sequences
}) {( x1 , y1 ) , ( x2 , y2 ) ,, ( x5 , y5
R )( paste .character
sep
)""=> paste(c("x","y"), rep(1:5,each=2), sep
"[1] "x1" "y1" "x2" "y2" "x3" "y3" "x4" "y4" "x5
""y5
)""=> str1 <- paste("(x", 1:5, sep
229
)""=> str2 <- paste("y", 1:5, ")", sep

)"> label1 <- paste(str1,str2,sep=",
> label1
")[1] "(x1,y1)" "(x2,y2)" "(x3,y3)" "(x4,y4
")"(x5,y5
)> mode(label1
"[1] "character
:Lists
.
components .
)( list
> mklst <- list("BSc exam marks", c(10,6,2005),
)mkmsc
)> mode(mklst
"[1] "list
)> length(mklst
[1] 3
> mklst
]][[1
"[1] "BSc exam marks
6 2005
]][[2
][1
10
]][[3
or221 or241 or342

54
67
71
73
80
84
46
55
55
92
76
68
25
49
52
68
61
61
Ali
Badr
Ahmad
Bakur
Saeed
Faris
] [
]> mklst[2
230
6 2005
]][[1
][1
10
)]> mode(mklst[2
"[1] "list
)]> length(mklst[2
[1] 1
. 4
] [ ] mklst[2
)> mklst[2]+c(4,0,0
Error in mklst[2] + c(4, 0, 0) : non-numeric
argument to binary operator
]] [[
]]> mklst[[2
[1] 10 6 2005
)]]> mode(mklst[[2
"[1] "numeric
)> mklst[[2]] <- mklst[[2]] + c(4,0,0
> mklst
]] mklst[[2
4
> mklst[[2]][1] <- mklst[[2]][1] + 4
] [ ]] [[
. label
1 2 3 ...

)"> names(mklst) <- c("title", "date", "marks
]] [[ $
231
]]> mklst[[2
[1] 18 6 2005
]]"> mklst[["date
[1] 18 6 2005
> mklst$date
[1] 18 6 2005
$ "" .

> mklst <- list("title"="MSc exam marks",
+"date"=c(10,6,2005),
)+ "marks"=mkmsc
:R
R . .
:
)(hist
:

)"> setwd("C:/orCourse
)> mk2nd <- read.table("marks2.dat", header=TRUE
)> attributes(mk2nd
$names
"[1] "candno" "exam1" "exam2" "exam3
$class
"[1] "data.frame
$row.names
[1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
16 17 18 19 20 21 22
[23] 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
38 39 40 41 42 43 44
[45] 45 46 47 48 49 50 51 52 53 54 55
232
)> attach(mk2nd
exam1
)> hist(exam1
.
)> hist(exam1, probability = TRUE
233
10
)> hist(exam1, nclass=10

)]> hist(exam3[exam1+exam2 <50
234

> hist(mk2nd[mk2nd>20])
235

> hist(mk2nd)
Error in hist.default(mk2nd) : `x' must be numeric

> hist(mk2nd[mk2nd<=max(mk2nd)])
236
237

> hist(exam1, breaks=c(0,20,25,30,40))
238
)( qqnorm
)( qqline

)> qqnorm(exam2
)> qqline(exam2
239
Boxplots
> boxplot(exam1,exam2,exam3)
240
:
> boxplot(mk2nd)
241
> boxplot(mk2nd, main="Boxplot of exam scores",

+ylab="Scores")
242
Plot types, graphics

: parameters and interactivity
R
type :
)> plot(exam1,exam2
243
> plot(exam1, exam2, type="p") # points (the

default)
244
> plot(exam1, exam2, type="l") # lines
line l
245
> plot(exam1, exam2, type="b") # both lines and

points
both b
246
> plot(exam1, exam2, type="o") # overlaid lines on

points
overlaid o
247
> plot(exam1, exam2, type="h") # high density

(vertical lines)
248
plotting character o
pch
)"> plot(exam1, exam2, pch="+
249

> plot(exam1, exam2, pch="x")
250

> plot(exam1, exam2, pch=2)
251

252

253
)( par

)(> par
$xlog
[1] FALSE
$ylog
[1] FALSE
$adj
[1] 0.5
$ann
[1] TRUE
254
$ask
[1] FALSE
$bg
[1] "transparent"
$bty
[1] "o"
$cex
[1] 1
$cex.axis
[1] 1
$cex.lab
[1] 1
$cex.main
[1] 1.2
$cex.sub
[1] 1
$cin
[1] 0.15 0.20
$col
[1] "black"
$col.axis
[1] "black"
$col.lab
[1] "black"
$col.main
[1] "black"
$col.sub
255
[1] "black"
$cra
[1] 14.4 19.2
$crt
[1] 0
$csi
[1] 0.2
$cxy
[1] 0.03437083 0.05328007
$din
[1] 5.604166 5.593749
$err
[1] 0
$family
[1] ""
$fg
[1] "black"
$fig
[1] 0 1 0 1
$fin
[1] 5.604166 5.593749
$font
[1] 1
$font.axis
[1] 1
$font.lab
[1] 1
256
$font.main
[1] 2
$font.sub
[1] 1
$lab
[1] 5 5 7
$las
[1] 0
$lend
[1] "round"
$lheight
[1] 1
$ljoin
[1] "round"
$lmitre
[1] 10
$lty
[1] "solid"
$lwd
[1] 1
$mai
[1] 1.02 0.82 0.82 0.42
$mar
[1] 5.1 4.1 4.1 2.1
$mex
[1] 1
257
$mfcol
[1] 1 1
$mfg
[1] 1 1 1 1
$mfrow
[1] 1 1
$mgp
[1] 3 1 0
$mkh
[1] 0.001
$new
[1] FALSE
$oma
[1] 0 0 0 0
$omd
[1] 0 1 0 1
$omi
[1] 0 0 0 0
$pch
[1] 1
$pin
[1] 4.364166 3.753749
$plt
[1] 0.1463197 0.9250557 0.1823464 0.8534078
$ps
[1] 12
$pty
258
[1] "m"
$smo
[1] 1
$srt
[1] 0
$tck
[1] NA
$tcl
[1] -0.5
$usr
[1] 0 1 0 1
$xaxp
[1] 0 1 5
$xaxs
[1] "r"
$xaxt
[1] "s"
$xpd
[1] FALSE
$yaxp
[1] 0 1 5
$yaxs
[1] "r"
$yaxt
[1] "s"
>

259
))"> par(c("pch", "col

$pch
[1] 1
$col
"[1] "black
>
*
)"*"=> par(pch
:
R )( identify
. )( identify

)> plot(exam1,exam2
)> identify(exam1,exam2
[1] 17 45 55
>
260
261
)> plot(exam1,exam2
))> identify(exam1,exam2,row.names(mk2nd
[1] 25 41 42 45
>
mfrow

:
))par(mfrow=c(3,2
)hist(exam1
)qqnorm(exam1
)hist(exam2
)qqnorm(exam2
)hist(exam3
)qqnorm(exam3
262
>
>
>
>
>
>
>
> par(mfrow=c(1,1))
.
:
> par(mfcol=c(3,2))
.mfrow mfcol
:
> citynames <- c("Athens", "Jo'burg", "London",
"NYC", "Shanghai")
> longitude <- c(23.72, 28.07, -0.08, -73.47,
121.47)
> latitude <- c(37.97, -26.20, 53.42, 40.78, 31.17)
> cities <- data.frame(latitude,longitude)
> row.names(cities) <- citynames
> cities
263
latitude longitude
Athens
37.97
23.72
Jo'burg
-26.20
28.07
London
53.42
-0.08
NYC
40.78
-73.47
Shanghai
31.17
121.47
> rm(latitude,longitude,citynames)
> attach(cities)
> plot(longitude,latitude,type="n")
> points(longitude,latitude,pch=".")
> text(longitude[1], latitude[1],
row.names(cities)[1],pos=1)
> lines(c(longitude[1],longitude[3]),
c(latitude[1],latitude[3]))
>
264
:
-1 )" plot(longitude,latitude,type="n
" type = "n .
-2 pos 1 2 3 4 .
adj offset .
:3-D
f ( x, y ) = x y 3 ] x [ 1,1 ]y [ 1,1
50 ] [ 1,1 outer
) ( 50X50
2
)> x <- seq(-1,1,length=50

)> y <- seq(-1,1,length=50
265
)z <- outer(x^2,y^3
)contour(x,y,z
)image(x,y,z
)persp(x,y,z
266
>
>
>
>
: R essentials
R
buffer

:
)"> savehistory("filename.Rhistory
:
)"> loadhistory("filename.Rhistory

:
)> source("filename ", echo=TRUE
The search path

R .
R ) global environment
( .GlobalEnv R
) (
)( attach
)( detach . )( search

)(> search
)> objects(package:MASS
)> objects(4
:R packages
R
.R
)(.library

)(> library
Packages in library 'C:/PROGRA~1/R/R-28~1.1/library':
267
base
boot
class
cluster
codetools
datasets
foreign
The R Base Package

Bootstrap R (S-Plus) Functions (Canty)
Functions for Classification
Cluster Analysis Extended Rousseeuw et al.
Code Analysis Tools for R
The R Datasets Package
Read Data Stored by Minitab, S, SAS, SPSS,
Stata, Systat, dBase, ...
The R Graphics Package
The R Graphics Devices and Support for
Colours and Fonts
The Grid Graphics Package
Functions for kernel smoothing for Wand &
Jones (1995)
Lattice Graphics
Main Package of Venables and Ripley's MASS
Formal Methods and Classes
GAMs with GCV/AIC/REML smoothness
graphics
grDevices
grid
KernSmooth
lattice
MASS
methods
mgcv
estimation
and GAMMs by PQL

Linear and Nonlinear Mixed Effects Models
Feed-forward Neural Networks and
nlme
nnet
Multinomial
Log-Linear Models
Utility function for defining S3 methods
R object-oriented programming with or
without references
Recursive Partitioning
Sim 101 Package for WSC 2008
Functions for Kriging and Point Pattern
Analysis
Regression Spline Functions and Classes
The R Stats Package
Statistical Functions using S4 Classes
Survival analysis, including penalised
likelihood.
Tcl/Tk Interface
Tools for Package Development
The R Utils Package
R.methodsS3
R.oo
rpart
Sim101
spatial
splines
stats
stats4
survival
tcltk
tools
utils
MASS
> library(MASS)

> library(help=MASS)
Information on package 'MASS'
Description:
268
Bundle:
Priority:
Contains:
Version:
Date:
Depends:
Suggests:
Author:
Maintainer:
BundleDescription:
License:
URL:
Packaged:
Package:
Description:
Title:
LazyLoad:
LazyData:
Built:
VR
recommended
MASS class nnet spatial
7.2-45
2008-12-07
R (>= 2.4.0), grDevices, graphics, stats,
utils
lattice, nlme, survival
S original by Venables & Ripley. R port by
Brian Ripley <ripley@stats.ox.ac.uk>,
following earlier work by Kurt Hornik and
Albrecht Gebhardt.
Brian Ripley <ripley@stats.ox.ac.uk>
Functions and datasets to support Venables
and Ripley, 'Modern Applied Statistics with
S' (4th edition).
GPL-2 | GPL-3
http://www.stats.ox.ac.uk/pub/MASS4/
Tue Dec 9 11:11:17 2008; ripley
MASS
The main library and the datasets
Main Package of Venables and Ripley's MASS
yes
yes
R 2.8.1; i386-pc-mingw32; 2008-12-22
09:22:56; windows
Index:
Functions:
=========
Null
addterm
anova.negbin
Binomial GLMs
area
bandwidth.nrd
Reference
bcv
Selection
boxcox
con2tr
Trellis
confint-MASS
contr.sdif
corresp
cov.rob
Location and
Null Spaces of Matrices

Try All One-Term Additions to a Model
Likelihood Ratio Tests for Negative
Adaptive Numerical Integration
Bandwidth for density() via Normal
Distribution
Biased Cross-Validation for Bandwidth
Box-Cox Transformations for Linear Models
Convert Lists to Data Frames for use by
Confidence Intervals for Model Parameters
Successive Differences contrast coding
Simple Correspondence Analysis
Resistant Estimation of Multivariate
Scatter
269
cov.trob
Distribution
denumerate
'loglm'
dose.p
dropterm
eqscplot
fitdistr
Distributions
fractions
gamma.dispersion
Parameter
gamma.shape
Distribution
ginv
glm.convert
fit
glm.nb
Linear Model
glmmPQL
PQL
hist.scott
Selection
huber
Scale
hubers
Location
isoMDS
Scaling
kde2d
lda
ldahist
Groups
lm.gls
Squares
lm.ridge
loglm
logtrans
lqs
mca
mvrnorm
Distribution
negative.binomial
GLMs
newcomb
Time of Light
Covariance Estimation for Multivariate t

Transform an Allowable Formula for
into one for 'terms'
Predict Doses for Binomial Assay model
Try All One-Term Deletions from a Model
Plots with Geometrically Equal Scales
Maximum-likelihood Fitting of Univariate
Rational Approximation
Calculate the MLE of the Gamma Dispersion
in a GLM Fit
Estimate the Shape Parameter of the Gamma
in a GLM Fit
Generalized Inverse of a Matrix
Change a Negative Binomial fit to a GLM
Fit a Negative Binomial Generalized
Fit Generalized Linear Mixed Models via
Plot a Histogram with Automatic Bin Width
Huber M-estimator of Location with MAD
Huber Proposal 2 Robust Estimator of
and/or Scale
Kruskal's Non-metric Multidimensional
Two-Dimensional Kernel Density Estimation
Linear Discriminant Analysis
Histograms or Density Plots of Multiple
Fit Linear Models by Generalized Least
Ridge Regression
Fit Log-Linear Models by Iterative
Proportional Scaling
Estimate log Transformation Parameter
Resistant Regression
Multiple Correspondence Analysis
Simulate from a Multivariate Normal
Family function for Negative Binomial
Newcomb's Measurements of the Passage
270
pairs.lda
'lda' Fit
parcoord
plot.lda
plot.mca
polr
predict.lda
Linear
predict.lqs
predict.mca
predict.qda
Analysis
qda
rational
renumerate
'denumerate'
rlm
rms.curv
Linear Regression
rnegbin
sammon
stdres
Linear Model
stepAIC
Algorithm
studres
Linear Model
summary.loglm
Class 'loglm'
summary.negbin
Class 'negbin'
summary.rlm
synth.tr
theta.md
by Deviance
theta.ml
by Maximum
theta.mm
by Moments
truehist
ucv
Selection
width.SJ
of Derivatives
write.matrix
Produce Pairwise Scatterplots from an

Parallel Coordinates Plot
Plot Method for Class 'lda'
Plot Method for Objects of Class 'mca'
Proportional Odds Logistic Regression
Classify Multivariate Observations by
Discrimination
Predict from an lqs Fit
Predict Method for Class 'mca'
Classify from Quadratic Discriminant
Quadratic Discriminant Analysis
Rational Approximation
Convert a Formula Transformed by
Robust Fitting of Linear Models
Relative Curvature Measures for NonSimulate Negative Binomial Variates
Sammon's Non-Linear Mapping
Extract Standardized Residuals from a
Choose a model by AIC in a Stepwise
Extract Studentized Residuals from a
Summary Method Function for Objects of
Summary Method Function for Objects of
Summary Method for Robust Linear Models
Synthetic Classification Problem
Estimate theta of the Negative Binomial
Likelihood
Plot a Histogram
Unbiased Cross-Validation for Bandwidth
Bandwidth Selection by Pilot Estimation
Write a Matrix or Data Frame
Datasets:
========
271
Aids2
Animals
Belgian-phones
Boston
Cars93
1993
Cushings
Cushing's Syndrome
DDT
GAGurine
Insurance
Melanoma
OME
with OME
Pima.tr
Rabbit
Rubber
SP500
Sitka
1988
Sitka89
1989
Skye
Traffic
Accidents
UScereal
US Cereals
UScrime
Rates
VA
Trial
abbey
accdeaths
anorexia
bacteria
Treatments
beav1
beav2
biopsy
birthwt
Birth Weight
cabbages
caith
Caithness
cats
cement
chem
coop
Chemistry
cpus
crabs
Leptograpsus Crabs
Australian AIDS Survival Data

Brain and Body Weights for 28 Species
Belgium Phone Calls 1950-1973
Housing Values in Suburbs of Boston
Data from 93 Cars on Sale in the USA in
Diagnostic Tests on Patients with
DDT in Kale
Level of GAG in Urine of Children
Numbers of Car Insurance claims
Survival from Malignant Melanoma
Tests of Auditory Perception in Children
Diabetes in Pima Indian Women
Blood Pressure in Rabbits
Accelerated Testing of Tyre Rubber
Returns of the Standard and Poors 500
Growth Curves for Sitka Spruce Trees in
AFM Compositions of Aphyric Skye Lavas
Effect of Swedish Speed Limits on
Nutritional and Marketing Information on
The Effect of Punishment Regimes on Crime
Veteran's Administration Lung Cancer
Determinations of Nickel Content
Accidental Deaths in the US 1973-1978
Anorexia Data on Weight Change
Presence of Bacteria after Drug
Body Temperature Series of Beaver 1
Biopsy Data on Breast Cancer Patients
Risk Factors Associated with Low Infant
Data from a cabbage field trial
Colours of Eyes and Hair of People in
Anatomical Data from Domestic Cats
Heat Evolved by Setting Cements
Copper in Wholemeal Flour
Co-operative Trial in Analytical
Performance of Computer CPUs
Morphological Measurements on
272
drivers
1969-84
eagles
epil
farms
fgl
forbes
Alps
galaxies
gehan
genotype
geyser
gilgais
hills
housing
Conditions
immer
leuk
mammals
Land Mammals
mcycle
menarche
michelson
minn38
motors
muscle
Contraction
nlschools
npk
npr1
oats
painters
petrol
quine
South Wales
road
rotifer
ships
shoes
shrimp
shuttle
snails
steam
stormer
survey
topo
waders
Africa
whiteside
Deaths of Car Drivers in Great Britain

Foraging Ecology of Bald Eagles
Seizure Counts for Epileptics
Ecological Factors in Farm Management
Measurements of Forensic Glass Fragments
Forbes' Data on Boiling Points in the
Velocities for 82 Galaxies
Remission Times of Leukaemia Patients
Rat Genotype Data
Old Faithful Geyser Data
Line Transect of Soil in Gilgai Territory
Record Times in Scottish Hill Races
Frequency Table from a Copenhagen Housing
Survey
Yields from a Barley Field Trial
Survival Times and White Blood Counts for
Leukaemia Patients
Brain and Body Weights for 62 Species of
Data from a Simulated Motorcycle Accident
Age of Menarche data
Michelson's Speed of Light Data
Minnesota High School Graduates of 1938
Accelerated Life Testing of Motorettes
Effect of Calcium Chloride on Muscle
in Rat Hearts
Eighth-Grade Pupils in the Netherlands
Classical N, P, K Factorial Experiment
US Naval Petroleum Reserve No. 1 data
Data from an Oats Field Trial
The Painter's Data of de Piles
N. L. Prater's Petrol Refinery Data
Absenteeism from School in Rural New
Road Accident Deaths in US States
Numbers of Rotifers by Fluid Density
Ships Damage Data
Shoe wear data of Box, Hunter and Hunter
Percentage of Shrimp in Shrimp Cocktail
Space Shuttle Autolander Problem
Snail Mortality Data
The Saturated Steam Pressure Data
The Stormer Viscometer Data
Student Survey Data
Spatial Topographic Data
Counts of Waders at 15 Sites in South
House Insulation: Whiteside's Data
273
wtloss
Weight Loss Data from an Obese Patient

data()
> data()
Data sets in package datasets:
AirPassengers
Monthly Airline Passenger Numbers 1949-1960
BJsales
Sales Data with Leading Indicator
BJsales.lead (BJsales)
Sales Data with Leading Indicator
BOD
Biochemical Oxygen Demand
CO2
Carbon Dioxide uptake in grass plants
ChickWeight
Weight versus age of chicks on different
diets
DNase
Elisa assay of DNase
EuStockMarkets
Daily Closing Prices of Major European
Stock
Indices, 1991-1998
Formaldehyde
Determination of Formaldehyde
HairEyeColor
Hair and Eye Color of Statistics Students
Harman23.cor
Harman Example 2.3
Harman74.cor
Harman Example 7.4
Indometh
Pharmacokinetics of Indomethicin
InsectSprays
Effectiveness of Insect Sprays
JohnsonJohnson
Quarterly Earnings per Johnson & Johnson
Share
LakeHuron
Level of Lake Huron 1875-1972
LifeCycleSavings
Intercountry Life-Cycle Savings Data
Loblolly
Growth of Loblolly pine trees
Nile
Flow of the River Nile
Orange
Growth of Orange Trees
OrchardSprays
Potency of Orchard Sprays
PlantGrowth
Results from an Experiment on Plant Growth
Puromycin
Reaction velocity of an enzymatic reaction
Seatbelts
Road Casualties in Great Britain 1969-84
Theoph
Pharmacokinetics of theophylline
Titanic
Survival of passengers on the Titanic
ToothGrowth
The Effect of Vitamin C on Tooth Growth in
Guinea Pigs
UCBAdmissions
Student Admissions at UC Berkeley
UKDriverDeaths
Road Casualties in Great Britain 1969-84
UKgas
UK Quarterly Gas Consumption
USAccDeaths
USArrests
Violent Crime Rates by US State
USJudgeRatings
Lawyers' Ratings of State Judges in the US
Superior Court
USPersonalExpenditure
Personal Expenditure Data
VADeaths
Death Rates in Virginia (1940)
274
WWWusage
WorldPhones
ability.cov
airmiles
Internet Usage per Minute

The World's Telephones
Ability and Intelligence Tests
Passenger Miles on Commercial US Airlines,
1937-1960
airquality
New York Air Quality Measurements
anscombe
Anscombe's Quartet of "Identical" Simple
Linear Regressions
attenu
The Joyner-Boore Attenuation Data
attitude
The Chatterjee-Price Attitude Data
austres
Quarterly Time Series of the Number of
Australian Residents
beaver1 (beavers)
Body Temperature Series of Two Beavers
beaver2 (beavers)
Body Temperature Series of Two Beavers
cars
Speed and Stopping Distances of Cars
chickwts
Chicken Weights by Feed Type
co2
Mauna Loa Atmospheric CO2 Concentration
crimtab
Student's 3000 Criminals Data
discoveries
Yearly Numbers of Important Discoveries
esoph
Smoking, Alcohol and (O)esophageal Cancer
euro
Conversion Rates of Euro Currencies
euro.cross (euro)
Conversion Rates of Euro Currencies
eurodist
Distances Between European Cities
faithful
fdeaths (UKLungDeaths)
Monthly Deaths from Lung Diseases in the UK
freeny
Freeny's Revenue Data
freeny.x (freeny)
freeny.y (freeny)
infert
Infertility after Spontaneous and Induced
Abortion
iris
Edgar Anderson's Iris Data
iris3
Edgar Anderson's Iris Data
islands
Areas of the World's Major Landmasses
ldeaths (UKLungDeaths)
lh
Luteinizing Hormone in Blood Samples
longley
Longley's Economic Regression Data
lynx
Annual Canadian Lynx trappings 1821-1934
mdeaths (UKLungDeaths)
morley
Michaelson-Morley Speed of Light Data
mtcars
Motor Trend Car Road Tests
nhtemp
Average Yearly Temperatures in New Haven
nottem
Average Monthly Temperatures at Nottingham,
1920-1939
occupationalStatus
Occupational Status of Fathers and their
Sons
precip
Annual Precipitation in US Cities
presidents
Quarterly Approval Ratings of US Presidents
pressure
Vapor Pressure of Mercury as a Function of
Temperature
275
quakes
randu
Locations of Earthquakes off Fiji

Random Numbers from Congruential Generator
RANDU
rivers
Lengths of Major North American Rivers
rock
Measurements on Petroleum Rock Samples
sleep
Student's Sleep Data
stack.loss (stackloss)
Brownlee's Stack Loss Plant Data
stack.x (stackloss)
stackloss
state.abb (state)
US State Facts and Figures
state.area (state)
state.center (state)
state.division (state)
state.name (state)
state.region (state)
state.x77 (state)
sunspot.month
Monthly Sunspot Data, 1749-1997
sunspot.year
Yearly Sunspot Data, 1700-1988
sunspots
Monthly Sunspot Numbers, 1749-1983
swiss
Swiss Fertility and Socioeconomic
Indicators
(1888) Data
treering
Yearly Treering Data, -6000-1979
trees
Girth, Height and Volume for Black Cherry
Trees
uspop
Populations Recorded by the US Census
volcano
Topographic Information on Auckland's
Maunga
Whau Volcano
warpbreaks
The Number of Breaks in Yarn during Weaving
women
Average Heights and Weights for American
Women
Data sets in package MASS:
Aids2
Animals
Boston
Cars93
1993
Cushings
DDT
GAGurine
Insurance
Melanoma
OME
Australian AIDS Survival Data

Brain and Body Weights for 28 Species
Housing Values in Suburbs of Boston
Data from 93 Cars on Sale in the USA in
Diagnostic Tests on Patients with Cushing's
Syndrome
DDT in Kale
Level of GAG in Urine of Children
Numbers of Car Insurance claims
Survival from Malignant Melanoma
Tests of Auditory Perception in Children
with OME
276
Pima.te
Pima.tr
Pima.tr2
Rabbit
Rubber
SP500
Sitka
1988
Sitka89
1989
Skye
Traffic
UScereal
UScrime
VA
abbey
accdeaths
anorexia
bacteria
beav1
beav2
biopsy
birthwt
cabbages
caith
cats
cement
chem
coop
cpus
crabs
deaths
drivers
eagles
epil
farms
fgl
forbes
galaxies
gehan
genotype
geyser
gilgais
hills
housing

Blood Pressure in Rabbits
Accelerated Testing of Tyre Rubber
Returns of the Standard and Poors 500
AFM Compositions of Aphyric Skye Lavas
Effect of Swedish Speed Limits on Accidents
Nutritional and Marketing Information on US
Cereals
The Effect of Punishment Regimes on Crime
Rates
Veteran's Administration Lung Cancer Trial
Determinations of Nickel Content
Anorexia Data on Weight Change
Presence of Bacteria after Drug Treatments
Biopsy Data on Breast Cancer Patients
Risk Factors Associated with Low Infant
Birth Weight
Data from a cabbage field trial
Colours of Eyes and Hair of People in
Caithness
Anatomical Data from Domestic Cats
Heat Evolved by Setting Cements
Copper in Wholemeal Flour
Co-operative Trial in Analytical Chemistry
Performance of Computer CPUs
Morphological Measurements on Leptograpsus
Crabs
Deaths of Car Drivers in Great Britain
1969-84
Foraging Ecology of Bald Eagles
Seizure Counts for Epileptics
Ecological Factors in Farm Management
Measurements of Forensic Glass Fragments
Forbes' Data on Boiling Points in the Alps
Velocities for 82 Galaxies
Remission Times of Leukaemia Patients
Rat Genotype Data
Line Transect of Soil in Gilgai Territory
Record Times in Scottish Hill Races
Frequency Table from a Copenhagen Housing
Conditions Survey
277
immer
leuk
mammals
mcycle
menarche
michelson
minn38
motors
muscle
newcomb
nlschools
npk
npr1
oats
painters
petrol
phones
quine
road
rotifer
ships
shoes
shrimp
shuttle
snails
steam
stormer
survey
synth.te
synth.tr
topo
waders
Africa
whiteside
wtloss
Yields from a Barley Field Trial

Survival Times and White Blood Counts for
Leukaemia Patients
Brain and Body Weights for 62 Species of
Land Mammals
Data from a Simulated Motorcycle Accident
Age of Menarche in Warsaw
Michelson's Speed of Light Data
Minnesota High School Graduates of 1938
Accelerated Life Testing of Motorettes
Effect of Calcium Chloride on Muscle
Contraction in Rat Hearts
Newcomb's Measurements of the Passage Time
of Light
Eighth-Grade Pupils in the Netherlands
Classical N, P, K Factorial Experiment
US Naval Petroleum Reserve No. 1 data
Data from an Oats Field Trial
The Painter's Data of de Piles
N. L. Prater's Petrol Refinery Data
Belgium Phone Calls 1950-1973
Absenteeism from School in Rural New South
Wales
Road Accident Deaths in US States
Numbers of Rotifers by Fluid Density
Ships Damage Data
Shoe wear data of Box, Hunter and Hunter
Percentage of Shrimp in Shrimp Cocktail
Space Shuttle Autolander Problem
Snail Mortality Data
The Saturated Steam Pressure Data
The Stormer Viscometer Data
Student Survey Data
Spatial Topographic Data
Counts of Waders at 15 Sites in South
House Insulation: Whiteside's Data
Weight Loss Data from an Obese Patient
Use data(package = .packages(all.available = TRUE))

to list the data sets in all *available* packages.

> data(mydata, package=MASS)

278
279
280
> update.packages(ask='graphics')
--- Please select a CRAN mirror for use in this session --Warning: package 'VR' is in use and will not be installed
trying URL
'http://cran.mtu.edu/bin/windows/contrib/2.8/cluster_1.11.13.zip'
Content type 'application/zip' length 518967 bytes (506 Kb)
opened URL
downloaded 506 Kb
trying URL
'http://cran.mtu.edu/bin/windows/contrib/2.8/lattice_0.17-22.zip'
opened URL
downloaded 904 Kb
trying URL
'http://cran.mtu.edu/bin/windows/contrib/2.8/survival_2.35-4.zip'
Content type 'application/zip' length 2694031 bytes (2.6 Mb)
opened URL
281
downloaded 2.6 Mb
package 'cluster' successfully unpacked and MD5 sums checked
package 'lattice' successfully unpacked and MD5 sums checked
Warning: cannot remove prior installation of package 'lattice'
package 'survival' successfully unpacked and MD5 sums checked
The downloaded packages are in
C:\Documents and Settings\amb\Local
Settings\Temp\RtmptdGcgZ\downloaded_packages
updating HTML package descriptions
>
> utils:::menuInstallPkgs()
trying URL
'http://cran.mtu.edu/bin/windows/contrib/2.8/neural_1.4.2.zip'
opened URL
downloaded 58 Kb
package 'neural' successfully unpacked and MD5 sums checked
The downloaded packages are in
C:\Documents and Settings\amb\Local
Settings\Temp\Rtmp1dLn2q\downloaded_packages
updating HTML package descriptions
> library(neural)
> library(help = neural)
>
Information on package 'neural'

Description:
Package:
Version:
Title:
Author:
Maintainer:
Description:
License:
Built:
neural
1.4.2
Neural Networks
dm Nagy
dm Nagy <sodzsu@yahoo.com>
RBF and MLP neural networks with graphical user
interface
GPL version 2 or later
R 2.8.1; ; 2008-12-14 01:45:38; windows
Index:
mlp
MLP neural network recalling method
282
mlptrain
rbf
rbftrain
letters_train
letters_out
letters_recall
MLP neural network training method

RBF neural network recalling method
RBF neural network training method
dataset for pattern recognizing
:Arrays and matrices

. R
.
dim arry() .
matrix() .2
> m1 <- array(1:15,dim = c(3,5))
> m1
[,1] [,2] [,3] [,4] [,5]
[1,]
1
4
7
10
13
[2,]
2
5
8
11
14
[3,]
3
6
9
12
15
> m2 <- matrix(1:15,3,5)
> m2
[,1] [,2] [,3] [,4] [,5]
[1,]
1
4
7
10
13
[2,]
2
5
8
11
14
[3,]
3
6
9
12
15
> m3 <- 1:15
> dim(m3) <- c(3,5)
> m3
[,1] [,2] [,3] [,4] [,5]
[1,]
1
4
7
10
13
[2,]
2
5
8
11
14
[3,]
3
6
9
12
15
> c(class(m1), class(m2), class(m3))
[1] "matrix" "matrix" "matrix"
> array(1:15, dim=c(3,6)) # recycling rule used
[,1] [,2] [,3] [,4] [,5] [,6]
[1,]
1
4
7
10
13
1
283
][2,
2
5
8
11
14
2
][3,
3
6
9
12
15
3
> array(1:15, dim=c(2,4)) # extra values discarded
][,1] [,2] [,3] [,4
][1,
1
3
5
7
][2,
2
4
6
8
> m1+m1
][,1] [,2] [,3] [,4] [,5
][1,
2
8
14
20
26
][2,
4
10
16
22
28
][3,
6
12
18
24
30
> m1*m1
][,1] [,2] [,3] [,4] [,5
][1,
1
16
49 100 169
][2,
4
25
64 121 196
][3,
9
36
81 144 225
) conformal matrices
(
. %*%
)( solve ax = b
) solve(A,b ) solve(A .A
))> m4 <- array(1:3, c(4,2
> m4
][,1] [,2
][1,
1
2
][2,
2
3
][3,
3
1
][4,
1
2
))> m5 <- array(3:8, c(2,3
> m5
][,1] [,2] [,3
][1,
3
5
7
284
][2,
> m4 %*% m5
][,1] [,2] [,3
][1,
11
17
23
][2,
18
28
38
][3,
13
21
29
][4,
11
17
23
))> m6 <- array(c(1,3,2,1),c(2,2
> m6
][,1] [,2
][1,
1
2
][2,
3
1
))> v1 <- array(c(1,0), c(2,1
> v1
][,1
][1,
1
][2,
0
)> solve(m6,v1
][,1
[1,] -0.2
[2,] 0.6
> solve(m6) # inverts m6
][,1] [,2
[1,] -0.2 0.4
[2,] 0.6 -0.2
)> solve(m6) %*% v1 # does the same as solve(m6,v1
][,1
[1,] -0.2
[2,] 0.6
outer product
. )( outer
) (
) (
. 2X2
285
} {0,,5 AD - BC
A B C D .
)( table

> m7 <- outer(0:5,0:5) # every possible value of AD
and BC
> m7
][,1] [,2] [,3] [,4] [,5] [,6
][1,
0
0
0
0
0
0
][2,
0
1
2
3
4
5
][3,
0
2
4
6
8
10
][4,
0
3
6
9
12
15
][5,
0
4
8
12
16
20
][6,
0
5
10
15
20
25
> freq <- table(outer(m7,m7,"-")) # frequency for
all values of AD-BC
> freq
> freq
-4
59
18
4
-5
45
17
6
-6
42
16
18
-7
17
15
29
-8
39
14
8
-9
22
13
8
-25 -24 -23 -22 -21 -20 -19 -18 -17 -16 -15 -14 -13 -12 -11 -10
11
1
2
2
3 24
4
4
6 18 29
8
8 33 12 38
-3 -2 -1
0
1
2
3
4
5
6
7
8
9 10 11 12
45 52 39 170 39 52 45 59 45 42 17 39 22 38 12 33
19 20 21 22 23 24 25
4 24
3
2
2
1 11
> plot(freq/sum(freq), xlab="Determinant value",

)"+ylab = "Probability
286
R )( t
transpose )( nrow )( ncol
)( rbind )( cbind .
)( eigen eigenvectors and eigenvalues
singular value decomposition
)( svd.
287
:Data from the Internet

)( read.table :
> data <-read.table("http://www.stat.ucla.edu/~vlew
)"/stat130a/datasets/twins.csv",header=TRUE,sep=",
header=TRUE R
.
" sep=", R )" . (" ,
288
Quick R
:
Working directory:
setwd("../scripts")
getwd()
:
Help:
help(x)
?x
help.search("x")
help.start()
demo()
demo(graphics)
:
Installing and loading the package:
install.packages("spuRs")
library(spuRs)
:
Arithmetic:
(1 + 1/100)^100
17%%5
17%/%5
exp(1)
options(digits = 16)
exp(1)
pi
sin(pi/6)
:
Variables:
x <- 100
x
(1 + 1/x)^x
x <- 200
(1 + 1/x)^x
(y <- (1 + 1/x)^x)
n <- 1
n <- n + 1
n
:
Functions:
289
seq(from = 1, to = 9, by = 2)
seq(from = 1, to = 9)
seq(1, 9, 2)
seq(to = 9, from = 1)
seq(by = -2, 9, 1)
x <- 9
seq(1, x, x/3)
290
:
Vectors:
(x <- seq(1, 20, by = 2))
(y <- rep(3, 4))
(z <- c(y, x))
(x <- 100:110)
i <- c(1, 3, 2)
x[i]
j <- c(-1, -2, -3)
x[j]
x <- c()
length(x)
:
Algebraic operations on vectors:
x <- c(1, 2, 3)
y <- c(4, 5, 6)
x * y
x + y
y^x
c(1, 2, 3, 4) + c(1, 2)
(1:10)^c(1, 2)
2 + c(1, 2, 3)
2 * c(1, 2, 3)
(1:10)^2
sqrt(1:6)
mean(1:6)
sort(c(5, 1, 3, 4, 2))
:
Example: mean and variance
x <- c(1.2, 0.9, 0.8, 1, 1.2)
x.mean <- sum(x)/length(x)
x.mean - mean(x)
x.var <- sum((x - x.mean)^2)/(length(x) - 1)
x.var - var(x)
:
Example: simple numerical integration
dt <- 0.005
t <- seq(0, pi/6, by = dt)
ft <- cos(t)
(I <- sum(ft) * dt)
I - sin(pi/6)
:
291
Example: exponential limit

x <- seq(10, 200, by = 10)
y <- (1 + 1/x)^x
plot(x, y)
:
Missing data:
a <- NA # assign NA to variable A
is.na(a) # is it missing?
a <- c(11,NA,13) # now try a vector
is.na(a) # is it missing?
mean(a) # NAs can propagate
mean(a, na.rm = TRUE) # NAs can be removed
:
Matrices:
(A <- matrix(1:6, nrow = 2, ncol = 3, byrow = TRUE))
A[1, 3] <- 0
A[, 2:3]
(B <- diag(c(1, 2, 3)))
(A <- matrix(c(3, 5, 2, 3), nrow = 2, ncol = 2))
(B <- matrix(c(1, 1, 0, 1), nrow = 2, ncol = 2))
A %*% B
A * B
(A.inv <- solve(A))
A %*% A.inv
A^(-1)
A[2]
is.matrix(x)
is.vector(x)
A <- as.matrix(x)
as.vector(A)
:
The workspace:
ls()
objects()
rm(x)
rm(list = ls())
save.image(file = "fname")
save(x, y, file = "fname")
292
load(file = "fname")
savehistory(file = "fname")
loadhistory(file = "fname")
:
Basic programming:
# find the zeros of a2*x^2 + a1*x + a0 = 0
# clear the workspace
rm(list=ls())
# input
a2 <- 1
a1 <- 4
a0 <- 2
# calculation
root1 <- (-a1 + sqrt(a1^2 - 4*a2*a0))/(2*a2)
root2 <- (-a1 - sqrt(a1^2 - 4*a2*a0))/(2*a2)
# output
show(c(root1, root2))
:if
Branching with if:
if (logical_expression) {
expression_1
...
}
if (logical_expression) {
expression_1
...
} else {
expression_2
...
}
:
Example: roots of a quadratic
rm(list=ls())
# input
a2 <- 1
a1 <- 4
a0 <- 5
# calculate the discriminant
discrim <- a1^2 - 4*a2*a0
# calculate the roots depending on the value of the
discriminant
293
if (discrim > 0) {
roots <- c( (-a1 + sqrt(a1^2 - 4*a2*a0))/(2*a2),
(-a1 - sqrt(a1^2 - 4*a2*a0))/(2*a2) )
} else {
if (discrim == 0) {
roots <- -a1/(2*a2)
} else {
roots <- c()
}
}
# output
show(roots)
:for
Looping with for:
for (x in vector) {
expression_1
...
}
:
Example: summing a vector
(x_list <- seq(1, 9, by = 2))
sum_x <- 0
for (x in x_list) {
+ sum_x <- sum_x + x
+ cat("The current loop element is", x, "\n")
+ cat("The cumulative total is", sum_x, "\n")
+ }
sum(x_list)
:n
Example: n factorial
# Calculate n factorial
rm(list=ls())
# Input
n <- 6
# Calculation
n_factorial <- 1
for (i in 1:n) {
n_factorial <- n_factorial * i
}
# Output
294
show(n_factorial)
:while
Looping with while:
while (logical_expression) {
expression_1
...
}
:
Example: Fibonacci numbers
F1, F2, . . .,
F1 = 1,
F2 = 1,
Fn = Fn1 + Fn2 for n 2.
# calculate the first Fibonacci number greater than 100

rm(list=ls())
# initialise variables
F <- c(1, 1) # list of Fibonacci numbers
n <- 2 # length of F
# iteratively calculate new Fibonacci numbers
while (F[n] <= 100) {
# cat("n =", n, " F[n] =", F[n], "\n")
n <- n + 1
F[n] <- F[n-1] + F[n-2]
}
# output
cat("The first Fibonacci number > 100 is F(", n, ") =",
F[n], "\n")
F
:
Vector-based programming:
n :
Example: sum of the first n squares using a loop
n <- 100
S <- 0
for (i in 1:n) {
+ S <- S + i^2
+ }
295
n :
Example: sum of the first n squares using vector
operations:
sum((1:n)^2)
ifelse:
ifelse(test, A, B)
x <- c(-2, -1, 1, 2)
ifelse(x > 0, "Positive", "Negative")
pmin and pmax:

max min
pmin(c(1, 2, 3), c(3, 2, 1), c(2, 2, 2))
:
Input from a file:
list.files(path = "dir.name")
scan(file = "", what = 0, n = -1, sep = "", skip = 0, quiet
= FALSE)
:
Example: file input
# Calculate median and quartiles.
# Clear the workspace
rm(list=ls())
# Input
# We assume that the file file_name consists of numeric
values
# separated by spaces and/or newlines
file_name = "../data/data1.txt"
# Read from file
data <- scan(file = file_name)
# Calculations
n <- length(data)
data.sort <- sort(data)
data.1qrt <- data.sort[ceiling(n/4)]
data.med <- data.sort[ceiling(n/2)]
data.3qrt <- data.sort[ceiling(3*n/4)]
296
# Output
cat("1st Quartile:", data.1qrt, "\n")
cat("Median: ", data.med, "\n")
cat("3rd Quartile:", data.3qrt, "\n")
OR:
quantile(scan("../data/data1.txt"), (0:4)/4)
297
:
Input from the keyboard:
:
rm(list=ls())
# input
cat("find the zeros of a2*x^2 + a1*x + a0 = 0\n")
a2 <- as.numeric(readline("a2 = "))
discriminant
if (discrim > 0) {
roots <- (-a1 + c(1,-1) * sqrt(a1^2 - 4*a2*a0))/(2*a2)
} else {
if (discrim == 0) {
roots <- -a1/(2*a2)
} else {
roots <- c()
}
}
# output
if (length(roots) == 0) {
cat("no roots\n")
} else if (length(roots) == 1) {
cat("single root at", roots, "\n")
} else {
cat("roots at", roots[1], "and", roots[2], "\n")
}
:
Output to a file:
write(x, file = "data", ncolumns = if(is.character(x)) 1
else 5,
append = FALSE)
(x <- matrix(1:24, nrow = 4, ncol = 6))
write(t(x), file = "../results/out.txt", ncolumns = 6)
cat(..., file = "", sep = " ", append = FALSE)
298
dump("x", file = "../results/x.txt")
:
Plotting:
plot(x, y, type)
:
Example:
x <- seq(0, 5, by = 0.01)
y.upper <- 2 * sqrt(x)
y.lower <- -2 * sqrt(x)
y.max <- max(y.upper)
y.min <- min(y.lower)
plot(c(-2, 5), c(y.min, y.max), type = "n", xlab = "x",
+ ylab = "y")
lines(x, y.upper)
lines(x, y.lower)
abline(v = -1)
points(1, 0)
text(1, 0, "focus (1, 0)", pos = 4)
text(-1, y.min, "directrix x = -1", pos = 4)
title("The parabola y^2 = 4*x")
:
Multiple graphs:
par(mfrow = c(nr, nc))
par(mfcol = c(nr, nc))
:
example:
par(mfrow
curve(x *
curve(x *
curve(x *
curve(x *
par(mfrow
= c(2, 2))
sin(x), from
sin(x), from
sin(x), from
sin(x), from
= c(1, 1))
=
=
=
=
0,
0,
0,
0,
to
to
to
to
=
=
=
=
100, n = 1001)
10, n = 1001)
1, n = 1001)
0.1, n = 1001)
:
Programming with functions:
:
Functions:
:
name <- function(argument_1, argument_2, ...) {
299
expression_1
expression_2
...
return(output)
}
)(
name(x1, x2, ...)
:
quad3 <- function(a0, a1, a2) {
if (a2 == 0 && a1 == 0 && a0 == 0) {
roots <- NA
} else if (a2 == 0 && a1 == 0) {
roots <- NULL
} else if (a2 == 0) {
roots <- -a0/a1
} else {
discriminant
if (discrim > 0) {
roots <- (-a1 + c(1,-1) * sqrt(a1^2 - 4*a2*a0))/(2*a2)
} else if (discrim == 0) {
roots <- -a1/(2*a2)
} else {
roots <- NULL
}
}
return(roots)
}
:
output:
rm(list = ls())
quad3(1, 0, -1)
quad3(1, -2, 1)
quad3(1, 1, 1)
( ) r n :
Example: n choose r
n_factorial <- function(n) {
300
# Calculate n factorial
n_fact <- prod(1:n)
return(n_fact)
}
n_choose_r <- function(n, r) {
# Calculate n choose r
n_ch_r <- n_factorial(n)/n_factorial(r)/n_factorial(n-r)
return(n_ch_r)
}
:
output:
rm(list = ls())
n_choose_r(4, 2)
n_choose_r(6, 4)
:
Scope:
Arguments Variable
x
.
.
:
Illustration:
test <- function(x) {
+ y <- x + 1
+ return(y)
+ }
test(1)
[1] 2
x
Error: Object "x" not found
y
Error: Object "y" not found
y <- 10
test(1)
301
[1] 2
y
[1] 10
The variable
scope .
:
{ )test2 <- function(x
+ y <- x + z
)+ return(y
} +
z <- 1
)test2(1
[1] 2
z <- 2
)test2(1
[1] 3
:
Optional arguments and default values:
argument_1 x1 argument_1 = x1
.
R .
:
Illustration:
{ )test3 <- function(x = 1, y = 1, z = 1
)+ return(x * 100 + y * 10 + z
} +
)test3(2, 2
[1] 221
)test3(y = 2, z = 2
[1] 122
302
:
Vector-based programming using functions:
R Vectorised Functions
.
R .
R
Vectorisation :
apply, sapply, lapply, tapply, and mapply.
) sapply(X, FUN FUN
X ) sapply(X, FUN i
)] FUN(X[i FUN ] X[i
) sapply(X, FUN, ...
) FUN(X[i], ... .i
.mapply
) (
.apply
:
Example: density of primes
.
sapply 2:n
. n
) cumsum(x x.
TRUE/FALSE R
) 1/0 (R coerces into a 1/0 vector .
# estimate the density of primes (using a very inefficient
)algorithm
))(rm(list=ls
{ )prime <- function(n
# returns TRUE if n is prime
# assumes n is a positive integer
{ )if (n == 1
is.prime <- FALSE
{ )} else if (n == 2
is.prime <- TRUE
{ } else
is.prime <- TRUE
303
for (m in 2:(n/2)) {
if (n %% m == 0) is.prime <- FALSE
}
}
return(is.prime)
}
# input
# we consider primes <= n
n <- 1000
# calculate the number of primes <= m for m in 2:n
# num.primes[i] == number of primes <= i+1
m.vec <- 2:n
primes <- sapply(m.vec, prime)
num.primes <- cumsum(primes)
# output
# plot the actual prime density against the theoretical
limit
par(mfrow = c(1, 2))
plot(m.vec, num.primes/m.vec, type = "l",
main = "prime density", xlab = "n", ylab = "")
lines(m.vec, 1/log(m.vec), col = "red")
plot(m.vec, num.primes/m.vec*log(m.vec), type = "l",
main = "prime density * log(n)", xlab = "n", ylab = "")
par(mfrow = c(1, 1))
prime <- function(n) {
# returns TRUE if n is prime
# assumes n is a positive integer
if (n == 1) {
is.prime <- FALSE
} else if (n == 2) {
is.prime <- TRUE
} else {
is.prime <- TRUE
m <- 2
m.max <- sqrt(n) # only want to calculate this once
while (is.prime && m <= m.max) {
if (n %% m == 0) is.prime <- FALSE
m <- m + 1
}
}
return(is.prime)
}
:
304
Recursive programming:
.
.
n :
Example: n factorial
nfact2 <- function(n) {
# calculate n factorial
if (n == 1) {
cat("called nfact2(1)\n")
return(1)
} else {
cat("called nfact2(", n, ")\n", sep = "")
return(n*nfact2(n-1))
}
}
nfact2(6)
called
called
called
called
called
called
nfact2(6)
nfact2(5)
nfact2(4)
nfact2(3)
nfact2(2)
nfact2(1)
[1] 720
) ( :
Example: Sieve of Eratosthenes

.n
primesieve <- function(sieved, unsieved) {
# finds primes using the Sieve of Eratosthenes
# sieved: sorted vector of sieved numbers
# unsieved: sorted vector of unsieved numbers
# cat("sieved", sieved, "\n")
# cat("unsieved", unsieved, "\n")
p <- unsieved[1]
n <- unsieved[length(unsieved)]
if (p^2 > n) {
return(c(sieved, unsieved))
} else {
unsieved <- unsieved[unsieved %% p != 0]
sieved <- c(sieved, p)
305
return(primesieve(sieved, unsieved))
}
}
output:
rm(list = ls())
primesieve(c(), 2:200)
:
Sophisticated data structures:
:
Factors:
:
Illustration:
hair <- c("blond", "black", "brown", "brown", "black",
"gray","none")
is.character(hair)
[1] TRUE
is.factor(hair)
[1] FALSE
hair <- factor(hair)
levels(hair)
[1] "black" "blond" "brown" "gray" "none"
hair <- factor(hair, levels = c("black", "gray", "brown",
+ "blond", "white", "none"))
table(hair)
hair
black gray brown blond white none
2
1
2
1
0
1
hair
[1] blond black brown brown black gray none
Levels: black gray brown blond white none
as.vector(hair)
306
[1] "blond" "black" "brown" "brown" "black" "gray" "none"

as.numeric(hair)
[1] 4 1 3 3 1 2 6
c(hair, 5)
[1] 4 1 3 3 1 2 6 5
x <- factor(c(0.8, 1.1, 0.7, 1.4, 1.4, 0.9))
as.numeric(x) # does not recover x
[1] 2 4 1 5 5 3
as.numeric(levels(x))[x] # does recover x
[1] 0.8 1.1 0.7 1.4 1.4 0.9
as.numeric(as.character(x)) # does recover x
[1] 0.8 1.1 0.7 1.4 1.4 0.9
table(hair[hair == "gray" | hair == "none"])
black gray brown blond white none
0
1
0
0
0
1
table(hair[hair == "gray" | hair == "none", drop = TRUE])
gray none
1
1
:
Illustration:
phys.act <- c("L", "H", "H", "L", "M", "M")
phys.act <- factor(phys.act, levels = c("L", "M", "H"),
+ ordered = TRUE)
is.ordered(phys.act)
[1] TRUE
phys.act[2] > phys.act[1]
[1] TRUE
307
phys.act <- factor(phys.act, levels = c("L", "M", "H"),

+ labels = c("Low", "Medium", "High"), ordered = TRUE)
table(phys.act)
phys.act
Low Medium High
2
2
2
which(phys.act == "High")
[1] 2 3
308
:
Dataframes:
Lists Dataframes
.

.Multivariate Datasets
.
) (
.
).( basic modes of object
R read.table
:
)"" = read.table(file, header = FALSE, sep
read.table .
read.table ) read.csv(file :
read.table(file, header = TRUE, sep = ",").
) read.delim(file ) (Tab
:
read.delim (file, header = TRUE, sep = "\t").
:
Example:
)"ufc <- read.csv("../data/ufc.csv
)head(ufc
plot tree species dbh.cm height.m
1
2
1
DF
39
20.5
2
2
2
WL
48
33.0
3
3
2
GF
52
30.0
4
3
5
WC
36
20.7
5
3
8
WC
38
22.5
6
4
1
WC
46
18.0
)tail(ufc
plot tree species dbh.cm height.m
331 143 1
GF
28.0
21.0
332 143 2
GF
33.0
20.5
333 143 7
WC
47.8
20.5
334 144 1
GF
10.2
16.0
335 144 2
DF
31.5
22.0
336 144 4
WL
26.5
25.0
309

x <- ufc$height.m
]x[1:5
[1] 20.5 33.0 30.0 20.7 22.5
]] ufc$height.m, ufc[[5 ]]" ufc[["height.m

]ufc[1:5, 5
[1] 20.5 33.0 30.0 20.7 22.5
] ufc[4:5 ])".ufc[c("dbh.cm", "height.m

]diam.height <- ufc[4:5
] diam.height[1:5,
dbh.cm height.m
1 39 20.5
2 48 33.0
3 52 30.0
4 36 20.7
5 38 22.5
)is.data.frame(diam.height
[1] TRUE
)mode(ufc
"[1] "list
)]mode(ufc[5
"[1] "list
)]]mode(ufc[[5
"[1] "numeric

/ data.frame
:
data.frame(col1 = x1, col2 = x2, ..., df1, df2,
)...
col1 col2 )
" ' ( x1 x2 df1 df2
x1 . x2
:
ufc$volume.m3 <- pi * (ufc$dbh.cm/200)^2 * ufc$height/2
)mean(ufc$volume.m3
[1] 1.93294
310
:
ufc[[6]] ufc["volume.m3"] ufc[6] ufc$volume.m3
. ufc[["volume.m3"]]
. df names(df)
:
(ufc.names <- names(ufc))
[1] "plot" "tree" "species" "dbh.cm" "height.m"
[6] "volume.m3"
names(ufc) <- c("P", "T", "S", "D", "H", "V")
names(ufc)
[1] "P" "T" "S" "D" "H" "V"
names(ufc) <- ufc.names
:
Dataframe attributes:
names(df)
dim(df)
row.names(df)
:subset
The function subset:
fir.height <- subset(ufc, subset = species %in% c("DF",
"GF"),
+ select = c(plot, tree, height.m))
head(fir.height)
plot tree height.m
1 2 1 20.5
3 3 2 30.0
7 4 2 17.0
8 5 2 29.3
9 5 4 29.0
10 6 1 26.0
x %in% y y x
x[i] TRUE i x
.y
:
To write a dataframe to a file we use
write.table(x, file = "", append = FALSE, sep = " ",
row.names = TRUE, col.names = TRUE)
311
.na.omit
:
Attaching:

)attach(ufc
)]"max(height.m[species == "GF
[1] 47
height.m <- 0 #vandalism

)max(height.m
[1] 0
)max(ufc$height.m
[1] 47
)detach(ufc
)max(ufc$height.m
[1] 47
:
Lists:
Indexed set
) ( Mode.

R
. .
)( list .

.
:
Examples:
))"> my.list <- list("one", TRUE, 3, c("f", "o", "u", "r
]]> my.list[[2
[1] TRUE
)]]> mode(my.list[[2
312
[1] "logical"
> my.list[2]
[[1]]
[1] TRUE
> mode(my.list[2])
[1] "list"
> my.list[[4]][1]
[1] "f"
> my.list[4][1]
[[1]]
[1] "f" "o" "u" "r"
[[ 2]] [[ 1]] R
.[ 2] [ 1]
> my.list <- list(first = "one", second = TRUE, third = 3,
+ fourth = c("f", "o", "u", "r"))
> names(my.list)
[1] "first" "second" "third" "fourth"
> my.list$second
[1] TRUE
> names(my.list) <- c("First element", "Second element",
+ "Third element", "Fourth element")
> my.list$"Second element"
[1] TRUE
> x <- "Second element"
> my.list[[x]]
[1] TRUE
unlist(x)
313
))> x <- list(1, c(2, 3), c(4, 5, 6

)> unlist(x
[1] 1 2 3 4 5 6

.recursive = FALSE
))> lm.xy <- lm(y ~ x, data = data.frame(x = 1:5, y = 1:5
)> mode(lm.xy
"[1] "list
)> names(lm.xy
"[1] "coefficients" "residuals" "effects" "rank
"[5] "fitted.values" "assign" "qr" "df.residual
"[9] "xlevels" "call" "terms" "model
lm .
coefficients a b residuals
yi - a xi - b i fitted.values a xi + b.
apply
The apply family
R
) ( .
tapply
:
tapply(X, INDEX, FUN, ...),
:
X .
314
INDEX factor X ) (group

.X
FUN .
lapply sapply
Applying functions to lists lapply and sapply
sapply apply array
.
sapply .lappy ) lapply(X,FUN,
FUN X . ) sapply(X,FUN,
FUN X X .
315
:R
:

install.packages('ggplot2')
install.packages("Rcmdr")

library(ggplot2)

update.packages()

help(functionname)
mean
help(mean)
?mean

args(functionname)
args
args(mean)
function (x, ...)
NULL
args(sd)
function (x, na.rm = FALSE)
NULL

example(functionname)
example(mean)
mean> x <- c(0:10, 50)
mean> xm <- mean(x)
mean> c(xm, mean(x, trim = 0.1))
[1] 8.75 5.50
316
mean> mean(USArrests, trim = 0.2)

Murder Assault UrbanPop Rape
7.42 167.60 66.20 20.16
R
help.start()
R
http://rseek.org
http://stackoverflow.com/
http://stats.stackexchange.com/
RSiteSearch("key phrase")
RSiteSearch("canonical correlation")

getwd()

setwd("R:\\data")
setwd("R:/data")

dir()
317
:
dfrm
dfrm = read.table("filename.txt")
dfrm = read.table("statisticians.txt", sep=" ")

) statisticians.txt
(
dfrm V1
dfrm$V1
class(dfrm$V1)

dfrm = read.table("statisticians.txt", header=TRUE)
csv
tbl = read.csv("filename")
csv
tbl = read.csv("filename", header=FALSE)

data = read.csv(file.choose(), header = TRUE)

hs0 <read.table("http://www.ats.ucla.edu/stat/R/notes/hs
0.csv", header=T, sep=",")

data =
read.csv("http://wiki.stdout.org/rcookbook/Data
input and output/Loading data from a
file/datafile.csv")
data
318
First
Last Sex Number
1 Currer
Bell
F
2
2
Dr.
Seuss
M
49
3
Student <NA>
21
data2 =
read.csv("http://wiki.stdout.org/rcookbook/Data
input and output/Loading data from a file/datafilenoheader.csv", header=FALSE)
data2
V1
V2
V3 V4
1 Currer
Bell
F 2
2
Dr.
Seuss
M 49
3
Student <NA> 21
names(data2) <- c("First","Last","Sex","Number")
data2
First
Last Sex Number
1 Currer
Bell
F
2
2
Dr.
Seuss
M
49
3
Student <NA>
21
>
:Excel
gdata
library(gdata)
data = read.xls("data.xls")
319
SAS SPSS
foreign
library(foreign)
data = read.spss("data.sav", to.data.frame=TRUE)
data = read.sas("data.sas", to.data.frame=TRUE)

data = read.csv(stdin())
data = read.table(stdin(), header=TRUE)
data = read.csv('clipboard')
data = read.table('clipboard', header=TRUE)
:
a<-read.csv(stdin())
gender,id,race,ses,schtyp,prgtype,read,write,math,s
cience,socst
0,70,4,1,1,general,57,52,41,47,57
1,121,4,2,1,vocati,68,59,53,63,61
0,86,4,3,1,general,44,33,54,58,31
0,141,4,3,1,vocati,63,44,47,53,56

print(data, row.names=FALSE)

write.csv(df, 'clipboard', row.names=FALSE)
write.csv(data, stdout(), row.names=FALSE)

write.csv(data, "data.csv", row.names=FALSE)
write.table(data, "data.csv", sep="\t",
row.names=FALSE, col.names=FALSE)
write.csv(data, "data.csv", row.names=FALSE, na="")
320

dump("data", "data.Rdmpd")
source("data.Rdmpd")
R
save("data", file="data.RData")
load("data.RData")
321

) (
)c(1,1,2,3,5,8,13,21
v1 v2
)v1 = c(1,2,3
)v2 = c(4,5,6
v1 ) v2 (
)c(v1,v2
x
)x = c(0,1,1,2,3,5,8,13,21,34
) x (
)mean(x
[1] 8.8
) x (
)median(x
[1] 4
) x (
)sd(x
[1] 11.03328
) x (
)var(x
[1] 121.7333
x y
)y <- log(x+1
x y
)cor(x,y
[1] 0.9068053
x y
)cov(x,y
[1] 11.49988
) x ( missing value R
NA
)x <- c(0,1,1,2,3,NA
NA
)mean(x
[1] NA
)sd(x
[1] NA
322
na.rm=TRUE

mean(x, na.rm=TRUE)
[1] 1.4
sd(x, na.rm=TRUE)
[1] 1.140175
dframe
print(dframe)
small
medium
big
1 0.6739635 10.526448 99.83624
2 1.5524619 9.205156 100.70852
3 0.3250562 11.427756 99.73202
4 1.2143595 8.533180 98.53608
5 1.3107692 9.763317 100.74444
6 2.1739663 9.806662 98.58961
7 1.6187899 9.150245 100.46707
8 0.8872657 10.058465 99.88068
9 1.9170283 9.182330 100.46724
10 0.7767406 7.949692 100.49814
dframe
summary(dframe)
mean(dframe)
small
medium
big
1.245040 9.560325 99.946003
sd(dframe)
small
medium
big
0.5844025 0.9920281 0.8135498
var(dframe)
small
medium
big
small 0.34152627 -0.21516416 -0.04005275
medium -0.21516416 0.98411974 -0.09253855
big -0.04005275 -0.09253855 0.66186326
cor(dframe)
small
medium
big
small 1.00000000 -0.3711367 -0.08424345
323
medium -0.37113670 1.0000000 -0.11466070

big -0.08424345 -0.1146607 1.00000000
cov(dframe)
small
medium
big
small 0.34152627 -0.21516416 -0.04005275
medium -0.21516416 0.98411974 -0.09253855
big -0.04005275 -0.09253855 0.66186326
:

20 1
hs0[1:20, ]

names(hs0)
)(
attach(hs0)

detach()
getOption("digits")
options(digits=2)
by(hs0, prgtype, mean, na.rm=T)
by(hs0, prgtype, sd, na.rm=T)
m
<- tapply(write, prgtype, mean)
v
<- tapply(write, prgtype, var)
med <- tapply(write, prgtype, median)
n
<- tapply(write, prgtype, length)
sd <- tapply(write, prgtype, sd)
cbind(mean=m, var=v, std.dev=sd, median=med, n=n)
hist(write)
# load trellis graphics
library(lattice)
# trellis graphs
histogram(~write, hs0, type="count")
# histogram of write by gender
histogram(~write | gender, hs0, type="count")
324
# change the number of bins to 15

hist(write, breaks=15)

table(ses)
tab1<-table(gender, ses)
# row proportions
prop.table(tab1,1)
# column proportions
prop.table(tab1,2)
# row frequencies
rowSums(tab1)
# column frequencies
colSums(tab1)

# shorthand way of referring to read, write, math,
science
read.sci <- hs0[ , 7:10]
# correlation of a pair of variables
cor(write, math)
cor(write, science)
cor(write, science, use="complete.obs")
# correlation matrix
plot(math, write)
# scatter plot matrix
plot(read.sci)
cor(read.sci, use="complete.obs")
plot(math, write)
> # correlation of a pair of variables
> cor(write, math)
> cor(write, science)
> cor(write, science, use="complete.obs")
> # correlation matrix
> plot(math, write)
> # scatter plot matrix
> # shorthand way of referring to read, write,
math, science
> read.sci <- hs0[ , 7:10]
> plot(read.sci)
> cor(read.sci, use="complete.obs")
> cor(read.sci, use="pairwise.complete.obs")
325
> plot(math, write)

> # scatter plot matrix
> hs1 <read.table("http://www.ats.ucla.edu/stat/R/notes/hs
> hs1.read.well <- hs1[hs1$read >= 60, ]
> mean(hs1.read.well$read)
> mean(hs1$read)
> hs2<-hs1[, c("read", "write")]
> # another way of doing the same thing
> hs3<-hs1[, c(7, 8)]
> names(hs3)
> hs2.drop<-hs1[, -c(7, 8)]
> names(hs2.drop)
> attach(hs1)
> hsfemale<-hs1[female==1, ]
> hsmale<-hs1[female==0, ]
> dim(hsfemale)
> dim(hsmale)
> hs.all<-rbind(hsfemale, hsmale)
> dim(hs.all)
> hs.demo<-hs1[, c("id", "ses", "female", "race")]
> hs.scores<-hs1[, c("id", "read", "write", "math",
"science")]
> dim(hs.demo)
> dim(hs.scores)
> hs.merge <- merge(hs.demo, hs.scores, by="id",
all=T)
> head(hs.merge)
> dim(hs.merge)
> hs.merge1 <- merge(hs.demo, hs.scores, by.x="id",
by.y="id", all=T)
326

dfrm = data.frame(v1, v2, v3, f1, f2)
dfrm = as.data.frame(list.of.vectors)
n
dfrm[[n]]
dfrm n
dfrm[n]
dfrm n1, n2, ,nk
dfrm[c(n1, n2, ..., nk)]
) ( subscrip
n .
dfrm[, n]
dfrm n1, n2, ,nk
dfrm[, c(n1, n2, ..., nk)]
:
suburbs = read.table(file.choose(), header = TRUE)
suburbs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
city county state

pop
Chicago
Cook
IL 2853114
Kenosha Kenosha
WI
90352
Aurora
Kane
IL 171782
Elgin
Kane
IL
94487
Gary
Lake
IN 102746
Joliet Kendall
IL 106221
Naperville DuPage
IL 147779
Arlington
Cook
IL
76031
Bolingbrook
Will
IL
70834
Cicero
Cook
IL
72616
Evanston
Cook
IL
74239
Hammond
Lake
IN
83048
Palatine
Cook
IL
67232
Schaumburg
Cook
IL
75386
Skokie
Cook
IL
63348
327
16
Waukegan
suburbs[[1]]
Lake
IL
91452
[1] "Chicago" "Kenosha" "Aurora" "Elgin"

[5] "Gary" "Joliet" "Naperville" "Arlington
Heights"
[9] "Bolingbrook" "Cicero" "Evanston" "Hammond"
[13] "Palatine" "Schaumburg" "Skokie" "Waukegan"
suburbs[1]
city
1 Chicago
2 Kenosha
3 Aurora
4 Elgin
5 Gary
6 Joliet
7 Naperville
8 Arlington Heights
9 Bolingbrook
10 Cicero
11 Evanston
12 Hammond
13 Palatine
14 Schaumburg
15 Skokie
16 Waukegan
suburbs[c(1,3)]
city pop
1 Chicago 2853114
2 Kenosha 90352
3 Aurora 171782
4 Elgin 94487
5 Gary 102746
6 Joliet 106221
7 Naperville 147779
8 Arlington Heights 76031
9 Bolingbrook 70834
10 Cicero 72616
328
11
12
13
14
15
16
Evanston 74239
Hammond 83048
Palatine 67232
Schaumburg 75386
Skokie 63348
Waukegan 91452
suburbs[,1]
[1] "Chicago" "Kenosha" "Aurora" "Elgin"
[5] "Gary" "Joliet" "Naperville" "Arlington
Heights"
[9] "Bolingbrook" "Cicero" "Evanston" "Hammond"
[13] "Palatine" "Schaumburg" "Skokie" "Waukegan"
suburbs[,c(1,4)]
city pop
1 Chicago 2853114
2 Kenosha 90352
3 Aurora 171782
4 Elgin 94487
5 Gary 102746
6 Joliet 106221
7 Naperville 147779
8 Arlington Heights 76031
9 Bolingbrook 70834
10 Cicero 72616
11 Evanston 74239
12 Hammond 83048
13 Palatine 67232
14 Schaumburg 75386
15 Skokie 63348
16 Waukegan 91452
:con
data = read.table(header=T, con = textConnection('
subject sex size
1
M
7
2
F
6
3
F
9
4
M
11
'))
329
)close(con
data
subject sex size
1
M
7
2
F
6
3
F
9
4
M
11
1
2
3
4
:Negative Indexing
)x = c(1,4,4,3,2,2,3
x
[1] 1 4 4 3 2 2 3
]x[-1
[1] 4 4 3 2 2 3
.
]x[-1:-3
[1] 3 2 2 3
1 3
])x[-length(x
[1] 1 4 4 3 2 2
.
:
(1 rep
)y = rep(1, 10
y
[1] 1 1 1 1 1 1 1 1 1 1
)z = rep(1:5, 4
z
[1] 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5
)w = rep(1:5, each=4
w
[1] 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5
)abc = rep(factor(LETTERS[1:3]), 5
330
abc
[1] A B C A B C A B C A B C A B C
Levels: A B C
ls ( 2
ls()
[1] "abc"
"con"
"n"
"suburbs" "v"
[11] "y"
"z"
"data"
"w"
"df"
"let"
"x"
rm ( 3
rm(v)
ls()
[1] "abc"
"con"
"n"
"suburbs" "w"
[11] "z"
"data"
"x"
"df"
"let"
"y"
( )( 4
length(x)
[1] 1
length(y)
[1] 10
length(n)
[1] 4
( 5
nrow(df)
[1] 4
ncol(df)
[1] 2
dim(df)
[1] 4 2
331
:
data <- read.table(header=T, con <textConnection('
subject sex condition before after change
1
F
placebo
10.1
6.9
-3.2
2
F
placebo
6.3
4.2
-2.1
3
M
aspirin
12.4
6.3
-6.1
4
F
placebo
8.1
6.1
-2.0
5
M
aspirin
15.2
9.9
-5.3
6
F
aspirin
10.9
7.0
-3.9
7
F
aspirin
11.6
8.5
-3.1
8
M
aspirin
9.5
3.0
-6.5
9
F
placebo
11.5
9.0
-2.5
10
M
placebo
11.9 11.0
-0.9
11
F
aspirin
11.4
8.0
-3.4
12
M
aspirin
10.0
4.4
-5.6
13
M
aspirin
12.5
5.4
-7.1
14
M
placebo
10.6 10.6
0.0
15
M
aspirin
9.1
4.3
-4.8
16
F
placebo
12.1 10.2
-1.9
17
F
placebo
11.0
8.8
-2.2
18
F
placebo
11.9 10.2
-1.7
19
M
aspirin
9.1
3.6
-5.5
20
M
placebo
13.5 12.4
-1.1
21
M
aspirin
12.0
7.5
-4.5
22
F
placebo
9.1
7.6
-1.5
23
M
placebo
9.9
8.0
-1.9
24
F
placebo
7.6
5.2
-2.4
25
F
placebo
11.8
9.7
-2.1
26
F
placebo
11.8 10.7
-1.1
27
F
aspirin
10.1
7.9
-2.2
28
M
aspirin
11.6
8.3
-3.3
29
F
aspirin
11.3
6.8
-4.5
30
F
placebo
10.3
8.3
-2.0
'))
close(con)
library(plyr)
cdata <- ddply(data, .(sex, condition), summarise,
332
N
=
change =
sd
=
se
=
sqrt(length(change)) )
length(change),
mean(change),
sd(change),
sd(change) /
dataNA <- data

dataNA$change[11:14] <- NA
cdata <- ddply(dataNA, .(sex, condition),
summarise,
N
= sum(!is.na(change)),
change = mean(change, na.rm=TRUE),
sd
= sd(change, na.rm=TRUE),
se
= sd(change, na.rm=TRUE) /
sqrt(sum(!is.na(change))) )
333

Regression and correlation
:
set.seed(955)
xvar <- 1:20 + rnorm(20,sd=3)
zvar <- 1:20/4 + rnorm(20,sd=2)
yvar <- -2*xvar + xvar*zvar/5 + 3 + rnorm(20,sd=4)
df <- data.frame(x=xvar, y=yvar, z=zvar)
cor(df$x, df$y)
cor(df)
round(cor(df),2)
fit <- lm(y ~ x, data=df)
fit <- lm(df$y ~ df$x)
summary(fit)
fit2 <- lm(y ~ x + z, data=df)
fit2 <- lm(df$y ~ df$x + df$z)
:
interactions:
fit3 <- lm(y ~ x * z, data=df)
fit3 <- lm(y ~ x + z + x:z, data=df)
t-test
sleep
sleep
extra group ID
0.7
1 1
-1.6
1 2
-0.2
1 3
-1.2
1 4
-0.1
1 5
334
3.4
3.7
0.8
0.0
2.0
1.9
0.8
1.1
0.1
-0.1
4.4
5.5
1.6
4.6
3.4
1 6
1 7
1 8
1 9
1 10
2 1
2 2
2 3
2 4
2 5
2 6
2 7
2 8
2 9
2 10
sleep.wide <- data.frame(ID=1:10,

group1=sleep$extra[1:10],
group2=sleep$extra[11:20])
t.test(extra ~ group, sleep)
t.test(sleep.wide$group1, sleep.wide$group2)
t.test(extra ~ group, sleep, var.equal=TRUE)
t.test(sleep.wide$group1, sleep.wide$group2,
var.equal=TRUE)
t
Paired-sample t-test
t.test(extra ~ group, sleep, paired=TRUE)

t.test(sleep.wide$group1, sleep.wide$group2,
paired=TRUE)
t.test(sleep.wide$group1 - sleep.wide$group2, mu=0,
var.equal=TRUE)
335
One-sample t-test
t.test(sleep$extra, mu=0)

Frequency tests
data <- read.table(header=TRUE, con <textConnection('
condition result
control
0
control
0
control
0
control
0
treatment
1
control
0
control
0
treatment
0
treatment
1
control
1
treatment
1
treatment
1
treatment
1
treatment
1
treatment
0
control
0
control
1
control
0
control
1
treatment
0
treatment
1
treatment
0
treatment
0
control
0
treatment
1
control
0
control
0
treatment
1
treatment
0
treatment
1
'))
close(con)
336

Tests of goodness-of-fit

Chi-square test
ct <- table(data$result)
# An alternative is to manually create the table
#ct <- matrix(c(17,13), ncol=2)
#colnames(ct1) <- c("0", "1")
chisq.test(ct)
ct <- table(data$result)
pt <- c(.75, .25)
chisq.test(ct, p=pt)

Tests of independence

Chi-square test
ct <- table(data$condition, data$result)
chisq.test(ct)
chisq.test(ct, correct=FALSE)
337
ANOVA
data <- read.table(header=T, con <textConnection('
subject sex
age before after
1
F
old
9.5
7.1
2
M
old
10.3 11.0
3
M
old
7.5
5.8
4
F
old
12.4
8.8
5
M
old
10.2
8.6
6
M
old
11.0
8.0
7
M young
9.1
3.0
8
F young
7.9
5.2
9
F
old
6.6
3.4
10
M young
7.7
4.0
11
M young
9.4
5.3
12
M
old
11.6 11.3
13
M young
9.9
4.6
14
F young
8.6
6.4
15
F young
14.3 13.5
16
F
old
9.2
4.7
17
M young
9.8
5.1
18
F
old
9.9
7.3
19
F young
13.0
9.5
20
M young
10.2
5.4
21
M young
9.0
3.7
22
F young
7.9
6.2
23
M
old
10.1 10.0
24
M young
9.0
1.7
25
M young
8.6
2.9
26
M young
9.4
3.2
27
M young
9.7
4.7
28
M young
9.3
4.9
29
F young
10.7
9.8
30
M
old
9.3
9.4
'))
close(con)
338

One way between ANOVA
# One way between:

# IV: sex
# DV: before
aov.before.sex <- aov(before ~ sex, data=data)
summary(aov.before.sex)

Two way between ANOVA
# 2x2 between:
# IV: sex
# IV: age
# DV: after
# These two calls are equivalent
aov.after.sex.age <- aov(after ~ sex*age,
data=data)
aov.after.sex.age <- aov(after ~ sex + age +
sex:age, data=data)
summary(aov.after.sex.age)
:

rm(list=ls())

attach(hs1)

tab1 <- table(female, ses)
# chi-square test of independence
summary(tab1)
t
t.test(write, mu=50)
t
t.test(write, read, paired=TRUE)
339
t
by(write, female, var)
tapply(write, female, var)
# assuming equal variances
t.test(write~female, var.equal=TRUE)
# assuming unequal variances
t.test(write~female, var.equal=FALSE)
:
anova(lm(write~factor(prog)))
summary(aov(write~factor(prog)))
m2<-lm(write~factor(prog)*factor(female))
anova(m2)
anova(lm(write~factor(prog) + read))
summary(aov(write~factor(prog) + read))
:
summary(lm(write~female+read))
lm2 <- lm(write~read+socst)
summary(lm2)
# plotting diagnostic plots of lm2
plot(lm2)
write[1:20]
fitted(lm2)[1:20]
resid(lm2)[1:20]
340
Numerical Methods :

Numerical Derivatives
Examples
library(mosaic)
g = numD( a*x^2 + x*y ~ x, a=1)
g(x=2,y=10)
gg = numD( a*x^2 + x*y ~ x&x, a=1)
gg(x=2,y=10)
ggg = numD( a*x^2 + x*y ~ x&y, a=1)
ggg(x=2,y=10)
h = numD( g(x=x,y=y,a=a) ~ y, a=1)
h(x=2,y=10)
f = numD( sin(x)~x, add.h.control=TRUE)
plotFun( f(3,.hstep=h)~h, hlim=range(.00000001,.000001))
ladd( panel.abline(cos(3),0))
R Summary Examples
===========Getting Help in R==========
?read.table
find(lowess)
apropos(lm)
============Worked Examples of Functions===
example(lm)
=========Demonstrations of R Functions=========
demo(persp)
demo(graphics)
demo(Hershey)
demo(plotmath)
==================Libraries in R=============
library(spatial)
===============Contents of Libraries=======
library(help=spatial)
objects(grep("spatial",search()))
=======Installing Packages and Libraries=========
install.packages("akima")
install.packages("chron")
install.packages("Ime4")
341
install.packages("mcmc")
install.packages("odesolve")
install.packages("spdep")
install.packages("spatstat")
install.packages("tree")
===================Data Editor=================
library(MASS)
attach(bacteria)
fix(bacteria)
==================Significance Stars============
options(show.signif.stars=FALSE)
options( digits = 3)
========To stop multiple graphs whizzing by====
par(ask=TRUE)
================Good Housekeeping============
objects()
search()
ls()
rm(list=ls())
rm(x,y,z)
detach(worms)
====Summary Information from Vectors by Groups=====
data<-read.table("c:\\temp\\daphnia.txt",header=T)
attach(data)
names(data)
tapply(Growth.rate,Detergent,mean)
tapply(Growth.rate,list(Water,Daphnia),median)
with(data, function( ...))
with(OrchardSprays,boxplot(decrease~treatment))
library(MASS)
with(bacteria,tapply((y=="n"),trt,sum))
with(mammals,plot(body,brain,log="xy"))
reg.data<-read.table("c:\\temp\\regression.txt",header=T)
with (reg.data, {
model<-lm(growth~tannin)
summary(model) } )
summary(lm(growth~tannin,data=reg.data))
=======To see the names of the dataframes in the built-in
package called datasets====
data()
342
==========To see all available data sets=========

data(package = .packages(all.available = TRUE))
=============Sorting, Ranking and Ordering=======

houses<-read.table("c:\\temp \\houses.txt",header=T)
attach(houses)
names(houses)
[1] "Location" "Price"
ranks<-rank(Price)
sorted<-sort(Price)
ordered<-order(Price)
view<-data.frame(Price,ranks,sorted,ordered)
view
===============Matrices========================
X<-matrix(c(1,0,0,0,1,0,0,0,1),nrow=3)
X
vector<-c(1,2,3,4,4,3,2,1)
V<-matrix(vector,byrow=T,nrow=2)
V
====================Data Input==============
y <- c (6,7,3,4,8,5,6,2)
x<-scan() (enter data, to finish return)
===============Data Input from Files===========
data<-read.table("c:\\temp\\regression.txt",header=T)
map<-read.table("c:\\temp\\bowens.csv",header=T,sep=",")
map<-read.csv("c:\\temp\\bowens.csv")
read.delim("c:\\temp\\file.txt")
===============Browsing to Find Files==========
data<-read.table(file.choose(),header=T)
=============Reading from clipboard=========
data <-read.table("clipboard", sep = " "))
==============Setting the Working Directory=====
343
setwd("c:\\temp")
getwd()
=====================Dataframes===============
worms<-read.table(file.choose(), header = T)
attach(worms)
names(worms)
summary(worms)
by(worms,Vegetation,mean)
===============Subscripts and Indices=========
worms[3,5]
worms[14:19,7]
worms[1:5,2:3]
worms[3,]
worms[,3]
worms[,c(1,5)]
===================Sorting Dataframes===========
worms[order(Slope),]
worms[rev(order(Slope)),]
worms[order(Vegetation,Worm.density),]
====Omitting Rows Containing Missing Values, NA====
na.omit(data)
new.frame<-na.exclude(data)
===Dataframe with Row Names instead of Row Numbers=
worms<-read.table(file.choose(),header=T,row.names=1)
====Summarizing the Contents of Dataframes =======
aggregate(worms[,c(2,3,5,7)],by=list(veg=Vegetation),mean)
aggregate(worms[,c(2,3,5,7)],by=list(veg=Vegetation,d=Damp)
,mean)
========Adding Normal Curve to histogram========
x<-rnorm(300)
h<-hist(x, breaks=10, col="red", xlab="Simulated Data",
main="Histogram with Normal Curve")
xfit<-seq(min(x),max(x),length=40)
yfit<-dnorm(xfit,mean=mean(x),sd=sd(x))
yfit <- yfit*diff(h$mids[1:2])*length(x)
lines(xfit, yfit, col="blue", lwd=2)
====another example=========
n <- 1000
x <- rnorm(n)
h <- hist(x, col="red",freq=TRUE)
344
dx <- min(diff(h$breaks))
curve(n*dx*dnorm(x), add=TRUE, col="blue", lwd=2)
===Classical Tests===Plots for testing normality ==
x<-exp(rnorm(30))
qqnorm(x)
qqline(x,lty=2)
================Test for normality===============
x<-exp(rnorm(30))
shapiro.test(x)
wilcox.test(x,mu=0)
hist(x)
skew(x)
kurtosis(x)
==========quantiles of the F distribution=========
qf(0.975,9,9)
======F test to compare two variances========
x<-exp(rnorm(30))
y<-exp(rnorm(30))
var.test(x,y)
====Bartlett test of homogeneity of variances =====
bartlett.test(x,y)
===Comparing two means==Students t test======
qt(0.975,18)
t.test(x,y)
==================Tests on paired samples=========
t.test(x,y,paired=T)
=======Chi-squared contingency tables========
qchisq(0.95,1)
count<-matrix(c(38,14,11,51),nrow=2)
chisq.test(count)
chisq.test(count,correct=F)
chisq.test(count,correct=F)$expected
============Test of contingency=========
chisq.test(c(10,3,2,6))
chisq.test(c(10,3,2,6),p=c(0.2,0.2,0.3,0.3))
die<-ceiling(runif(100,0,6))
345
table(die)
chisq.test(table(die))
=======Fishers Exact Test for Count Data ======
x<-as.matrix(c(6,4,2,8))
dim(x)<-c(2,2)
fisher.test(x)
=========Correlation and covariance=============
var(x,y) ====covariance of x and y===
cor(x,y)
=====Pearsons product-moment correlation========
cor.test(Summer, Winter)
cor.test(x,y,method="spearman")
=============KolmogorovSmirnov test============
ks.test(A,B)
=========Regression====very simple intro===
reg<-lm(y ~ x)
summary(reg)
lm.influence(lm(growth~tannin))
influence.measures(lm(growth ~ tannin))
model<-lm(Fruit ~ Root,subset=(Grazing=="Grazed")) ====
na.action = na.omit
model<-lm(Fruit ~ Grazing*Root,na.action=na.fail)
AIC(model)
model.1<-lm(Fruit ~ Grazing*Root)
model.2<-lm(Fruit ~ Grazing+Root)
AIC(model.1, model.2)
==================Leverage===========
leverage(x1)
plot(leverage(x1),type="h")
abline(0.66,0,lty=2)
points(leverage(x1))
======Extracting components of the model using $ ==
model$coef
model$fitted
model$resid
model$df
==Extracting components from the summary.aov table=
summary.aov(model)
summary.aov(model)
346
Df
tannin
Residuals
Sum Sq Mean Sq F value Pr(>F)

1
88.817 88.817 30.974 0.000846
7
20.072 2.867
summary.aov(model)[[1]][[1]]
[1] 1 7
[1] 88.81667 20.07222
[1] 88.816667 2.867460
[1] 30.97398 NA
[1] 0.0008460738 NA
model<-lm(biomass ~ clipping)
summary.aov(model)
summary.lm(model)
anova(model6,model7)
===========Prediction using the fitted model==
model<-lm(growth~tannin)
predict(model,list(tannin=5.5))
predict(model,list(tannin=c(3.3,4.4,5.5,6.6)))
===============Model checking========
par(mfrow=c(2,2))
plot(model)
==========The Multiple Regression Model=========
model7<-lm(log(ozone) ~ temp + wind + rad + I(temp^2) +
I(wind^2))
summary(model7)
===================Step reg=======
model10<-step(model1)
summary(model10)
pairs(pollute,panel=panel.smooth)
================One-Way ANOVA========
results<-read.table("c:\\temp\\yields.txt",header=T)
attach(results)
347
names(results)
sapply(list(sand,clay,loam),mean)
y<-c(sand,clay,loam)
soil<-factor(rep(1:3,c(10,10,10)))
sapply(list(sand,clay,loam),var)
plot(soil,y,names=c("sand","clay","loam"),ylab="yield")
summary(aov(y~soil))
plot(aov(y~soil))
summary.lm(aov(y~soil))
summary.lm(model1)
summary.aov(model2)
>
>
>
>
>
>
>
>
>
x<-rnorm(150)
h<-hist(x,breaks=15)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(min(x),max(x),length=40)
yfit<-dnorm(xfit,mean=mean(x),sd=sd(x))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)))
lines(xfit,yfit)
curve(dnorm(x,0,1),xlim=c(-3.5,3.5))
curve(dnorm(x,0,1),-3.5,3.5)
> dat <- rnorm(30, mean = 82, sd = 7)
> hist(dat, prob = TRUE)
> curve(dnorm(x, mean = mean(dat), sd = sd(dat)), add =
TRUE)
> # Why not throw a kernel density estimate on there too
> lines(density(dat), col = "red")
>
> library(descr)
Warning message:
package descr was built under R version 2.15.1
> dat <- rnorm(30, mean = 82, sd = 7)
> histkdnc(dat)
> dat <- rnorm(3000, mean = 82, sd = 7)
> histkdnc(dat)
>
x <- rnorm(1000)
hist(x, freq = FALSE, col = "grey")
curve(dnorm, col = 2, add = TRUE)
348
Glossary
Basic arithmetic operators:
Assignment operator
Concatenation function
containing those values.
Simple statistical functions
Help
Session management
Load data from text file
Editing data
Scatterplot
Linear model fitting
Basic inference
( ) brackets in arithmetic calculations

^ raise to the power of
/ division
* multiplication
+ addition
- subtraction
<- assigns the value of the expression on the right
to the identifer on the left.
c(...) argument is a set of values; returns a vector
sum(...)
mean(...)
median(...)
range(...)
sd(...) standard deviation
mad(...) mean absolute deviation
IQR(...) inter-quartile range
min(...) minimum
max(...) maximum
? ... will provide information on function usage and
arguments
help.start() opens html help files
objects() lists objects in workspace
ls() does the same as objects()
rm(...) removes the objects listed from workspace
rm(list = objects()) removes all objects from
workspace
getwd() returns the current working directory
setwd(...) set the working directory
dir() list files in current directory
save.image(...) saves workspace to specified file
quit() ends R session
load(...) loads a saved workspace from file
read.table(...) argument is a file in the working
directory. Return value is a data frame.
fix(...) or data.entry(...) brings up spreadsheet like
environment for editing data.
plot(...) is a versatile plotting command, draws a
scatterplot when two arguments are given.
lm(...) can fit a variety of linear models, argument is
a model formula.
t.test(...) Student's t-test
var.test(...) F test to compare two variances
chisq.test(...) Pearson's
349
test for count data
Object properties
Object contents
Regular sequences :
cor.test(...) test for association

length(...)
mode(...)
typeof(...)
class(...)
attributes(...) returns all non-intrinsic attributes
summary(...) information on an object; output
depends on class
str(...) compact details of object structure
dput(...) text listing of object
sequence generator gives sequence with unit steps

between left and right arguments
seq(...) more general regular sequence generator,
can set step (by) and/or length of sequence (length)
rep(...) for generating sequence with repeated
values
Logical values
TRUE and FALSE
Comparison and logical operators == equality
!= inequality
< less than
> greater than
<= less than or equal to
>= greater than or equal to
! negation
& and (&& scalar version)
| or (|| scalar version)
Accessing elements [...] contents of brackets a vector of integers, a vector of
logical values or a vector of names.
Accessing a list component [[...]] contents of brackets a number or a name.
Accessing a named component $
Referring to list components directly attach(...) brings components of a list into
view; use detach() to tidy up.
Generating a vector of strings paste(...) converts any non-character arguments
into characters and puts them together into a vector of mode character.
Generating lists list(...) put arguments (which may be named) into a list.
A selection of plots
hist(...) histogram
qqnorm(...) normal qq-plot
boxplot(...)
contour(...) 3D contours
image(...) 3D coloured blocks
persp(...) 3D wire frame
Some low level plotting commands points(...)
lines(...)
text(...)
350
Some graphics parameters
pch plotting character

col colour
mfrow multi-figure page specification mfcol
Storing commands
savehistory(...)
loadhistory(...)
source(...)
library(...) list and load packages

data(...) add data from a package to workspace
Search path
search() lists environments in the search path in
the order in which
theywill be searched. Passing the
position in search path
or name of an environments
to objects(...) lists objects
in that environment.
Arrays
matrix(...) to generate a matrix (2D array)
array(...) to generate a general array.
Packages
351
352

433 ) (
1424/1423
3
:
: EXCEL :
( ) f ( x ) = e sin ( x
x
x = 0 . h = 0.01
( ) f ( x ) = n ( x . x0 = 1
( :
sin ( x ) dx
.2
( :
dx
+ tx = t , x ( 0 ) = 0
dt
]. [ 0,1
: EXCEL SOLVER :
1 Minimize 8 x1 + 10 x2 + 7 x3 + 6 x4 + 11x5 + 9 x6
Subject to
12 x1 + 9 x2 + 25 x3 + 20 x4 + 17 x5 + 13 x6 60
35 x1 + 42 x2 + 18 x3 + 31x4 + 56 x5 + 49 x6 150
37 x1 + 53x2 + 28 x3 + 24 x4 + 29 x5 + 20 x6 125
0 x1 , x2 1
: LINGO :
.
4 . Pawn
Knight Bishop .King Peanuts .Cashews

:
Pawn Knight Bishop King
)Peanuts (oz.
15
10
6
2
)Cashews (oz.
1
6
10
14
)Selling Price ($
2
3
4
5
353
750 250 .

.
354
:
:

)f ( x + h) f ( x h
) + O ( h2
2h
= )f ( x
)f ( x + h) 2 f ( x ) + f ( x h
= ) f ( x
) + O ( h2
2
h
:
) f ( x ) ( n
) pn 1 ( x:
k
) ( x x0
) ( x0
)k
!k
(f
n 1
= ) pn 1 ( x
k =0
. :
j
)( j
) ( x x0
p j ( x ) = p j 1 ( x ) +
!j
:
Eulers Formula
) k1 = f ( x j , y j
h
h
k2 = f x j + , y j + k1
2
2
y j +1 = y j + h k2
:
) ( :
b
I = f ( x ) dx
a
) f (x
i
i =1
xi . N
) (.
355
) (b a
N
1424/1423
433 ) (
2 : :
:
:
( .
( .
( Solver
356
( Solver
( .WinQSB .
:
A B C
1 2 . 3
:
:1

1600
A
1600
B
1600
C
:2
357
2000
1
1400
2
1500
3
:3
3
2
1
250
225
175
A
100
100
150
B
200
275
300
C
Solver WinQSB
.
358
1424/1423
433 ) (
2 : :
:
:
( .
( .
( Solver
359
( Solver
( .WinQSB .
:
Solver WinQSB :
360

1424/1423
433 ) (
:
(
Min 2 x1 + 0.2 x2 + 0.25 x3
3.2 x1 + 4.9 x2 + 0.8 x3 13
1.12 x1 + 1.3x2 + 0.19 x3 1.5
+ 93 x3 45
32 x1
x1 , x2 , x3 0
(
) 3( .
(
361
St
362
363
364
365
366
367
:
(
Max 33 x1 + 500 x2
60
x1
x2 50
x1 + 2 x2 120
x1 , x2 0, and integers
(
.
(
368
St
369
370
371
372
373
374
:
1- Lawrence, John A., Jr, and Pasternack, Barry A. (2002) Applied
Management Science: Modeling, Spreadsheet Analysis, and Communication
for Decision Making. Second Edition. Wiley.
2- Lawrence, John A., Jr, and Pasternack, Barry A. (1998) Applied
Management Science: A Computer-Integrated Approach for Decision
Making. Wiley.
3- Microsoft EXCEL Online Help.
4- WINQSB Online Help and Manual.
5- LINDO Online Help.
6- LINGO Online Help.
7- The R Manuals at http://cran.r-project.org/
375

Calculation Methods Book With R

Uploaded by

Copyright:

Available Formats

Calculation Methods Book With R

Uploaded by

Document Information

Original Description:

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Calculation Methods Book With R

Uploaded by

Copyright:

Available Formats

EXCEL SOLVER, LINGO, AND THE

Curve Fitting and Parameters

The Solution of Ordinary Differential :

Initial Value Problem

: Monte Carlo Integration

Assume Linear Model Assume Non-Negative OK

Minimize 0.6 X 1 + 0.5 X 2

Use Automatic Scaling

for all i and j

x1,2 + x1,3 + x1,4 = 1

Microsoft Excel 11.0 Answer Report

Target Cell (Min)

Microsoft Excel 11.0 Answer Report

Target Cell (Max)

: The Objective Function

4 x ( 2,1) + 9 x ( 2, 2 ) + 5 x ( 2,3) + 3x ( 2, 4 ) + 8 x ( 2, 5 ) + 5 x ( 2, 6 ) + 8 x ( 2, 7 ) + 2 x ( 2,8 ) +

x (1,3) + x ( 2,3) + x ( 3,3) + x ( 4,3) + x ( 5,3) + x ( 6,3) = 22

x (1,5 ) + x ( 2,5 ) + x ( 3,5 ) + x ( 4,5 ) + x ( 5,5 ) + x ( 6,5 ) = 41

x (1,8 ) + x ( 2,8 ) + x ( 3,8 ) + x ( 4,8 ) + x ( 5,8 ) + x ( 6,8 ) = 38

WAREHOUSES VOLUME VENDORS

)COST(WH6,V1), COST(WH6,V2 ), COST(WH6,V3),,COST(WH6,V8

Minimize 0.6 X 1 + 0.5 X 2

Max. 12000 X 1 + 20000 X 2

for all i and j

C1 C2 C3 C4 C5 C6 C7 C8 C9 C10 C11 C12 SPL

for all i and j

Model Title: Linear Regression with one independent variable

Extended solver steps:

0.1 0.05 0.1

0.2 0.1 0.3

0.2 0.3 0.3

@FOR( STATE( J)| J #LT# @SIZE( STATE):

Insert Name Define

Global optimal solution found.

Export Summary Report

) Microsoft Access Driver(*.mdb Finish

Export Summary Report

model <- nls( wage ~ A + B * exper + C * exper^2,

y3 <- fderiv(f, xs, n = 3, method = "backward")

antiD(formula, ..., lower.bound = 0,force.numeric = FALSE)

= makeAntiDfun(.function, .wrt, from,.tol

f <- D(A*x^3 ~ x + x, A=1) # 2nd order partial -- note,

# note: it's a function of t

# note: it's a function

model <- lm(wage ~ poly(exper,degree=2), data=CPS85)

Max. 12000 X1 + 20000 X 2

Results of Linear Programming / Linear Optimization

Objective function (Maximum):

> assign.costs <- matrix (c(2, 7, 7, 2, 7, 7, 3, 2, 7, 2,

> costs[5,1] <- costs[7,3] <- 8

:Shortest Path Problem

2> E <- rbind( c(1,2,599), c(1,3,180), c(1,4,497), c(2,5,691),

:Maximal Flow Problem

)> gm <- graph.maxflow(g2, 1, 7

Travelling Salesman Problem

432 1043 1270

782 1064 1304

725 1035 1667 1345

0 * 0.001 0.01 * 0.05 . 0.1 1

0 * 0.001 0.01 * 0.05 . 0.1 1

0 * 0.001 0.01 * 0.05 . 0.1