Zia Ranks - 1 year ago 72
R Question

# Retrieve the position (column name) of the maximum value of the derivative of an interval

To calculate the Red Edge Position Index, I need to find the wavelength value (column name) corresponding to the maximum derivative of reflectance in the red edge region from 690nm to 740nm. I have included a subset of my dataframe below, it contains the correct interval...

I have 640 rows (Sample) of 2151 measurements (values) plus a few catagoricals in the first columns (e.g. plantType and plantCondition). I need to find the column of the value corresponding to the maximum of the derivative of the values in the interval specified and return the wavelength value to the REPI column.

I am trying something like this but I do not know how to calculate the maximum of the derivative in the specified interval

# find the maximum of the derivative of the values in columns x690:x740
# attempt to find for single sample first
> which( colnames(spec.data)=="X690")
[1] 352
> which( colnames(spec.data)=="X740")
[1] 402
# I want to return the values of the differential but this doesn't work
> foo.vector <- diff(spec.data[1,352:402])
>> Error in r[i1] - r[-length(r):-(length(r) - lag + 1L)] : non-numeric argument to binary operator

This makes sense because I don't have the dt in dx/dt but I am not sure how to retrieve the position of the maximum value of the derivative of this interval. once I did I think I would

> spec.data\$REPI <- which( colnames(spec.data) == max(foo.vector))

Then I think I would lapply this for each row?

Can anyone point me towards a solution for this?
Thank you...

subset of data from dput

