Shaxi Liver
Reputation: 1120
Dividing values in the row by the closest maximum
I am trying to divide all of the values in the row by the closest maximum (if there is no 0 between the maximum and the value). What does exactly it mean I will show you on an example:
The original data:
Name 1st 2nd 3rd 4th 5th 6th 7th
Gregg 0 30 50 10 0 30 60
Mike 20 50 30 0 0 2 0
Susane 30 0 10 0 100 30 0
Marcel 0 40 30 10 0 2 0
The script I write so far is able to find a local maximas in such data. It ignores the maximas if the value is not atleast 20% of the highest maximum in the row.
That's an output:
Name 1st 2nd 3rd 4th 5th 6th 7th
Gregg 0 0 1 0 0 0 1
Mike 0 1 0 0 0 0 0
Susane 1 0 0 0 1 0 0
Marcel 0 1 0 0 0 0 0
And now I will show you what exactly I want to achieve:
Name 1st 2nd 3rd 4th 5th 6th 7th
Gregg 0 0.6 1 0.2 0 0.5 1 ## There are 2 local maximas (3rd & 7th), so firstly I divided a value in the 2nd by the local maximum in 3rd, than I divided 4th value by the maximum in 3th. In next (5th) is 0 so I value in 6th belongs to the next local maximum in position 7th.
Mike 0.4 1 0.6 0 0 0 0 ## Local maximum in 2nd position. Values in 1st and 3rd position divided by the maximum in 2nd.
Susane 1 0 0 0 1 0.3 0 ## Local maximum in 1st, no other values close to this maximum. Another maximum in 5th so 6th divided by the maximum
Marcel 0 1 0.75 0.25 0 0 0 ## and so on...
I forgot to put my data and the script I use. Sorry I was in hurry.
My data:
> dput(head(tbl_all2))
structure(list(`Gene name` = structure(1:6, .Label = c("a2p1u8",
"a2qab2", "a6zl23", "a6zlf3", "a6zq61", "a6ztx1", "a6zw47", "a6zya9",
"a7a095", "a7a0l4", "b2g4d8", "b2g4i6", "b2g4p9", "b2g4u5", "b2zbw7",
"b3lgx6", "b3lh69", "b3lha4", "b3ljq6", "b3llk0", "b3lp17", "b3ltm6",
"b5vdr5", "b5ve00", "b5ve47", "b5ve66", "b5ve75", "b5vea8", "b5ved3",
"b5vej5", "b5vfh0", "b5vfm0", "b5vfq6", "b5vg00", "b5vgm8", "b5vgw4",
"b5vh77", "b5vi95", "b5vif4", "b5vik7", "b5vik8", "b5viu6", "b5vj32",
"b5vjc2", "b5vji2", "b5vk65", "b5vkc9", "b5vkd1", "b5vkr2", "b5vkr3",
"b5vl55", "b5vl71", "b5vla9", "b5vlc1", "b5vln1", "b5vlr4", "b5vm13",
"b5vm96", "b5vmw7", "b5vn73", "b5vnb6", "b5vnc3", "b5vnj1", "b5vnk1",
"b5vp33", "b5vp56", "b5vpx6", "b5vq26", "b5vq44", "b5vq52", "b5vqk3",
"b5vrj3", "b5vrz5", "b5vs89", "b5vsy8", "c7gni0", "c7gq32", "c7gqn5",
"c7gtn6", "c7gu46", "c7gwe7", "c7gxt0", "c8z669", "c8z6f5", "c8z6r4",
"c8z6v4", "c8zbm1", "c8zcu8", "c8zd16", "c8zhg0", "e7k9a7", "e7k9i7",
"e7ka19", "e7ka28", "e7kag3", "e7kak7", "e7kau5", "e7kb37", "e7kbg6",
"e7kbp6", "e7kde5", "e7kdf5", "e7kdl8", "e7kec6", "e7kek6", "e7ker2",
"e7kez8", "e7kfj1", "e7kg86", "e7kgg6", "e7kgj9", "e7kgm9", "e7kh79",
"e7khz2", "e7kid1", "e7kid2", "e7kij3", "e7kip9", "e7kiv1", "e7kj59",
"e7kjc9", "e7kjz8", "e7kkg8", "e7kks4", "e7kkx7", "e7klq2", "e7km62",
"e7kmw1", "e7kni6", "e7knq6", "e7knx6", "e7kp09", "e7kps9", "e7kql6",
"e7kqt5", "e7kr71", "e7krc8", "e7krj9", "e7krs0", "e7ks72", "e7ksf4",
"e7ksg0", "e7ksv0", "e7ku26", "e7kui4", "e7kuz1", "e7kv21", "e7kvp5",
"e7lr73", "e7lrn1", "e7ls46", "e7ls63", "e7lsa7", "e7lsk8", "e7lsm3",
"e7lsy6", "e7lte7", "e7ltk1", "e7ltv7", "e7lu34", "e7lun6", "e7lup5",
"e7lux5", "e7lv27", "e7lw21", "e7lw44", "e7lwa5", "e7lwl6", "e7lwm3",
"e7lx88", "e7lxj7", "e7lxn8", "e7lxp5", "e7ly02", "e7lyz3", "e7lz85",
"e7lzh7", "e7lzn6", "e7m129", "e7ney3", "e7nf47", "e7nfe5", "e7nfq5",
"e7nfz0", "e7ng34", "e7nh47", "e7nh77", "e7nhb2", "e7nhq7", "e7nie7",
"e7nii6", "e7nir5", "e7nje2", "e7njk4", "e7njv1", "e7nk19", "e7nk28",
"e7nkm6", "e7nl37", "e7nl74", "e7nlc7", "e7nlm1", "e7nlr2", "e7nlt8",
"e7nm31", "e7nm99", "e7nmz4", "e7nn89", "e7npc6", "e7q121", "e7q1a1",
"e7q1e1", "e7q1k7", "e7q1t1", "e7q1x8", "e7q2c3", "e7q2x6", "e7q3f3",
"e7q3m4", "e7q3x2", "e7q4c4", "e7q4i8", "e7q5g3", "e7q5l9", "e7q5p8",
"e7q6a9", "e7q6d5", "e7q800", "e7q814", "e7q825", "e7q833", "e7q8i6",
"e7q8q5", "e7q8r1", "e7q8u9", "e7q8y1", "e7qbg0", "e7qcc5", "e7qcf3",
"e7qd66", "e7qdy4", "e7qdy8", "e7qe39", "e7qf79", "e7qfn0", "e7qgb5",
"e7qh38", "e7qh57", "e7qh90", "e7qhj0", "e7qhj7", "e7qhk8", "e7qi53",
"e7qi89", "e7qii2", "e7qiq0", "e7qiv9", "e7qje4", "e7qjm1", "e7qjn3",
"e7qjz3", "e7qka0", "e7qkh1", "e7qki3", "e7ql07", "e7ql23", "e7ql56",
"e7qle4", "e7qlh7", "e7qlm1", "e7qlq3", "e9p8k6", "e9p9c8", "e9p9h6",
"e9p9y2", "f8ka88", "g1uaw4", "g2w8j6", "g2wax6", "g2wbs0", "g2wbt1",
"g2wc37", "g2we94", "g2weh9", "g2wej8", "g2wf31", "g2wgt2", "g2whe0",
"g2wi84", "g2wlm2", "g2wmh7", "g2wmk0", "g2wnc9", "h0gc43", "h0gc45",
"h0gc46", "h0gc71", "h0gcc4", "h0gce3", "h0gce7", "h0gcg9", "h0gcx2",
"h0gd06", "h0gd44", "h0gd98", "h0gda5", "h0gda8", "h0gdj5", "h0gdq8",
"h0gdr5", "h0gdt8", "h0ger5", "h0geu6", "h0gf09", "h0gf24", "h0gf63",
"h0gfb9", "h0gfx9", "h0gg75", "h0ggk6", "h0ggy4", "h0gh33", "h0gh37",
"h0ghf6", "h0ghg0", "h0ghh6", "h0ghk6", "h0gig2", "h0gim1", "h0giq8",
"h0gir4", "h0gj73", "h0gk02", "h0gk39", "h0gk56", "h0gkc0", "h0gkh0",
"h0gl26", "h0gl41", "h0gle1", "h0glz7", "h0gm98", "h0gmi5", "h0gmp1",
"h0gmp4", "h0gms2", "h0gmz5", "h0gn89", "h0gp57", "h0gp81", "h0gp99",
"h0gpm9", "h0gq90", "h0gqv1", "h0gqv6", "h0gr16", "h0gr46", "h0gr62",
"h0grh5", "h0grj7", "h0grp5", "h0gru2", "h0gry2", "h0grz3", "h0gs82",
"h0gs88", "h0gsa9", "h0gsk0", "h0gsl8", "h0gsu6", "h0gtf9", "h0gti8",
"h0gtn2", "h0gts6", "h0gu87", "h0gug5", "h0guj4", "h0gur2", "h0gut3",
"h0guu5", "h0gux5", "h0gv21", "h0gv78", "h0gvm9", "h0gvn0", "h0gw05",
"h0gw07", "h0gwi0", "h0gwr8", "h0gx56", "h0gx58", "h0gx70", "h0gx75",
"h0gxf9", "h0gxg6", "h0gxy4", "h0gxz9", "h0gy93", "h0gys0", "h0gyu8",
"h0gyz2", "h0gz20", "h0gzc0", "h0gzd5", "h0gzx8", "h0h061", "h0h0j5",
"h0h0s1", "h0h0t9", "h0h1f1", "h0h1m4", "h0h1r9", "h0h1t7", "h0h216",
"h0h220", "h0h251", "h0h294", "h0h2j1", "i7ji35", "i7ktc2", "n1nwq1",
"n1nxi5", "n1ny73", "n1nyf2", "n1nyt5", "n1nyw8", "n1nz14", "n1nzs8",
"n1p080", "n1p0a4", "n1p0i3", "n1p0w1", "n1p1a9", "n1p1r0", "n1p242",
"n1p2s1", "n1p2s2", "n1p3w6", "n1p4p6", "n1p4q6", "n1p4r9", "n1p548",
"n1p5a6", "n1p5i1", "n1p605", "n1p7b3", "n1p858", "n1p8d9", "n1p8f8",
"n1p8l5", "n1p910", "n1pa29", "n1pa30", "o13429", "o13516", "o14455",
"o14467", "o43137", "p00358", "p00359", "p00360", "p00431", "p00445",
"p00498", "p00549", "p00560", "p00635", "p00729", "p00812", "p00815",
"p00817", "p00830", "p00890", "p00899", "p00924", "p00925", "p00931",
"p00942", "p00950", "p00958", "p01120", "p01123", "p02309", "p02400",
"p02406", "p02557", "p02829", "p02992", "p02994", "p03962", "p03965",
"p04037", "p04046", "p04050", "p04076", "p04147", "p04161", "p04456",
"p04801", "p04802", "p04806", "p04807", "p05150", "p05317", "p05318",
"p05319", "p05373", "p05694", "p05737", "p05738", "p05739", "p05740",
"p05743", "p05744", "p05745", "p05747", "p05749", "p05750", "p05755",
"p05756", "p05759", "p06101", "p06106", "p06168", "p06169", "p06174",
"p06208", "p06244", "p06367", "p06634", "p06738", "p07149", "p07170",
"p07172", "p07244", "p07245", "p07246", "p07256", "p07257", "p07258",
"p07259", "p07260", "p07262", "p07263.2", "p07264", "p07274",
"p07275", "p07277", "p07281", "p07283", "p07284", "p07285", "p07560",
"p07702", "p07703", "p07806.2", "p07884.2", "p07991", "p08465",
"p08518", "p08524", "p08536", "p08566", "p09064", "p09436", "p09624",
"p09733", "p09734", "p09880", "p09938", "p0c2h7", "p0c2h8", "p0cs90",
"p0ct05", "p0cx11", "p0cx24", "p0cx26", "p0cx30", "p0cx32", "p0cx34",
"p0cx36", "p0cx38", "p0cx40", "p0cx42", "p0cx44", "p0cx48", "p0cx50",
"p0cx52", "p0cx54", "p0cx56", "p0cx83", "p0cx85", "p10081", "p10127",
"p10356", "p10591", "p10592", "p10594.2", "p10659", "p10664",
"p10869", "p10964", "p11076", "p11154", "p11353", "p11412", "p11484",
"p11745", "p12612", "p12630", "p12709", "p12904", "p12945", "p13188",
"p13298", "p13663", "p14065", "p14120", "p14126", "p14127", "p14306",
"p14540", "p14743", "p14832", "p14843", "p14904", "p15019", "p15108",
"p15180", "p15202", "p15303", "p15424", "p15454", "p15496", "p15624",
"p15625", "p15646", "p15703", "p15705", "p15790", "p15873", "p15992",
"p16120", "p16140", "p16370", "p16387", "p16467", "p16474", "p16550",
"p16603", "p16649", "p16861", "p17076", "p17255", "p17423", "p17505",
"p17555", "p17649", "p17709", "p17967", "p18544", "p18562", "p18962",
"p19097", "p19262", "p19414", "p19454", "p19812", "p19881", "p19882",
"p20081", "p20133", "p20433", "p20434", "p20436", "p20459", "p20967",
"p21242", "p21243", "p21524", "p21801", "p21826", "p22023", "p22108",
"p22138", "p22141", "p22146", "p22202", "p22203", "p22217", "p22336",
"p22515", "p22696", "p22803", "p23180", "p23248", "p23254", "p23301",
"p23638", "p23639", "p23724", "p23776", "p24000", "p24280", "p24521",
"p24783", "p24859", "p25036", "p25043", "p25293", "p25328", "p25332",
"p25359", "p25373", "p25375", "p25443", "p25451", "p25491", "p25567",
"p25572", "p25631", "p25632", "p25638", "p25654", "p25694", "p25719",
"p26321", "p26637", "p26755", "p26783", "p26784", "p26785", "p26786",
"p27466", "p27472", "p27476", "p27614", "p27616", "p27929", "p28000",
"p28241", "p28272", "p28273", "p28274", "p28319", "p28495", "p28707",
"p28777", "p28834", "p29311", "p29453", "p29509", "p29547", "p29952",
"p30402", "p30656", "p30657", "p30952", "p31115", "p31116", "p31209",
"p31373", "p31383", "p31412", "p31539", "p31688", "p32178", "p32179",
"p32288", "p32324", "p32327", "p32337", "p32347", "p32356", "p32377",
"p32379", "p32381", "p32445", "p32452", "p32459", "p32460", "p32461",
"p32469", "p32471", "p32474", "p32481", "p32485", "p32486", "p32495",
"p32497", "p32527", "p32529", "p32558", "p32565", "p32582", "p32589",
"p32590", "p32598", "p32604", "p32614", "p32626", "p32628", "p32643",
"p32656", "p32767", "p32771", "p32774", "p32775", "p32835", "p32836",
"p32860", "p32895", "p32905", "p32939", "p33201", "p33204", "p33298",
"p33307", "p33312", "p33315", "p33317", "p33327", "p33330", "p33399",
"p33401", "p33412", "p33416", "p33442", "p33734", "p34162", "p34167",
"p34223", "p34227", "p34760", "p35176", "p35184", "p35189", "p35195",
"p35691", "p35719", "p35844", "p36008", "p36010", "p36015", "p36017",
"p36018", "p36037", "p36047", "p36060", "p36069", "p36104", "p36136",
"p36156", "p36159", "p36421", "p37012", "p37254", "p37291", "p37292",
"p37302", "p37303", "p37898", "p38009", "p38011", "p38013", "p38061",
"p38066", "p38067", "p38071", "p38075", "p38081", "p38088.2",
"p38109", "p38113", "p38115", "p38145", "p38197", "p38199", "p38203",
"p38205", "p38237", "p38254", "p38260", "p38328", "p38331", "p38431",
"p38439", "p38523", "p38555", "p38616", "p38620", "p38623", "p38625",
"p38627", "p38628", "p38687", "p38688", "p38693", "p38697", "p38698",
"p38701", "p38707", "p38710", "p38711", "p38715", "p38716", "p38754",
"p38764", "p38765", "p38774", "p38777", "p38787", "p38788", "p38791",
"p38792", "p38797", "p38804", "p38820", "p38840", "p38841", "p38858",
"p38861", "p38879", "p38882", "p38888", "p38891", "p38902", "p38930",
"p38972", "p38986", "p38999", "p39076", "p39079", "p39522", "p39676",
"p39683", "p39692", "p39708", "p39714", "p39721", "p39929", "p39939",
"p39954", "p39958", "p39976", "p39979", "p39988", "p39990", "p40011",
"p40016", "p40029", "p40032", "p40037", "p40043", "p40047", "p40054",
"p40069", "p40070", "p40075", "p40087", "p40089", "p40106", "p40185",
"p40302", "p40354", "p40363", "p40414", "p40422", "p40454", "p40459",
"p40495", "p40498", "p40506", "p40509", "p40510", "p40531", "p40545",
"p40553", "p40581", "p40586", "p40825.2", "p41057", "p41058",
"p41277", "p41338", "p41752", "p41805", "p41811", "p41816", "p41835",
"p41895", "p41896", "p41920", "p41921", "p41939", "p41940", "p42935",
"p42936", "p42941", "p42943", "p43561", "p43567", "p43583", "p43590",
"p43593", "p43616", "p43621", "p46151", "p46654", "p46655", "p46669",
"p46672", "p46680", "p46948", "p46959", "p46969", "p46990", "p47008",
"p47079", "p47089", "p47095", "p47096", "p47103", "p47117", "p47119",
"p47120", "p47164", "p47173", "p47176", "p47771", "p48164", "p48362",
"p48363", "p48445", "p48526", "p48567", "p48589", "p49017", "p49089",
"p49090", "p49166", "p49167", "p49367", "p49435", "p49723", "p49775",
"p49954", "p49957", "p50086", "p50094", "p50095", "p50101", "p50264",
"p50861", "p50946", "p51401", "p51601", "p51996", "p52488", "p52489",
"p52910", "p52918", "p53072", "p53090", "p53095", "p53110", "p53111",
"p53128", "p53144", "p53164", "p53177", "p53183", "p53184", "p53196",
"p53221", "p53228", "p53235", "p53255", "p53256", "p53265", "p53270",
"p53303", "p53315", "p53319", "p53334", "p53342", "p53598", "p53615",
"p53633", "p53720", "p53727", "p53731", "p53759", "p53834", "p53839",
"p53848", "p53909", "p53912", "p53920", "p53980", "p53981", "p54113",
"p54114", "p54115", "p54838", "p54839", "p54885", "p60010", "p80210",
"p83774", "p87262", "p89886", "q00055", "q00618", "q00711", "q00764",
"q00955", "q01855", "q02326", "q02455", "q02642", "q02648", "q02725",
"q02821", "q02892", "q02933", "q03034", "q03048", "q03102", "q03161",
"q03262", "q03280", "q03532", "q03558", "q03629", "q03677", "q03690",
"q03771", "q03774", "q03940", "q04066", "q04119", "q04120", "q04175",
"q04178", "q04212", "q04225", "q04336", "q04401", "q04409", "q04430",
"q04432", "q04491", "q04533", "q04636", "q04660", "q04728", "q04792",
"q04894", "q04947", "q04951", "q05016", "q05022", "q05506", "q05515",
"q05533", "q05583", "q05636", "q05778", "q05788", "q05905", "q05911",
"q05933", "q05946", "q05979", "q06053", "q06103", "q06137", "q06146",
"q06151", "q06252", "q06338", "q06385", "q06406", "q06408", "q06440",
"q06494", "q06523", "q06608", "q06624", "q06625", "q06672", "q06706",
"q07381", "q07505", "q07527", "q07532", "q07551", "q07589", "q07648",
"q07938", "q08162", "q08220", "q08245", "q08421", "q08634", "q08647",
"q08686", "q08745", "q08920", "q08924", "q08952", "q08971", "q08977",
"q08985", "q12008", "q12009", "q12040", "q12074", "q12091", "q12109",
"q12118", "q12122", "q12123", "q12159", "q12168", "q12189", "q12211",
"q12242", "q12277", "q12283", "q12306", "q12314", "q12329", "q12335",
"q12341", "q12363", "q12377", "q12400", "q12408", "q12414", "q12434",
"q12447", "q12449", "q12455", "q12458", "q12460", "q12464", "q12496",
"q12522", "q12525", "q12680", "q3e754", "q3e792", "q3e7x9", "q3e7y3",
"q6fjy0_cangasimilartouniprot", "q6fl72_cangasimilartouniprot",
"q6fmr2_cangasimilartouniprot", "q6fns7_cangasimilartouniprot",
"q6fph8_cangasimilartouniprot", "q6fpi1_cangasimilartouniprot",
"q6fpn8_cangasimilartouniprot", "q6fpp1_cangasimilartouniprot",
"q6fr31_cangasimilartouniprot", "q6frs2_cangasimilartouniprot",
"q6fst2_cangasimilartouniprot", "q6ftb3_cangasimilartouniprot",
"q6ftj1_cangasimilartouniprot", "q6ftk5_cangasimilartouniprot",
"q6fvr0_cangasimilartouniprot", "q6fwr8_cangasimilartouniprot",
"q6fx34_cangasimilartouniprot", "q6fxu9_cangasimilartouniprot",
"q6q560", "q74z16", "q74z48", "q74zf6", "q74zm9", "q750e3", "q750u5",
"q750z7", "q751d8", "q752q7", "q752w6", "q753p8", "q753t3", "q753w1",
"q753y2", "q754c8", "q754d6", "q754f6", "q755g1", "q755g8", "q755q5",
"q756e2", "q756e7", "q756f7", "q756k2", "q756u4", "q756y3", "q757i1",
"q757l4", "q757n1", "q757y2", "q758l1", "q758t1", "q759a3", "q759a4",
"q759a9", "q759i7", "q759v7", "q75aa5", "q75bc3", "q75bq6", "q75bv8",
"q75c57", "q75cf8", "q75cn6", "q75df8", "q75dp6", "q75dq0", "q75ds7",
"q75du3", "q75dw1", "q75en0", "q75ew2", "q75f01", "q87026", "q8j1f8",
"q8j2m3", "q8mx29", "q96vh4", "q99210", "q99258", "q99312", "q9p4c2",
"s4vpl7", "s5s176", "t2a536", "v5rd14"), class = "factor"), `2_1` = c(0,
0, 0, 0, 0.933959669839227, 0), `2_2` = c(0, 0, 0, 0, 14.2445924025971,
0), `2_3` = c(0, 0, 0, 0, 1.84391659829476, 0), `2_4` = c(0,
0, 0, 0, 1, 0), `2_5` = c(0, 0, 0, 0, 0.850344700878792, 0),
`2_6` = c(0.0631240804031774, 0, 0, 1.11684072808048, 1,
1.29478435854497), `2_7` = c(0.135377134405041, 0, 0, 0.941579635959761,
0.389199799282971, 0.705215641455033), `2_8` = c(0.340634833543641,
0, 0, 1, 0.467857655108082, 0), `2_9` = c(1.43325438281299,
0, 0, 0, 0.157821181013907, 0), `2_10` = c(1.71425095521776,
0, 0, 0, 0.382740802185421, 0), `2_11` = c(0.715532320539672,
0, 0, 0, 0, 0), `2_12` = c(0, 0, 0, 0, 0, 0), `2_13` = c(0,
0, 0, 0, 0, 0), `2_14` = c(0, 0, 0, 0, 0, 0), `2_15` = c(1.72759758284943,
0, 0, 0, 0, 0), `2_16` = c(1.71289858010354, 0, 0, 0, 0,
0), `2_17` = c(0.747888289194788, 1, 0, 0, 0, 0), `2_18` = c(0,
0, 0, 0, 0, 0), `2_19` = c(0, 0, 0, 0, 0, 0), `2_20` = c(0,
0, 0, 0, 0, 0), `2_21` = c(0, 0, 0, 0, 0, 0), `2_22` = c(0,
0, 0, 0, 0, 0), `2_23` = c(0, 0, 1.29452015085474, 0, 0,
0), `2_24` = c(0, 0, 0.852739924572629, 0, 0, 0)), .Names = c("Gene name",
"2_1", "2_2", "2_3", "2_4", "2_5", "2_6", "2_7", "2_8", "2_9",
"2_10", "2_11", "2_12", "2_13", "2_14", "2_15", "2_16", "2_17",
"2_18", "2_19", "2_20", "2_21", "2_22", "2_23", "2_24"), row.names = c(NA,
6L), class = "data.frame")
Script I use to get local maximas:
## Preparing a function ##
example <- c(5,2,3,2,1, 1, 2, 3)
localmaxima <- function(example) {
x <- c(ifelse(diff(head(example, 2)) < 0, 1, NA), which(diff(sign(diff(example))) == -2) + 1, ifelse(diff(tail(example, 2)) > 0, length(example),
NA))
x <- as.vector(x[!is.na(x)])
x <- x[example[x] >= 0.2 * max(example)]
}
## Creating a list - one element for each row - containing indices
## of local maximas including edges
indices <- apply(as.matrix(tbl_all2[, -1]), 1, FUN = localmaxima)
## Converting them to coordinates of matrix
coords <- do.call(rbind, lapply(seq_along(indices), FUN = function(i) (expand.grid(i, indices[[i]]))))
## Creating an empty matrix
empty <- matrix(0, nrow = nrow(tbl_all2), ncol = ncol(tbl_all2) - 1)
## Setting the 1 at locations of local maximas
empty[as.matrix(coords)] <- 1
## Creating results by cbinding back the gene name and adding names to columns.
tbl_peak <- cbind(tbl_all2[, 1], as.data.frame(empty))
names(tbl_peak) <- names(tbl_all2)
Do you think it is possible to write such code ? Any ideas ?
Upvotes: 4
Views: 311
Answers (4)
slushy
Reputation: 3357
Only works when the local maxima are separated by zero values (which was specified in the post):
localmaxima <- function(Row) {
row.max <- max(Row)
# Zeros identify the boundaries
stops = unique( c(1, which(Row == 0), L) )
for ( i in seq(length(stops) - 1) ) {
win = stops[i]:stops[i+1]
intermediate.max = max(Row[win])
if ( intermediate.max >= .2 * row.max ) {
Row[win] <- Row[win] / intermediate.max
} else {
Row[win] <- 0
}
}
return(Row)
}
# The input:
Mat
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
Greg 0 30 50 10 0 30 60
Mike 20 50 30 0 0 2 0
Susane 30 0 10 0 100 30 0
Marcel 0 40 30 10 0 2 0
# The output:
t(apply(Mat, 1, localmaxima))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
Greg 0.0 0.6 1.00 0.20 0 0.5 1
Mike 0.4 1.0 0.60 0.00 0 0.0 0
Susane 1.0 0.0 0.00 0.00 1 0.3 0
Marcel 0.0 1.0 0.75 0.25 0 0.0 0
Upvotes: 2
TheComeOnMan
Reputation: 12875
Starting with your dataset, which I've called df, I think this does the trick. It needs you to pass df to it and the rest is handled in the code, I'm sure you can put it in a function yourself -
library(data.table)
library(reshape2)
dt <- data.table(df)
setnames(dt,'Gene name','Genename')
dtMelted <- data.table(melt(dt, id.vars = 'Genename'))
# correctly ordering
dtMelted[,variableno := match(variable ,colnames(dt))]
# identiftying possible local maximas
setkeyv(dtMelted, c('Genename','variableno'))
dtMelted[,MaxBefore := c(0,diff(value)), by = Genename]
dtMelted[,MaxAfter := -c(diff(value),0), by = Genename]
# adding 80% criteria
dtMelted[,pctcutoffmet := ifelse(value / max(value) > .8, TRUE, FALSE), by = Genename]
# isolating local maximas
dtMeltedLocalMaximas <- dtMelted[
MaxAfter >= 0 & MaxBefore >= 0
& !(MaxBefore ==0 & MaxAfter ==0)
& pctcutoffmet == TRUE
]
# merging to nearest local maxima, assuming that key(dtFinalMelted) = key(dtMeltedLocalMAximas) = c('Genename','variableno')
dtFinalMelted <- dtMeltedLocalMaximas[dtMelted, roll = 'nearest']
# calculating pct of local maxima
dtFinalMelted[,valuepctoflocalmaxima := value.1 / value]
# reformatting to original structure
dtFinal <- dcast(dtFinalMelted, Genename ~ variableno, value.var = 'valuepctoflocalmaxima', fun.aggregate = sum)
# setting column names correctly
setnames(dtFinal,colnames(df))
Output (in which I used round(value.1 / value,2) instead of as above) -
> dput(dtFinal)
structure(list(`Gene name` = structure(1:6, .Label = c("a2p1u8",
"a2qab2", "a6zl23", "a6zlf3", "a6zq61", "a6ztx1", "a6zw47", "a6zya9",
"a7a095", "a7a0l4", "b2g4d8", "b2g4i6", "b2g4p9", "b2g4u5", "b2zbw7",
"b3lgx6", "b3lh69", "b3lha4", "b3ljq6", "b3llk0", "b3lp17", "b3ltm6",
"b5vdr5", "b5ve00", "b5ve47", "b5ve66", "b5ve75", "b5vea8", "b5ved3",
"b5vej5", "b5vfh0", "b5vfm0", "b5vfq6", "b5vg00", "b5vgm8", "b5vgw4",
"b5vh77", "b5vi95", "b5vif4", "b5vik7", "b5vik8", "b5viu6", "b5vj32",
"b5vjc2", "b5vji2", "b5vk65", "b5vkc9", "b5vkd1", "b5vkr2", "b5vkr3",
"b5vl55", "b5vl71", "b5vla9", "b5vlc1", "b5vln1", "b5vlr4", "b5vm13",
"b5vm96", "b5vmw7", "b5vn73", "b5vnb6", "b5vnc3", "b5vnj1", "b5vnk1",
"b5vp33", "b5vp56", "b5vpx6", "b5vq26", "b5vq44", "b5vq52", "b5vqk3",
"b5vrj3", "b5vrz5", "b5vs89", "b5vsy8", "c7gni0", "c7gq32", "c7gqn5",
"c7gtn6", "c7gu46", "c7gwe7", "c7gxt0", "c8z669", "c8z6f5", "c8z6r4",
"c8z6v4", "c8zbm1", "c8zcu8", "c8zd16", "c8zhg0", "e7k9a7", "e7k9i7",
"e7ka19", "e7ka28", "e7kag3", "e7kak7", "e7kau5", "e7kb37", "e7kbg6",
"e7kbp6", "e7kde5", "e7kdf5", "e7kdl8", "e7kec6", "e7kek6", "e7ker2",
"e7kez8", "e7kfj1", "e7kg86", "e7kgg6", "e7kgj9", "e7kgm9", "e7kh79",
"e7khz2", "e7kid1", "e7kid2", "e7kij3", "e7kip9", "e7kiv1", "e7kj59",
"e7kjc9", "e7kjz8", "e7kkg8", "e7kks4", "e7kkx7", "e7klq2", "e7km62",
"e7kmw1", "e7kni6", "e7knq6", "e7knx6", "e7kp09", "e7kps9", "e7kql6",
"e7kqt5", "e7kr71", "e7krc8", "e7krj9", "e7krs0", "e7ks72", "e7ksf4",
"e7ksg0", "e7ksv0", "e7ku26", "e7kui4", "e7kuz1", "e7kv21", "e7kvp5",
"e7lr73", "e7lrn1", "e7ls46", "e7ls63", "e7lsa7", "e7lsk8", "e7lsm3",
"e7lsy6", "e7lte7", "e7ltk1", "e7ltv7", "e7lu34", "e7lun6", "e7lup5",
"e7lux5", "e7lv27", "e7lw21", "e7lw44", "e7lwa5", "e7lwl6", "e7lwm3",
"e7lx88", "e7lxj7", "e7lxn8", "e7lxp5", "e7ly02", "e7lyz3", "e7lz85",
"e7lzh7", "e7lzn6", "e7m129", "e7ney3", "e7nf47", "e7nfe5", "e7nfq5",
"e7nfz0", "e7ng34", "e7nh47", "e7nh77", "e7nhb2", "e7nhq7", "e7nie7",
"e7nii6", "e7nir5", "e7nje2", "e7njk4", "e7njv1", "e7nk19", "e7nk28",
"e7nkm6", "e7nl37", "e7nl74", "e7nlc7", "e7nlm1", "e7nlr2", "e7nlt8",
"e7nm31", "e7nm99", "e7nmz4", "e7nn89", "e7npc6", "e7q121", "e7q1a1",
"e7q1e1", "e7q1k7", "e7q1t1", "e7q1x8", "e7q2c3", "e7q2x6", "e7q3f3",
"e7q3m4", "e7q3x2", "e7q4c4", "e7q4i8", "e7q5g3", "e7q5l9", "e7q5p8",
"e7q6a9", "e7q6d5", "e7q800", "e7q814", "e7q825", "e7q833", "e7q8i6",
"e7q8q5", "e7q8r1", "e7q8u9", "e7q8y1", "e7qbg0", "e7qcc5", "e7qcf3",
"e7qd66", "e7qdy4", "e7qdy8", "e7qe39", "e7qf79", "e7qfn0", "e7qgb5",
"e7qh38", "e7qh57", "e7qh90", "e7qhj0", "e7qhj7", "e7qhk8", "e7qi53",
"e7qi89", "e7qii2", "e7qiq0", "e7qiv9", "e7qje4", "e7qjm1", "e7qjn3",
"e7qjz3", "e7qka0", "e7qkh1", "e7qki3", "e7ql07", "e7ql23", "e7ql56",
"e7qle4", "e7qlh7", "e7qlm1", "e7qlq3", "e9p8k6", "e9p9c8", "e9p9h6",
"e9p9y2", "f8ka88", "g1uaw4", "g2w8j6", "g2wax6", "g2wbs0", "g2wbt1",
"g2wc37", "g2we94", "g2weh9", "g2wej8", "g2wf31", "g2wgt2", "g2whe0",
"g2wi84", "g2wlm2", "g2wmh7", "g2wmk0", "g2wnc9", "h0gc43", "h0gc45",
"h0gc46", "h0gc71", "h0gcc4", "h0gce3", "h0gce7", "h0gcg9", "h0gcx2",
"h0gd06", "h0gd44", "h0gd98", "h0gda5", "h0gda8", "h0gdj5", "h0gdq8",
"h0gdr5", "h0gdt8", "h0ger5", "h0geu6", "h0gf09", "h0gf24", "h0gf63",
"h0gfb9", "h0gfx9", "h0gg75", "h0ggk6", "h0ggy4", "h0gh33", "h0gh37",
"h0ghf6", "h0ghg0", "h0ghh6", "h0ghk6", "h0gig2", "h0gim1", "h0giq8",
"h0gir4", "h0gj73", "h0gk02", "h0gk39", "h0gk56", "h0gkc0", "h0gkh0",
"h0gl26", "h0gl41", "h0gle1", "h0glz7", "h0gm98", "h0gmi5", "h0gmp1",
"h0gmp4", "h0gms2", "h0gmz5", "h0gn89", "h0gp57", "h0gp81", "h0gp99",
"h0gpm9", "h0gq90", "h0gqv1", "h0gqv6", "h0gr16", "h0gr46", "h0gr62",
"h0grh5", "h0grj7", "h0grp5", "h0gru2", "h0gry2", "h0grz3", "h0gs82",
"h0gs88", "h0gsa9", "h0gsk0", "h0gsl8", "h0gsu6", "h0gtf9", "h0gti8",
"h0gtn2", "h0gts6", "h0gu87", "h0gug5", "h0guj4", "h0gur2", "h0gut3",
"h0guu5", "h0gux5", "h0gv21", "h0gv78", "h0gvm9", "h0gvn0", "h0gw05",
"h0gw07", "h0gwi0", "h0gwr8", "h0gx56", "h0gx58", "h0gx70", "h0gx75",
"h0gxf9", "h0gxg6", "h0gxy4", "h0gxz9", "h0gy93", "h0gys0", "h0gyu8",
"h0gyz2", "h0gz20", "h0gzc0", "h0gzd5", "h0gzx8", "h0h061", "h0h0j5",
"h0h0s1", "h0h0t9", "h0h1f1", "h0h1m4", "h0h1r9", "h0h1t7", "h0h216",
"h0h220", "h0h251", "h0h294", "h0h2j1", "i7ji35", "i7ktc2", "n1nwq1",
"n1nxi5", "n1ny73", "n1nyf2", "n1nyt5", "n1nyw8", "n1nz14", "n1nzs8",
"n1p080", "n1p0a4", "n1p0i3", "n1p0w1", "n1p1a9", "n1p1r0", "n1p242",
"n1p2s1", "n1p2s2", "n1p3w6", "n1p4p6", "n1p4q6", "n1p4r9", "n1p548",
"n1p5a6", "n1p5i1", "n1p605", "n1p7b3", "n1p858", "n1p8d9", "n1p8f8",
"n1p8l5", "n1p910", "n1pa29", "n1pa30", "o13429", "o13516", "o14455",
"o14467", "o43137", "p00358", "p00359", "p00360", "p00431", "p00445",
"p00498", "p00549", "p00560", "p00635", "p00729", "p00812", "p00815",
"p00817", "p00830", "p00890", "p00899", "p00924", "p00925", "p00931",
"p00942", "p00950", "p00958", "p01120", "p01123", "p02309", "p02400",
"p02406", "p02557", "p02829", "p02992", "p02994", "p03962", "p03965",
"p04037", "p04046", "p04050", "p04076", "p04147", "p04161", "p04456",
"p04801", "p04802", "p04806", "p04807", "p05150", "p05317", "p05318",
"p05319", "p05373", "p05694", "p05737", "p05738", "p05739", "p05740",
"p05743", "p05744", "p05745", "p05747", "p05749", "p05750", "p05755",
"p05756", "p05759", "p06101", "p06106", "p06168", "p06169", "p06174",
"p06208", "p06244", "p06367", "p06634", "p06738", "p07149", "p07170",
"p07172", "p07244", "p07245", "p07246", "p07256", "p07257", "p07258",
"p07259", "p07260", "p07262", "p07263.2", "p07264", "p07274",
"p07275", "p07277", "p07281", "p07283", "p07284", "p07285", "p07560",
"p07702", "p07703", "p07806.2", "p07884.2", "p07991", "p08465",
"p08518", "p08524", "p08536", "p08566", "p09064", "p09436", "p09624",
"p09733", "p09734", "p09880", "p09938", "p0c2h7", "p0c2h8", "p0cs90",
"p0ct05", "p0cx11", "p0cx24", "p0cx26", "p0cx30", "p0cx32", "p0cx34",
"p0cx36", "p0cx38", "p0cx40", "p0cx42", "p0cx44", "p0cx48", "p0cx50",
"p0cx52", "p0cx54", "p0cx56", "p0cx83", "p0cx85", "p10081", "p10127",
"p10356", "p10591", "p10592", "p10594.2", "p10659", "p10664",
"p10869", "p10964", "p11076", "p11154", "p11353", "p11412", "p11484",
"p11745", "p12612", "p12630", "p12709", "p12904", "p12945", "p13188",
"p13298", "p13663", "p14065", "p14120", "p14126", "p14127", "p14306",
"p14540", "p14743", "p14832", "p14843", "p14904", "p15019", "p15108",
"p15180", "p15202", "p15303", "p15424", "p15454", "p15496", "p15624",
"p15625", "p15646", "p15703", "p15705", "p15790", "p15873", "p15992",
"p16120", "p16140", "p16370", "p16387", "p16467", "p16474", "p16550",
"p16603", "p16649", "p16861", "p17076", "p17255", "p17423", "p17505",
"p17555", "p17649", "p17709", "p17967", "p18544", "p18562", "p18962",
"p19097", "p19262", "p19414", "p19454", "p19812", "p19881", "p19882",
"p20081", "p20133", "p20433", "p20434", "p20436", "p20459", "p20967",
"p21242", "p21243", "p21524", "p21801", "p21826", "p22023", "p22108",
"p22138", "p22141", "p22146", "p22202", "p22203", "p22217", "p22336",
"p22515", "p22696", "p22803", "p23180", "p23248", "p23254", "p23301",
"p23638", "p23639", "p23724", "p23776", "p24000", "p24280", "p24521",
"p24783", "p24859", "p25036", "p25043", "p25293", "p25328", "p25332",
"p25359", "p25373", "p25375", "p25443", "p25451", "p25491", "p25567",
"p25572", "p25631", "p25632", "p25638", "p25654", "p25694", "p25719",
"p26321", "p26637", "p26755", "p26783", "p26784", "p26785", "p26786",
"p27466", "p27472", "p27476", "p27614", "p27616", "p27929", "p28000",
"p28241", "p28272", "p28273", "p28274", "p28319", "p28495", "p28707",
"p28777", "p28834", "p29311", "p29453", "p29509", "p29547", "p29952",
"p30402", "p30656", "p30657", "p30952", "p31115", "p31116", "p31209",
"p31373", "p31383", "p31412", "p31539", "p31688", "p32178", "p32179",
"p32288", "p32324", "p32327", "p32337", "p32347", "p32356", "p32377",
"p32379", "p32381", "p32445", "p32452", "p32459", "p32460", "p32461",
"p32469", "p32471", "p32474", "p32481", "p32485", "p32486", "p32495",
"p32497", "p32527", "p32529", "p32558", "p32565", "p32582", "p32589",
"p32590", "p32598", "p32604", "p32614", "p32626", "p32628", "p32643",
"p32656", "p32767", "p32771", "p32774", "p32775", "p32835", "p32836",
"p32860", "p32895", "p32905", "p32939", "p33201", "p33204", "p33298",
"p33307", "p33312", "p33315", "p33317", "p33327", "p33330", "p33399",
"p33401", "p33412", "p33416", "p33442", "p33734", "p34162", "p34167",
"p34223", "p34227", "p34760", "p35176", "p35184", "p35189", "p35195",
"p35691", "p35719", "p35844", "p36008", "p36010", "p36015", "p36017",
"p36018", "p36037", "p36047", "p36060", "p36069", "p36104", "p36136",
"p36156", "p36159", "p36421", "p37012", "p37254", "p37291", "p37292",
"p37302", "p37303", "p37898", "p38009", "p38011", "p38013", "p38061",
"p38066", "p38067", "p38071", "p38075", "p38081", "p38088.2",
"p38109", "p38113", "p38115", "p38145", "p38197", "p38199", "p38203",
"p38205", "p38237", "p38254", "p38260", "p38328", "p38331", "p38431",
"p38439", "p38523", "p38555", "p38616", "p38620", "p38623", "p38625",
"p38627", "p38628", "p38687", "p38688", "p38693", "p38697", "p38698",
"p38701", "p38707", "p38710", "p38711", "p38715", "p38716", "p38754",
"p38764", "p38765", "p38774", "p38777", "p38787", "p38788", "p38791",
"p38792", "p38797", "p38804", "p38820", "p38840", "p38841", "p38858",
"p38861", "p38879", "p38882", "p38888", "p38891", "p38902", "p38930",
"p38972", "p38986", "p38999", "p39076", "p39079", "p39522", "p39676",
"p39683", "p39692", "p39708", "p39714", "p39721", "p39929", "p39939",
"p39954", "p39958", "p39976", "p39979", "p39988", "p39990", "p40011",
"p40016", "p40029", "p40032", "p40037", "p40043", "p40047", "p40054",
"p40069", "p40070", "p40075", "p40087", "p40089", "p40106", "p40185",
"p40302", "p40354", "p40363", "p40414", "p40422", "p40454", "p40459",
"p40495", "p40498", "p40506", "p40509", "p40510", "p40531", "p40545",
"p40553", "p40581", "p40586", "p40825.2", "p41057", "p41058",
"p41277", "p41338", "p41752", "p41805", "p41811", "p41816", "p41835",
"p41895", "p41896", "p41920", "p41921", "p41939", "p41940", "p42935",
"p42936", "p42941", "p42943", "p43561", "p43567", "p43583", "p43590",
"p43593", "p43616", "p43621", "p46151", "p46654", "p46655", "p46669",
"p46672", "p46680", "p46948", "p46959", "p46969", "p46990", "p47008",
"p47079", "p47089", "p47095", "p47096", "p47103", "p47117", "p47119",
"p47120", "p47164", "p47173", "p47176", "p47771", "p48164", "p48362",
"p48363", "p48445", "p48526", "p48567", "p48589", "p49017", "p49089",
"p49090", "p49166", "p49167", "p49367", "p49435", "p49723", "p49775",
"p49954", "p49957", "p50086", "p50094", "p50095", "p50101", "p50264",
"p50861", "p50946", "p51401", "p51601", "p51996", "p52488", "p52489",
"p52910", "p52918", "p53072", "p53090", "p53095", "p53110", "p53111",
"p53128", "p53144", "p53164", "p53177", "p53183", "p53184", "p53196",
"p53221", "p53228", "p53235", "p53255", "p53256", "p53265", "p53270",
"p53303", "p53315", "p53319", "p53334", "p53342", "p53598", "p53615",
"p53633", "p53720", "p53727", "p53731", "p53759", "p53834", "p53839",
"p53848", "p53909", "p53912", "p53920", "p53980", "p53981", "p54113",
"p54114", "p54115", "p54838", "p54839", "p54885", "p60010", "p80210",
"p83774", "p87262", "p89886", "q00055", "q00618", "q00711", "q00764",
"q00955", "q01855", "q02326", "q02455", "q02642", "q02648", "q02725",
"q02821", "q02892", "q02933", "q03034", "q03048", "q03102", "q03161",
"q03262", "q03280", "q03532", "q03558", "q03629", "q03677", "q03690",
"q03771", "q03774", "q03940", "q04066", "q04119", "q04120", "q04175",
"q04178", "q04212", "q04225", "q04336", "q04401", "q04409", "q04430",
"q04432", "q04491", "q04533", "q04636", "q04660", "q04728", "q04792",
"q04894", "q04947", "q04951", "q05016", "q05022", "q05506", "q05515",
"q05533", "q05583", "q05636", "q05778", "q05788", "q05905", "q05911",
"q05933", "q05946", "q05979", "q06053", "q06103", "q06137", "q06146",
"q06151", "q06252", "q06338", "q06385", "q06406", "q06408", "q06440",
"q06494", "q06523", "q06608", "q06624", "q06625", "q06672", "q06706",
"q07381", "q07505", "q07527", "q07532", "q07551", "q07589", "q07648",
"q07938", "q08162", "q08220", "q08245", "q08421", "q08634", "q08647",
"q08686", "q08745", "q08920", "q08924", "q08952", "q08971", "q08977",
"q08985", "q12008", "q12009", "q12040", "q12074", "q12091", "q12109",
"q12118", "q12122", "q12123", "q12159", "q12168", "q12189", "q12211",
"q12242", "q12277", "q12283", "q12306", "q12314", "q12329", "q12335",
"q12341", "q12363", "q12377", "q12400", "q12408", "q12414", "q12434",
"q12447", "q12449", "q12455", "q12458", "q12460", "q12464", "q12496",
"q12522", "q12525", "q12680", "q3e754", "q3e792", "q3e7x9", "q3e7y3",
"q6fjy0_cangasimilartouniprot", "q6fl72_cangasimilartouniprot",
"q6fmr2_cangasimilartouniprot", "q6fns7_cangasimilartouniprot",
"q6fph8_cangasimilartouniprot", "q6fpi1_cangasimilartouniprot",
"q6fpn8_cangasimilartouniprot", "q6fpp1_cangasimilartouniprot",
"q6fr31_cangasimilartouniprot", "q6frs2_cangasimilartouniprot",
"q6fst2_cangasimilartouniprot", "q6ftb3_cangasimilartouniprot",
"q6ftj1_cangasimilartouniprot", "q6ftk5_cangasimilartouniprot",
"q6fvr0_cangasimilartouniprot", "q6fwr8_cangasimilartouniprot",
"q6fx34_cangasimilartouniprot", "q6fxu9_cangasimilartouniprot",
"q6q560", "q74z16", "q74z48", "q74zf6", "q74zm9", "q750e3", "q750u5",
"q750z7", "q751d8", "q752q7", "q752w6", "q753p8", "q753t3", "q753w1",
"q753y2", "q754c8", "q754d6", "q754f6", "q755g1", "q755g8", "q755q5",
"q756e2", "q756e7", "q756f7", "q756k2", "q756u4", "q756y3", "q757i1",
"q757l4", "q757n1", "q757y2", "q758l1", "q758t1", "q759a3", "q759a4",
"q759a9", "q759i7", "q759v7", "q75aa5", "q75bc3", "q75bq6", "q75bv8",
"q75c57", "q75cf8", "q75cn6", "q75df8", "q75dp6", "q75dq0", "q75ds7",
"q75du3", "q75dw1", "q75en0", "q75ew2", "q75f01", "q87026", "q8j1f8",
"q8j2m3", "q8mx29", "q96vh4", "q99210", "q99258", "q99312", "q9p4c2",
"s4vpl7", "s5s176", "t2a536", "v5rd14"), class = "factor"), `2_1` = c(0,
0, 0, 0, 0.07, 0), `2_2` = c(0, 0, 0, 0, 1, 0), `2_3` = c(0,
0, 0, 0, 0.13, 0), `2_4` = c(0, 0, 0, 0, 0.07, 0), `2_5` = c(0,
0, 0, 0, 0.06, 0), `2_6` = c(0.04, 0, 0, 1, 0.07, 1), `2_7` = c(0.08,
0, 0, 0.84, 0.03, 0.54), `2_8` = c(0.2, 0, 0, 1, 0.03, 0), `2_9` = c(0.84,
0, 0, 0, 0.01, 0), `2_10` = c(1, 0, 0, 0, 0.03, 0), `2_11` = c(0.42,
0, 0, 0, 0, 0), `2_12` = c(0, 0, 0, 0, 0, 0), `2_13` = c(0, 0,
0, 0, 0, 0), `2_14` = c(0, 0, 0, 0, 0, 0), `2_15` = c(1, 0, 0,
0, 0, 0), `2_16` = c(0.99, 0, 0, 0, 0, 0), `2_17` = c(0.43, 1,
0, 0, 0, 0), `2_18` = c(0, 0, 0, 0, 0, 0), `2_19` = c(0, 0, 0,
0, 0, 0), `2_20` = c(0, 0, 0, 0, 0, 0), `2_21` = c(0, 0, 0, 0,
0, 0), `2_22` = c(0, 0, 0, 0, 0, 0), `2_23` = c(0, 0, 1, 0, 0,
0), `2_24` = c(0, 0, 0.66, 0, 0, 0)), .Names = c("Gene name",
"2_1", "2_2", "2_3", "2_4", "2_5", "2_6", "2_7", "2_8", "2_9",
"2_10", "2_11", "2_12", "2_13", "2_14", "2_15", "2_16", "2_17",
"2_18", "2_19", "2_20", "2_21", "2_22", "2_23", "2_24"), row.names = c(NA,
-6L), class = "data.frame")
Upvotes: 2
Nathan Hatch
Reputation: 109
A slightly different solution, I'd started so I thought i'd finish. The hardest part was creating the local maximums which I did with sublists breaking at zero. Not the best way I don't think in hindsight as there are some annoying corner cases to work around.
(NB - You can add add the 20% criteria to each sublist by using a && operator on each if - from your examples I can't exactly see what behaviour you want in those instances.)
After that it's fairly straightforward to replicate the maximum value for the length of the list. When you put it back together you have a list of dividers rather than a list of indexes. (With a catch when the value is zero so you divide by 1). Apply this to every row of the starting matrix to create a divider matrix. The final step is an element wise multiplication of the inverse of these with the original matrix.
My local_list function with all the if functions is quite ugly, but the local_max and then bdv functions are a bit tidier.
local_list <- function(x) {
#Initialise Variables
L = list()
i = 0
k = 1
previous_zero = FALSE
for (j in 1:length(x)){
if (x[j] == 0) {
if (previous_zero == TRUE){
L[k] <- list(x[j])
k <- k+1
i<-j+1
}
else {
if (j==1){
L[k] <- list(x[j])
i <- j+1
k <- k+1
}
else {
L[k] <- list(x[i:(j-1)])
L[k+1] <- list(x[j]);
k <- k+2
i <- j+1
}
}
previous_zero <- TRUE
}
else {
previous_zero = FALSE
}
if (j==length(x) && x[j] != 0) {
L[k] <- list(x[i:length(x)])
}
}
return(L)
}
localmax <- function(y) {
if (max(unlist(y)) == 0){
rep(1,length(y))
}
else {rep(max(unlist(y)),length(unlist(y)))}
}
bdv <- function(x){ #Build Divider Vector
return((unlist(sapply(local_list(x), localmax))))
}
Having prepared the function calls create the sample matrix.
Greg <- c(0, 30, 50, 10, 0, 30, 60)
Mike <- c(20, 50, 30, 0, 0, 2, 0)
Susane <- c(30, 0, 10, 0, 100, 30, 0)
Marcel <- c(0, 40, 30, 10, 0, 2, 0)
Mat <- rbind(Greg,Mike,Susane,Marcel)
The output then becomes an element wise multiplication
dm <- t(1/(apply(Mat,1,bdv)))
output <- Mat * dm
Upvotes: 1
Miff
Reputation: 7941
localmaxima <- function(dat)
{
dat_orig <- dat
dat1 <- dat
dat[,-1] <- 0
n <- ncol(dat)
#Spread maximum across columns until all hit zeroes
while (!all(dat1 == dat))
{
dat <- dat1
dat1[,2] <- ifelse(dat[,2]==0, 0, pmax( dat[,2],dat[,3]))
dat1[,n] <- ifelse(dat[,n]==0, 0, pmax( dat[,n],dat[,n-1]))
for (i in 3:(n-1)) dat1[,i] <- ifelse(dat[,i]==0, 0, pmax( dat[,i-1],dat[,i],dat[,i+1]))
}
#Exclude using 20% rule
for (i in 1:nrow(dat1))
dat1[i,-1] <- ifelse(dat1[i,-1]/max(dat1[i,-1]) <0.8, 0, dat1[i,-1])
#Divide by maximum
for (i in 1:nrow(dat1))
dat[i,-1] <- ifelse(dat1[i,-1]==0, 0, dat_orig[i,-1]/dat1[i,-1])
dat
}
Example 1 (note that Susane first differs from your answer - I've set it to zero at less than 80% of row maximum)
dat2
# Name 1st 2nd 3rd 4th 5th 6th 7th
#1 Gregg 0 30 50 10 0 30 60
#2 Mike 20 50 30 0 0 2 0
#3 Susane 30 0 10 0 100 30 0
#4 Marcel 0 40 30 10 0 2 0
localmaxima(dat2)
# Name 1st 2nd 3rd 4th 5th 6th 7th
#1 Gregg 0.0 0.6 1.00 0.20 0 0.5 1
#2 Mike 0.4 1.0 0.60 0.00 0 0.0 0
#3 Susane 0.0 0.0 0.00 0.00 1 0.3 0
#4 Marcel 0.0 1.0 0.75 0.25 0 0.0 0
Example 2
dat
# Gene name 2_1 2_2 2_3 2_4 2_5 2_6 2_7 2_8 2_9 2_10 2_11 2_12 2_13 2_14 2_15 2_16 2_17 2_18 2_19 2_20 2_21 2_22 2_23 2_24
#1 a2p1u8 0.0000000 0.00000 0.000000 0 0.0000000 0.06312408 0.1353771 0.3406348 1.4332544 1.7142510 0.7155323 0 0 0 1.727598 1.712899 0.7478883 0 0 0 0 0 0.00000 0.0000000
#2 a2qab2 0.0000000 0.00000 0.000000 0 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0 0 0 0.000000 0.000000 1.0000000 0 0 0 0 0 0.00000 0.0000000
#3 a6zl23 0.0000000 0.00000 0.000000 0 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0 0 0 0.000000 0.000000 0.0000000 0 0 0 0 0 1.29452 0.8527399
#4 a6zlf3 0.0000000 0.00000 0.000000 0 0.0000000 1.11684073 0.9415796 1.0000000 0.0000000 0.0000000 0.0000000 0 0 0 0.000000 0.000000 0.0000000 0 0 0 0 0 0.00000 0.0000000
#5 a6zq61 0.9339597 14.24459 1.843917 1 0.8503447 1.00000000 0.3891998 0.4678577 0.1578212 0.3827408 0.0000000 0 0 0 0.000000 0.000000 0.0000000 0 0 0 0 0 0.00000 0.0000000
#6 a6ztx1 0.0000000 0.00000 0.000000 0 0.0000000 1.29478436 0.7052156 0.0000000 0.0000000 0.0000000 0.0000000 0 0 0 0.000000 0.000000 0.0000000 0 0 0 0 0 0.00000 0.0000000
localmaxima(dat)
# Gene name 2_1 2_2 2_3 2_4 2_5 2_6 2_7 2_8 2_9 2_10 2_11 2_12 2_13 2_14 2_15 2_16 2_17 2_18 2_19 2_20 2_21 2_22 2_23 2_24
#1 a2p1u8 0.00000000 0 0.0000000 0.00000000 0.00000000 0.03682313 0.07897160 0.19870768 0.83608201 1.0000000 0.4174023 0 0 0 1 0.9914917 0.4329065 0 0 0 0 0 0 0.0000000
#2 a2qab2 0.00000000 0 0.0000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.0000000 0.0000000 0 0 0 0 0.0000000 1.0000000 0 0 0 0 0 0 0.0000000
#3 a6zl23 0.00000000 0 0.0000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.0000000 0.0000000 0 0 0 0 0.0000000 0.0000000 0 0 0 0 0 1 0.6587305
#4 a6zlf3 0.00000000 0 0.0000000 0.00000000 0.00000000 1.00000000 0.84307423 0.89538282 0.00000000 0.0000000 0.0000000 0 0 0 0 0.0000000 0.0000000 0 0 0 0 0 0 0.0000000
#5 a6zq61 0.06556591 1 0.1294468 0.07020208 0.05969597 0.07020208 0.02732264 0.03284458 0.01107938 0.0268692 0.0000000 0 0 0 0 0.0000000 0.0000000 0 0 0 0 0 0 0.0000000
#6 a6ztx1 0.00000000 0 0.0000000 0.00000000 0.00000000 1.00000000 0.54465876 0.00000000 0.00000000 0.0000000 0.0000000 0 0 0 0 0.0000000 0.0000000 0 0 0 0 0 0 0.0000000
Upvotes: 1
Related Questions
- Find max number from row then divide and subtract previous number
- Count what is the maximum value in each row and divide each cell by this number (in R)
- R: divide values in rows dataframe by the maximum value in that row
- How to divide each value in a matrix with the max value of the corresponding column
- Dividing a particular numeric column by maximum observation corresponding to another factor column
- R - Divide each value in matrix by maximum value of its row/column
- Calculate row specific based on min
- Finding maximum value per row and normalizing to this value
- Divide all elements in row with the max value in row - Faster approach
- Getting the max for a set of rows in R