-
Notifications
You must be signed in to change notification settings - Fork 13
/
09-Tech_Comm_Apps.Rmd
366 lines (288 loc) · 14.9 KB
/
09-Tech_Comm_Apps.Rmd
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
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
---
editor_options:
markdown:
wrap: sentence
---
```{r, include=FALSE, eval=FALSE}
library(bookdown); library(rmarkdown); rmarkdown::render("09-Tech_Comm_Apps.Rmd", "pdf_book")
```
```{r setup, include=FALSE, warning=FALSE, message=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(DiagrammeRsvg)
library(rsvg)
library(htmltools)
library(kableExtra)
```
# Revisiting *Technology Commercialization*
## Introduction
In 2002, Sten Thore edited a book, *Technology Commercialization: DEA and Related Analytical Methods for Evaluating the Use and Implementation of Technological Innovation* This book compiled a series of cases applying Data Envelopment Analysis to real-world technology management situations.
This chapter revisits some of those cases.
We will provide a snapshot of the cases and the interested reader is referred to Thore's book for more details.
Before we begin, let's install some small helper functions.
These are described in more detail in an Appendix.
```{r loadhelperfiles , include=FALSE, eval=FALSE}
# Defunct code. Replaced with simply loading TRA package later.
source('Helperfiles.R')
#knitr::read_chunk('Helperfiles.R')
#<<poscolfunct>>
# This reads in a chunk that defines the poscol function
# This function will filter out columns that are zero
# More precisely, it factors out column with
# column sums that are zero. This is helpful
# for tables of lambda values in DEA.
source('Helperfiles.R')
#knitr::read_chunk('Helperfiles.R')
#<<DrawIOdiagramfunction>>
```
## Prioritizing R&D Activities
### Directional Drilling R&D Projects
Chapter 2 of Thore, by Thore and Rich, covers a series of small cases around R&D projects.
The first case begins on page 62 with an application from Baker Hughes Corporation.
They were considering 14 cases related to "directional drilling", which as a technology, combined with hydraulic fracturing, that years later resulted in the natural gas boom.
Thore and Rich use a one-input, four-output variable returns to scale DEA model.
The input was expected cost in millions of dollars.
The outputs are estimated market size in millions of dollars (Y1), strategic compatibility with existing products (Y2), projected market demand in millions of dollars (Y3), and competitive intensity (Y4).
Let's start by defining the data from page 63 of Thore and Rich.
```{r BHCorp, warning=FALSE, message=FALSE}
# library(devtools);devtools::install_github("prof-anderson/TRA")
# Install TRA package from github if not already installed.
library (TRA)
NX <- 1; NY <- 4; ND <- 14
BHNames <- TRA::DEAnames(NX=NX, NY=NY, ND=ND)
BHProjnames <- lapply(list(rep("P",NX)),paste0,1:ND)
# DMU names: P1, P2, ..., P14
XBH <- matrix(c(
1.07, 1.06, 0.325, 1.60,
0.55, 0.2, 0.35, 0.53,
0.21, 0.16, 0.07,
1.95, 5.59, 3.10),
ncol=NX,
dimnames=c(BHProjnames,list(BHNames$XnamesLX)))
YBH <- matrix(c(
32, 50, 40, 30 , 25, 8, 2, 12, 10, 0.8, 3, 300, 60, 240,
8.2, 7.6, 7.6, 7.1, 7.0, 6.0, 5.9, 5.8, 5.8, 5.4, 5.3, 6.8, 6.2, 6.5,
7.5, 7.2, 7.1, 7.2, 7.0, 6.1, 6.2, 5.8, 5.8, 5.6, 5.4, 6.1, 6.9, 6.6,
8.0, 6.4, 5.3, 5.5, 5.1, 6.9, 6.6, 5.4, 4.7, 6.1, 6.5, 6.4, 6.8, 7.1),
ncol=NY, byrow=FALSE,
dimnames=c(BHProjnames,
list(BHNames$YnamesLX)))
XFigNames <- "X1 - Expected Cost ($M)"
YFigNames <- c("Y1 - Market Size ($M)",
"Y2 - Strategic Compatability (1-10)",
"Y3 - Market Demand ($M)",
"Y4 - Competitive Intensity (1-10)" )
Figure<-DrawIOdiagram(XFigNames,YFigNames, '"\n\nBCC-IO\n\n "')
tmp<-capture.output(rsvg_png(charToRaw(export_svg(Figure)),
'IO-BakerHughes.png', height = 1440))
```
{#fig:IO-BakerHughes width="70%"}
```{r}
kbl (cbind(XBH,YBH),
caption="Data for Baker Hughes Corporation case.",
booktabs = T, escape=F) |>
kable_styling(latex_options = c("HOLD_position"))
```
Now, let's run DEA. Feel free to pick a package. We explored some packages in chapter 8. For now, let's try the `MultiplierDEA` package. Let's look over the results.
```{r results='asis', include=FALSE}
library(MultiplierDEA)
resBH<-DeaMultiplierModel(XBH, YBH,
rts = "vrs", orientation="input")
# Rename some of the results row and column labels
dimnames(resBH$Efficiency)<-c(BHProjnames,"$\\theta^{VRS}$")
dimnames(resBH$Lambda)<-c(list(BHNames$LambdanamesbynumberLX),
list(BHNames$LambdanamesbynumberLX))
dimnames(resBH$vx)<-c(BHProjnames,list(BHNames$VnamesLX))
dimnames(resBH$uy)<-c(BHProjnames,list(BHNames$UnamesLX))
kbl (poscol(cbind(resBH$Efficiency, resBH$Lambda), cutoff=0.000001),
caption = "Envelopment results for Baker Hughes Corporation analysis.",
booktabs = T, digits = 4, escape=F)|>
kable_styling(latex_options = c("HOLD_position"))
```
The results are consistent with those reported in Sten and Thore.
Note that projects (DMUs) A, C, and F are efficient and all other projects use those three projects in setting their own targets of performance as denoted by non-zero values of lambda.
Now, let's look at the other side of the analysis - the multiplier model.
```{r}
kbl (cbind(resBH$Efficiency,resBH$vx,resBH$uy),
caption="Weights for Baker Hughes Corporation analysis.",
booktabs = T, digits = 4, escape=F)|>
kable_styling(latex_options = c("HOLD_position"))
```
The envelopment and multiplier results are intricately related by \index{Dual values} duality.
In this case, we can see that certain outputs are "ignored" by certain projects by placing a zero weight on that output.
This is perfectly permissible in a DEA study when we don't know the relative value outputs and is why we refer to DEA scores as technical efficiency or relative efficiency.
On the other hand, if we had more information on relative values of outputs that could or should be incorporated, this can be done.
The impact is that it would generally decrease the scores of some (but not necessarily all) projects (DMUs) whose original results violate these restrictions.
The efficiency scores match those reported by Thore and Rich but they didn't examine the output weights.
A lot of discussion could be had about relative weights.
We will leave that to the interested reader to pontificate upon.
## NASA Aeronautical Projects
The next case in the book was comparing NASA aeronautics projects.
```{r}
XFigNames <- "X1 Cost ($M)"
YFigNames <- c("Y1 - Expected Income ($M)",
"Y2 - Priority (1-10)",
"Y3 - Expected Jobs ($M)")
Figure<-DrawIOdiagram(XFigNames,YFigNames, '"\n\nBCC-IO\n\n "')
tmp<-capture.output(rsvg_png(charToRaw(export_svg(Figure)),
'IO-NASA.png', height = 1440))
```
{#fig:IO-NASA width="70%"}
```{r, echo=FALSE}
NASAprojnames<-list(c("A1", "A2", "A3", "A4", "A5", "A6",
"B1", "B2", "B3", "B4", "C1", "C2", "C3",
"D1", "E1", "E2", "E3", "E4"))
NASANames <- TRA::DEAnames(NX=1, NY=3, ND=18)
XNASA <- matrix(c(15.5, 23.0, 39.5, 80.0, 14.5, 13.5,
30.0, 220.0, 180.0, 980.0, 1050.0, 15.0, 40.0,
5.5, 110.0, 350.0, 350.0, 110.0),
ncol=1, byrow = FALSE,
dimnames=c(NASAprojnames, list(NASANames$XnamesLX)))
YNASA <- matrix(c(
1.8, 2.7, 2.7, 9.0, 1.35, 2.25, 9.6, 16.0, 6.8, 25.2, 20.7, 4.5, 19.8, 0.75,
0, 0, 0, 0, 7.0, 7.0, 7.0, 7.0, 7.0, 7.0, 8.0, 10.0, 10.0, 9.0, 6.0, 6.0, 6.0, 10.0,
8.0, 8.0, 8.0, 8.0,18.0, 45.0, 7.2, 108.0, 6.3, 40.5, 240.0, 160, 64.0, 560.0,
1170.0, 18.0, 544.5, 1.0, 0, 0, 0, 0),
ncol=3, byrow = FALSE,
dimnames=c(NASAprojnames, list(NASANames$YnamesLX)))
```
Now that we have entered the data, let's run an input-oriented, variable returns-to-scale (BCC-IO) analysis.
```{r}
resNASA<-DeaMultiplierModel(XNASA, YNASA,
rts = "vrs", orientation="input")
kbl (cbind(XNASA,YNASA,resNASA$Efficiency),
booktabs = T, digits = 4, escape=F) |>
kable_styling(latex_options = c("HOLD_position"))
```
Again, the results match those of Thore and Rich.
Their discussion of results emphasized the comparison of projects to each other by looking at the lambda values to see how the targets of comparison were made.
```{r}
resNASA<-DeaMultiplierModel(XNASA,YNASA,
rts = "vrs", orientation="input")
kbl (poscol(cbind(resNASA$Efficiency,resNASA$Lambda), cutoff=0.00001),
booktabs = T, digits = 4, align = 'c',
caption="Envelopment Model Results for NASA projects.") |>
kable_styling(latex_options = c("HOLD_position"))
```
## University Technology Transfer
Let's examine the case of technology transfer success from university research by revisiting [@AndersonMeasuringefficiencyuniversity2007]. This paper used data from the Association of University Technology Managers, AUTM, and their 2004 survey. This dataset is available from the `TRA` package.
```{r DEA_IO_Plot_Univ, out.width="70%"}
#Define printable names to be used as appropriate
ynames_printable<-c("Licensing Income\n($M)",
"Licenses and \n Options Executed",
"Startup Companies",
"US Patents Filed",
"US Patents Issued")
xnames_printable<-c("Total Research\n Spending ($M)")
Figure <- DrawIOdiagram (xnames_printable,
ynames_printable,
'"\n\nUniversity\nTechnology\nTransfer\n\n\n"')
tmp<-capture.output(rsvg_png(
charToRaw(export_svg(Figure)),
'images/DEA_Univ_IO.PNG'))
knitr::include_graphics(
"images/DEA_Univ_IO.PNG")
```
```{r, message=FALSE}
head(TRA::univ_lic_2007)
#ynames_printable<-c("$Licensing \\n Income\n(\\$M)$",
# "$Licenses \\; and \\n Options \\; Executed$",
# "$Startup \\nCompanies$",
# "$US Patents \\nFiled$",
# "$US Patents \\nIssued$")
#xnames_printable<-c("$Total \\; Research\\n Spending (\\$M)$")
#univ_lic_2007 <- read_csv("univ_lic_2007.csv", show_col_types=FALSE)
kbl (TRA::univ_lic_2007,
booktabs = T, digits = 3, align = 'c', escape=T,
col.names = c("University", ynames_printable, xnames_printable),
caption="University Technology Transfer Data") |>
kable_styling(latex_options = c("HOLD_position", "scale_down"))
```
Now let's prepare the data for the analysis.
```{r results='asis'}
xdata <- as.matrix(univ_lic_2007 [,7])
rownames(xdata)<-as.matrix(univ_lic_2007[,1])
ydata <- as.matrix(univ_lic_2007 [,2:6])
rownames(ydata)<-as.matrix(univ_lic_2007[,1])
Xnames <- colnames(xdata)
Ynames <- colnames(ydata)
DMUnames <-list(as.matrix(univ_lic_2007[,1]))
dimnames(xdata) <- c(DMUnames,Xnames)
colnames(ydata) <- Ynames
ND <- nrow(xdata) # Number of DMUs (universities)
NX <- ncol(xdata) # Number of inputs (just 1 in this case)
NY <- ncol(ydata) # Number of outputs
res.efficiency <- matrix(rep(-1.0, ND), nrow=ND, ncol=1)
res.lambda <- matrix(rep(-1.0, ND^2), nrow=ND,ncol=ND)
dimnames(res.efficiency) <- c(DMUnames,"CCR-IO")
dimnames(res.lambda) <- c(DMUnames,DMUnames)
```
As usual in DEA study, decisions need to be made about orientation and returns to scale. Let's run both input-orientation and output-orientations for both CRS and VRS. In addition, two of the outputs are strongly related - patents applied for and patents issued. Applying for a patent merely implies the idea has sufficient value worth investing the time and effort to file paperwork. An issued patent is certainly more valuable. Therefore, we will incorporate a weight restricted model that imposes a weight restriction that an issued patent is worth at least five times that of an applied for patent.
We will again use the `MultiplierDEA` package. Let's use a series of models:
- Input-oriented, constant returns to scale model
- Output-oriented, constant returns to scale model
- Input-oriented, variable returns to scale model
- Output-oriented, variable returns to scale model
- Weight restricted Input-oriented, variable returns to scale model
- Weight restricted Output-oriented, variable returns to scale model
$$
\begin{split}
\begin{aligned}
\ & u_{\text{Patents Issued}} \geq 5 \cdot u_{\text{Patents Applied for}}\\
\ & 5 \leq \frac{u_{\text{Patents Issued}}} {u_{\text{Patents Applied for}}} \leq \infty \\
\end{aligned}
\end{split}
(\#eq:Ch9PatentWeightRestrictions)
$$
```{r univ-dea, warning=FALSE, messages=FALSE}
library(MultiplierDEA)
PatentWR<-data.frame(lower = c(5.0),
numerator = c("US Patents Issued"),
denominator = c("US Patents Filed"),
upper = c(NaN))
univiocrs<-DeaMultiplierModel (xdata, ydata,
rts="CRS", orientation="input")
univoocrs<-DeaMultiplierModel (xdata, ydata,
rts="CRS", orientation="output")
univiovrs<-DeaMultiplierModel (xdata, ydata,
rts="VRS", orientation="input")
univoovrs<-DeaMultiplierModel (xdata,ydata,
rts="VRS", orientation="output")
univiovrswr<-DeaMultiplierModel (xdata, ydata,
rts="VRS", orientation="input",
PatentWR)
univoovrswr<-DeaMultiplierModel (xdata, ydata,
rts="VRS", orientation="output",
PatentWR)
```
```{r collect-univ-result}
univcoll <- cbind(univiocrs$Efficiency, univoocrs$Efficiency,
univiovrs$Efficiency, univoovrs$Efficiency,
univiovrswr$Efficiency, univiovrswr$Efficiency)
colnames (univcoll) <- c("$\\theta^{IO,CRS}$", "$\\theta^{OO,CRS}$",
"$\\theta^{IO,VRS}$", "$\\theta^{OO,VRS}$",
"$\\theta^{IO,VRS,WR}$", "$\\theta^{OO,VRS,WR}$")
kbl (univcoll,
booktabs = T, digits = 4, align = 'c', escape=F,
caption="University Technology Collected Results") |>
kable_styling(latex_options = c("HOLD_position", "scale_down"))
```
```{r}
corrtemp <- rbind( cor(univcoll, method="pearson"),
cor(univcoll, method="spearman"))
```
```{r, echo=FALSE}
kbl(corrtemp, booktabs=T, escape=F,
caption="Correlations between Various Models of University Technology Transfer") |>
pack_rows ("Pearson Correlation", 1, 6) |>
pack_rows ("Spearman Rank Correlation", 7, 12) |>
kable_styling(latex_options = c("HOLD_position", "scale_down"))
```
## Possible to-Do Items for this Chapter
- More data sets and cases=
- Perhaps fix naming of outputs in first case to be P1, P2,... rather than A, B, C,... to match Thore
- Perhaps generalize naming of projects for NASA case to match Thore
- Create helper function for names to pass numbers of DMUs, inputs, outputs, and output naming objects
- Define \# of digits for tables
## To-Do Items for Packages (some for later)
- Add data sets to package(s)
- Naming of results to reflect lambdas, etc.