> dput(spec.data[1:2, c(1:3, 7, 300:450)])
structure(list(Sample = c("JUMO_G1 P1T9 Leaf Clip00000.asd",
"JUMO_G1 P1T9 Leaf Clip00001.asd"), plantType = c("JUMO", "JUMO"
), plantCondition = c("G", "G"), REPI = c(NA_real_, NA_real_),
X638 = c(0.0611, 0.06114), X639 = c(0.0606, 0.06064), X640 = c(0.0601,
0.06012), X641 = c(0.0595, 0.05953), X642 = c(0.0589, 0.05893
), X643 = c(0.0584, 0.05834), X644 = c(0.0577, 0.05775),
X645 = c(0.05717, 0.05717), X646 = c(0.0566, 0.05664), X647 = c(0.0562,
0.05618), X648 = c(0.0557, 0.05573), X649 = c(0.0554, 0.05536
), X650 = c(0.0551, 0.05505), X651 = c(0.0547, 0.05475),
X652 = c(0.05448, 0.05447), X653 = c(0.0542, 0.05421), X654 = c(0.054,
0.05395), X655 = c(0.0536, 0.05357), X656 = c(0.0532, 0.05319
), X657 = c(0.0528, 0.05277), X658 = c(0.0523, 0.05229),
X659 = c(0.0518, 0.05176), X660 = c(0.05128, 0.05126), X661 = c(0.0508,
0.05077), X662 = c(0.0503, 0.05024), X663 = c(0.0498, 0.04978
), X664 = c(0.0494, 0.04936), X665 = c(0.049, 0.04897), X666 = c(0.04869,
0.04866), X667 = c(0.0484, 0.04838), X668 = c(0.0482, 0.04815
), X669 = c(0.048, 0.04797), X670 = c(0.0479, 0.04782), X671 = c(0.0478,
0.04775), X672 = c(0.0478, 0.04773), X673 = c(0.0478, 0.04773
), X674 = c(0.0478, 0.04776), X675 = c(0.0479, 0.04786),
X676 = c(0.0481, 0.04802), X677 = c(0.0483, 0.0482), X678 = c(0.0486,
0.04843), X679 = c(0.0489, 0.04873), X680 = c(0.04925, 0.04911
), X681 = c(0.0498, 0.04962), X682 = c(0.0504, 0.05026),
X683 = c(0.05122, 0.05103), X684 = c(0.0522, 0.052), X685 = c(0.0533,
0.05317), X686 = c(0.0548, 0.05458), X687 = c(0.05647, 0.05627
), X688 = c(0.0584, 0.05824), X689 = c(0.0608, 0.06057),
X690 = c(0.0634, 0.06326), X691 = c(0.0664, 0.06626), X692 = c(0.0698,
0.06958), X693 = c(0.0734, 0.07317), X694 = c(0.0773, 0.07701
), X695 = c(0.0814, 0.08109), X696 = c(0.0856, 0.0854), X697 = c(0.0901,
0.08989), X698 = c(0.0947, 0.09449), X699 = c(0.0994, 0.09917
), X700 = c(0.10417, 0.10395), X701 = c(0.10899, 0.10881),
X702 = c(0.11385, 0.11366), X703 = c(0.11871, 0.11854), X704 = c(0.12356,
0.12342), X705 = c(0.1284, 0.12829), X706 = c(0.13324, 0.13312
), X707 = c(0.13803, 0.13792), X708 = c(0.14281, 0.14273),
X709 = c(0.14763, 0.14755), X710 = c(0.15243, 0.15235), X711 = c(0.15718,
0.15713), X712 = c(0.16192, 0.16189), X713 = c(0.1667, 0.16663
), X714 = c(0.17143, 0.17137), X715 = c(0.17609, 0.17605),
X716 = c(0.18069, 0.18062), X717 = c(0.18528, 0.1852), X718 = c(0.18977,
0.18968), X719 = c(0.19417, 0.19406), X720 = c(0.19851, 0.19838
), X721 = c(0.20276, 0.20263), X722 = c(0.20686, 0.20671),
X723 = c(0.2108, 0.21063), X724 = c(0.21465, 0.21449), X725 = c(0.21837,
0.21819), X726 = c(0.22194, 0.22174), X727 = c(0.22534, 0.22515
), X728 = c(0.2286, 0.22838), X729 = c(0.23164, 0.23142),
X730 = c(0.23447, 0.23427), X731 = c(0.23719, 0.23696), X732 = c(0.23984,
0.23959), X733 = c(0.24229, 0.24203), X734 = c(0.24452, 0.24426
), X735 = c(0.24668, 0.24638), X736 = c(0.24867, 0.24839),
X737 = c(0.25053, 0.25028), X738 = c(0.25229, 0.25203), X739 = c(0.25382,
0.25359), X740 = c(0.25531, 0.25508), X741 = c(0.25672, 0.25646
), X742 = c(0.25791, 0.25766), X743 = c(0.25907, 0.25884),
X744 = c(0.26014, 0.25993), X745 = c(0.2611, 0.26089), X746 = c(0.26201,
0.26178), X747 = c(0.26278, 0.26257), X748 = c(0.26347, 0.26329
), X749 = c(0.26414, 0.26397), X750 = c(0.26475, 0.26459),
X751 = c(0.26525, 0.2651), X752 = c(0.26568, 0.26554), X753 = c(0.26614,
0.266), X754 = c(0.26652, 0.26639), X755 = c(0.26682, 0.26671
), X756 = c(0.2671, 0.26701), X757 = c(0.26743, 0.26734),
X758 = c(0.26767, 0.26758), X759 = c(0.26789, 0.26781), X760 = c(0.26814,
0.26808), X761 = c(0.2682, 0.26817), X762 = c(0.26835, 0.26831
), X763 = c(0.26856, 0.26851), X764 = c(0.26872, 0.26869),
X765 = c(0.26884, 0.26881), X766 = c(0.26892, 0.2689), X767 = c(0.26896,
0.26894), X768 = c(0.26898, 0.26896), X769 = c(0.2691, 0.26909
), X770 = c(0.2692, 0.2692), X771 = c(0.26921, 0.26921),
X772 = c(0.26923, 0.26926), X773 = c(0.26927, 0.26931), X774 = c(0.26935,
0.26939), X775 = c(0.26945, 0.26947), X776 = c(0.26946, 0.26949
), X777 = c(0.26948, 0.26952), X778 = c(0.26953, 0.26958),
X779 = c(0.26958, 0.26963), X780 = c(0.26965, 0.2697), X781 = c(0.2697,
0.26975), X782 = c(0.2697, 0.26977), X783 = c(0.26972, 0.26978
), X784 = c(0.26979, 0.26982), X785 = c(0.26987, 0.2699),
X786 = c(0.26991, 0.26998), X787 = c(0.26989, 0.26997), X788 = c(0.26991,
0.26998)), .Names = c("Sample", "plantType", "plantCondition",
"REPI", "X638", "X639", "X640", "X641", "X642", "X643", "X644",
"X645", "X646", "X647", "X648", "X649", "X650", "X651", "X652",
"X653", "X654", "X655", "X656", "X657", "X658", "X659", "X660",
"X661", "X662", "X663", "X664", "X665", "X666", "X667", "X668",
"X669", "X670", "X671", "X672", "X673", "X674", "X675", "X676",
"X677", "X678", "X679", "X680", "X681", "X682", "X683", "X684",
"X685", "X686", "X687", "X688", "X689", "X690", "X691", "X692",
"X693", "X694", "X695", "X696", "X697", "X698", "X699", "X700",
"X701", "X702", "X703", "X704", "X705", "X706", "X707", "X708",
"X709", "X710", "X711", "X712", "X713", "X714", "X715", "X716",
"X717", "X718", "X719", "X720", "X721", "X722", "X723", "X724",
"X725", "X726", "X727", "X728", "X729", "X730", "X731", "X732",
"X733", "X734", "X735", "X736", "X737", "X738", "X739", "X740",
"X741", "X742", "X743", "X744", "X745", "X746", "X747", "X748",
"X749", "X750", "X751", "X752", "X753", "X754", "X755", "X756",
"X757", "X758", "X759", "X760", "X761", "X762", "X763", "X764",
"X765", "X766", "X767", "X768", "X769", "X770", "X771", "X772",
"X773", "X774", "X775", "X776", "X777", "X778", "X779", "X780",
"X781", "X782", "X783", "X784", "X785", "X786", "X787", "X788"
), row.names = 1:2, class = "data.frame")

You can try this

spec.data\$REPI <- apply(spec.data[,-(1:4)], 1, function(x) which.max(diff(x)))

Or you can try using dplyr and tidyr:

library(dplyr)
library(tidyr)
spec.data %>%
gather(key, value, -Sample, -plantType, - plantCondition, -REPI) %>%
group_by(Sample) %>%
summarise(which.max(diff(value)))

They both seem to give same results.

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download