बचना कई के लिए-छोरों आर में एक मैट्रिक्स एक नक्शे के सवाल का जवाब देने के लिए कुछ नकली डेटा पैदा करने के पाठ्यक्रम में

Question

तो गणना करने के लिए, मैंने पाया अपने आप निम्नलिखित लेखन:

# Generate some fake data 
lat <- seq(-90, 90, by = 5) 
lon <- seq(-180, 180, by = 10) 
phi <- matrix(0, nrow = length(lat), ncol = length(lon)) 
i <- 1 
for (l1 in lat) { 
    j <- 1 
    for (l2 in lon) { 
     phi[i, j] <- (sin(pi * l1/180) * cos(pi * l2/180))^2 
     j <- j+1 
    } 
    i <- i+1 
} 
phi <- 1500*phi + 4500 # scale it properly 

अब स्पष्ट रूप से उन दो केंद्रीय तक- लूप्स उतनी ही नहीं हैं जितनी मैं चाहूंगा। ऐसा लगता है कि मुझे mapply या नौकरी करने के लिए कुछ प्राप्त करने में सक्षम होना चाहिए, लेकिन दुख की बात है कि एक सूची देता है, और वास्तव में वह नहीं करता जो मैं चाहता हूं। अन्य आवेदन सही चीज़ नहीं लगते हैं।

मुझे यहां क्या याद आ रही है?

Answer 1

आपको मैट्रिक्स बीजगणित का उपयोग करने का प्रयास करना चाहिए। लागू परिवार से किसी भी कार्यों का उपयोग करने के लिए कोई ज़रूरत नहीं:

lat <- seq(-90, 90, by = 5) 
lon <- seq(-180, 180, by = 10) 
1500 * tcrossprod(sin(pi * lat/180), cos(pi * lon/180))^2 + 4500 

Answer 2

आप उपयोग कर सकते outer

x = outer(lat, lon, FUN = function(x,y) {(sin(pi * x/180) * cos(pi * y /180))^2}) 
    identical(x * 1500 + 4500, phi) 
# [1] TRUE 

NBATrends के जवाब अन्य समाधान की तुलना में तेजी हो रहा है। यहां कुछ बेंचमार्क

library(microbenchmark) 
microbenchmark(within(df, { 
    phi <- (sin(pi * lat/180) * cos(pi * lon/180))^2 
    phi <- 1500*phi + 4500 
}), 1500 * tcrossprod(sin(pi * lat/180), cos(pi * lon/180))^2 + 4500, outer(lat, lon, FUN = function(x,y) {(sin(pi * x/180) * cos(pi * y /180))^2}), 
((as.matrix(l1)%*%t(as.matrix(l2)))^2) * 1500 + 4500) 
Unit: microseconds 
                           expr  min  lq  mean median  uq  max neval 
within(df, {  phi <- (sin(pi * lat/180) * cos(pi * lon/180))^2  phi <- 1500 * phi + 4500 }) 255.670 262.0095 270.50948 266.6880 277.7060 385.467 100 
            1500 * tcrossprod(sin(pi * lat/180), cos(pi * lon/180))^2 + 4500 11.471 12.3770 22.30177 12.9805 13.5850 868.130 100 
       outer(lat, lon, FUN = function(x, y) {  (sin(pi * x/180) * cos(pi * y/180))^2 }) 137.645 139.7590 144.39520 141.5700 145.1925 179.905 100 
              ((as.matrix(l1) %*% t(as.matrix(l2)))^2) * 1500 + 4500 16.301 17.6595 20.20390 19.6215 20.5270 80.294 100 

Answer 3

मैट्रिक्स संरचना से क्यों जुड़ा हुआ है और जब आप वेक्टरिस कर सकते हैं तो उपयोग लागू करें?

df <- expand.grid(lat = seq(-90, 90, by = 5), 
       lon = seq(-180, 180, by = 10)) 
df <- within(df, { 
    phi <- (sin(pi * lat/180) * cos(pi * lon/180))^2 
    phi <- 1500*phi + 4500 
    }) 

आप हमेशा here निर्देशों का उपयोग करके वापस परिवर्तित कर सकते हैं।

Answer 4

रेखीय बीजगणित आपके आवेदन के लिए आसान हो सकता है, क्योंकि आप बस तत्व के लिहाज से दो वैक्टर, जो वी * यू^टी के माध्यम से किया जा सकता है गुणा कर रहे हैं। आर में, मैट्रिक्स गुणा %*% है।

lat <- seq(-90, 90, by = 5) 
lon <- seq(-180, 180, by = 10) 

l1 <- sin(pi * lat/180) 
l2 <- s(pi * lon/ 180) 

# compute the matrix 
phi <- as.matrix(l1)%*%t(as.matrix(l2)) 
# square each element of the matrix 
phi <- phi^2 
# scale properly 
# square each element of the matrix 
phi <- 1500*phi + 4500 

Answer 5

sapply() का उपयोग करना है, लेकिन मैं outer() समाधान पसंद करेंगे: बहुत

#using sapply 
phi_1 <- 
    t(
    sapply(lat, function(l1) 
     sapply(lon, function(l2)(sin(pi * l1/180) * cos(pi * l2/180))^2)) 
) * 1500 + 4500 

#compare result 
identical(phi_1, phi) 
# [1] TRUE