如何使全局环境中的用户定义函数的源代码在 R 中无法访问？ （用于教育目的）

Question

I'm a molecular biology instructor, and since the schools have turned online, I was forced to find a way to keep conducting "experiments". I've decided to conduct my "experiments" in R because the kids can already use it.

I have written a function that simulates data by using certain numbers, numbers which the students will be asked to calculate by using the output.

I plan to provide them the function as a global environment object. However, I don't want them to jump to the source code by using getAnywhere() function, and see the numbers there and simply copy + paste stuff. Is there a way I can make the source code of my user-defined function inaccessible? I know hiding code is not cool, but I will do it for the sake of online teaching. If there's no way, then I will try to find another solution.

Answer 1

I guess if this is for educational purposes, then a reasonable attempt at obscuration should be good enough. Here is a function that will take any other function as an argument and return a function with identical behaviour but whose code is not human readable:

obscure <- function(func) {
  f <- as.character(body(func))
  r <- charToRaw(paste(paste(f, collapse = "\n"), "}", sep = "\n"))
  bod <- as.call(list(quote(eval), as.call(list(quote(parse), 
                      text = as.call(list(quote(eval), 
                             as.call(list(quote(rawToChar), r))))))))
  as.function(c(formals(func), bod))
}

So, let's say you wanted to obscure a closed-form Fibonacci generator:

fib <- function(n) {
  round(((5 + sqrt(5)) / 10) * (( 1 + sqrt(5)) / 2) ** (1:n - 1))
}

fib(10)
#> [1]  1  1  2  3  5  8 13 21 34 55

All you need to do is:

fib <- obscure(fib)
fib(10)
#> [1]  1  1  2  3  5  8 13 21 34 55

But if you look at the function itself, it now looks like this:

fib
#> function (n) 
#> eval(parse(text = eval(rawToChar(as.raw(c(0x7b, 0x0a, 0x72, 0x6f, 
#> 0x75, 0x6e, 0x64, 0x28, 0x28, 0x28, 0x35, 0x20, 0x2b, 0x20, 0x73, 
#> 0x71, 0x72, 0x74, 0x28, 0x35, 0x29, 0x29, 0x2f, 0x31, 0x30, 0x29, 
#> 0x20, 0x2a, 0x20, 0x28, 0x28, 0x31, 0x20, 0x2b, 0x20, 0x73, 0x71, 
#> 0x72, 0x74, 0x28, 0x35, 0x29, 0x29, 0x2f, 0x32, 0x29, 0x5e, 0x28, 
#> 0x31, 0x3a, 0x6e, 0x20, 0x2d, 0x20, 0x31, 0x29, 0x29, 0x0a, 0x7d
#> ))))))
#> <environment: 0x0000025b9f7dc068>

Of course, an advanced user would likely be able to reverse-engineer this in a couple of minutes, but if you are teaching an R class I'm guessing most students will see this and give up.

Answer 2

Here is a method that will be a pain to reverse. It uses the walkast package to obfuscate function calls.

Essentially, it replaces f(x) with {randomstring <- f; randomNumber randomOperator randomNumber; randomstring(x)} {randomstring <- f; randomNumber randomOperator randomNumber; randomstring(x)}

Modify the min and max in runif(1, min = 0, max = 1) so that it is in the range of your secret numbers.

obfuscate <- function(f) {
  result <- f
  
  body(result) <- walkast::walk_ast(
    body(result),
    walkast::make_visitor(
      hd = function(f) {
        new_name <- as.name(paste0("x", runif(1, 0, 100000000)))
        decoy_f <- as.name(sample(c("+", "-", "*", "/", "%%", "%*%"), 1))
        bquote({
          .(new_name) <- .(f)
          .(decoy_f)(.(runif(1, min = 0, max = 1)), .(runif(1, min = 0, max = 1)))
          .(new_name)
        })
      }
    )
  )
  result
}


fib <- function(n) {
  round(((5 + sqrt(5)) / 10) * (( 1 + sqrt(5)) / 2) ** (1:n - 1))
}

obfuscate(fib) results in the following function (which isn't too hard to reverse).

function (n) 
{
    x67911473.8479257 <- `{`
    0.130855958675966%%0.881266586482525
    x67911473.8479257
}({
    x76250116.8530434 <- round
    0.302100569708273 - 0.405373327899724
    x76250116.8530434
}({
    x82210419.5132852 <- `*`
    0.49425036739558 + 0.228636586572975
    x82210419.5132852
}({
    x15765817.3236996 <- `(`
    0.797338604461402 %*% 0.514307061443105
    x15765817.3236996
}({
    x71525579.597801 <- `/`
    0.909275721525773 %*% 0.446680159773678
    x71525579.597801
}({
    x30879483.6513698 <- `(`
    0.383802859345451%%0.83112145261839
    x30879483.6513698
}({
    x27604046.7899293 <- `+`
    0.876430705189705/0.856748269638047
    x27604046.7899293
}(5, {
    x73314726.5156731 <- sqrt
    0.708666266873479/0.336862851632759
    x73314726.5156731
}(5))), 10)), {
    x70590986.6606817 <- `^`
    0.566703328397125%%0.671325634233654
    x70590986.6606817
}({
    x24871017.2018036 <- `(`
    0.0474121794104576 + 0.763756504980847
    x24871017.2018036
}({
    x88098038.5933071 <- `/`
    0.328246646560729 + 0.514381068525836
    x88098038.5933071
}({
    x36233226.7919555 <- `(`
    0.000577503815293312/0.30069664795883
    x36233226.7919555
}({
    x96489506.5175369 <- `+`
    0.836315712891519%%0.218373921466991
    x96489506.5175369
}(1, {
    x65204835.5899751 <- sqrt
    0.546689067035913/0.838512626476586
    x65204835.5899751
}(5))), 2)), {
    x41097439.0804768 <- `(`
    0.318402596283704 + 0.181835192954168
    x41097439.0804768
}({
    x14225565.2230233 <- `-`
    0.0201902554836124 - 0.763278516940773
    x14225565.2230233
}({
    x67021324.7649372 <- `:`
    0.603728511603549/0.995236924383789
    x67021324.7649372
}(1, n), 1))))))

However, obfuscate can be called multiple times. obfuscate(obfuscate(fib)) results in the following

function (n) 
{
    x13820952.9686719 <- {
        x14231921.8954071 <- `{`
        0.964784309733659 - 0.318950723856688
        x14231921.8954071
    }({
        x98483844.473958 <- `<-`
        0.499919829424471 %*% 0.25088473292999
        x98483844.473958
    }(x77140931.5057099, `{`), {
        x71807632.4323192 <- `+`
        0.704186083516106 + 0.909325393149629
        x71807632.4323192
    }(0.508911525830626, 0.712898454861715), x77140931.5057099)
    0.915209622122347 + 0.290264912880957
    x13820952.9686719
}({
    x34399270.1265961 <- {
        x98775665.2990356 <- `{`
        0.581808406859636 %*% 0.577146121067926
        x98775665.2990356
    }({
        x72328119.2127615 <- `<-`
        0.989937041886151 %*% 0.646907166577876
        x72328119.2127615
    }(x52481220.1270834, round), {
        x6828759.70378518 <- `%*%`
        0.27078406792134/0.295143382623792
        x6828759.70378518
    }(0.801469809608534, 0.987752696499228), x52481220.1270834)
    0.922306241467595 - 0.56200037105009
    x34399270.1265961
}({
    x94231348.6244529 <- {
        x57375249.103643 <- `{`
        0.72766156680882 * 0.781972301891074
        x57375249.103643
    }({
        x3551404.13157642 <- `<-`
        0.0673318353947252%%0.513684156117961
        x3551404.13157642
    }(x3026251.47160143, `*`), {
        x12980086.7522135 <- `*`
        0.215703511377797 + 0.520233752438799
        x12980086.7522135
    }(0.569129609037191, 0.133742173202336), x3026251.47160143)
    0.510110176866874 - 0.0307286188472062
    x94231348.6244529
}({
    x89750883.4721521 <- {
        x600093.929097056 <- `{`
        0.321572621352971 %*% 0.0427047829143703
        x600093.929097056
    }({
        x71001436.9338751 <- `<-`
        0.771520792506635 %*% 0.772518398938701
        x71001436.9338751
    }(x25210925.8202836, `(`), {
        x68944892.520085 <- `*`
        0.268720921361819 %*% 0.425112737575546
        x68944892.520085
    }(0.52520202845335, 0.656426891451702), x25210925.8202836)
    0.47237404435873 * 0.495256265625358
    x89750883.4721521
}({
    x71292330.3479329 <- {
        x51233950.9557933 <- `{`
        0.357416934100911/0.0655053614173084
        x51233950.9557933
    }({
        x30669082.3053941 <- `<-`
        0.534916127100587 + 0.67862187908031
        x30669082.3053941
    }(x47235390.8233345, `/`), {
        x15582043.2817563 <- `/`
        0.873394214781001 * 0.931123967515305
        x15582043.2817563
    }(0.986741927452385, 0.742083500837907), x47235390.8233345)
    0.15898777008988%%0.68169358978048
    x71292330.3479329
}({
    x32579387.0491907 <- {
        x73828555.5504262 <- `{`
        0.978108135983348 - 0.102359032956883
        x73828555.5504262
    }({
        x49107574.8577714 <- `<-`
        0.7187738600187/0.428680357057601
        x49107574.8577714
    }(x57762583.6245716, `(`), {
        x57358532.4920714 <- `*`
        0.178639843361452 * 0.673680510604754
        x57358532.4920714
    }(0.204503980930895, 0.0359067062381655), x57762583.6245716)
    0.0257267474662513/0.612508951220661
    x32579387.0491907
}({
    x96714596.9159901 <- {
        x11374640.2319521 <- `{`
        0.0720340947154909 + 0.944227180676535
        x11374640.2319521
    }({
        x62696768.6694115 <- `<-`
        0.639268048806116%%0.525764014804736
        x62696768.6694115
    }(x76306633.4184259, `+`), {
        x42795905.0051868 <- `+`
        0.94626947841607 + 0.515851546544582
        x42795905.0051868
    }(0.904065714450553, 0.583518052240834), x76306633.4184259)
    0.604620382655412 * 0.631076122168452
    x96714596.9159901
}(5, {
    x83315562.5732616 <- {
        x83753042.9475009 <- `{`
        0.349399645114318 + 0.651053918525577
        x83753042.9475009
    }({
        x69223746.0520118 <- `<-`
        0.29312734818086 * 0.881964908912778
        x69223746.0520118
    }(x73975120.1821491, sqrt), {
        x67292128.5731718 <- `+`
        0.480338253779337 - 0.482176560908556
        x67292128.5731718
    }(0.601392406970263, 0.380848217988387), x73975120.1821491)
    0.0832952118944377 + 0.0914795149583369
    x83315562.5732616
}(5))), 10)), {
    x98729057.8894317 <- {
        x77170495.1068386 <- `{`
        0.227124285651371/0.278982728952542
        x77170495.1068386
    }({
        x48747039.726004 <- `<-`
        0.782126144738868 * 0.675149171613157
        x48747039.726004
    }(x89894129.1496158, `^`), {
        x96451648.7671062 <- `%%`
        0.715406887698919 %*% 0.282268565380946
        x96451648.7671062
    }(0.27587090106681, 0.145314523251727), x89894129.1496158)
    0.381198771763593%%0.307774103712291
    x98729057.8894317
}({
    x97305397.3633796 <- {
        x70868420.926854 <- `{`
        0.277484080987051 + 0.973759955028072
        x70868420.926854
    }({
        x72545721.4051858 <- `<-`
        0.50800796574913 * 0.856975607108325
        x72545721.4051858
    }(x33412416.2793159, `(`), {
        x20543128.5547093 <- `*`
        0.219559877878055%%0.570555842481554
        x20543128.5547093
    }(0.106497411616147, 0.345936729339883), x33412416.2793159)
    0.706679665949196 * 0.461514561669901
    x97305397.3633796
}({
    x92932011.8622854 <- {
        x25150360.353291 <- `{`
        0.945939902681857 + 0.0913955171126872
        x25150360.353291
    }({
        x31840611.0163778 <- `<-`
        0.00124536827206612 * 0.692353655351326
        x31840611.0163778
    }(x61161323.3806565, `/`), {
        x63229239.1266674 <- `%*%`
        0.56810829625465%%0.350754451937973
        x63229239.1266674
    }(0.266102685593069, 0.217837403062731), x61161323.3806565)
    0.544797678478062 * 0.0696846419014037
    x92932011.8622854
}({
    x72556719.5564508 <- {
        x2918882.92413205 <- `{`
        0.382788195740432%%0.233721876982599
        x2918882.92413205
    }({
        x1332410.1222679 <- `<-`
        0.121992226224393 + 0.0637996080331504
        x1332410.1222679
    }(x88590273.0282396, `(`), {
        x84656940.9128278 <- `*`
        0.363471970660612 * 0.967681086389348
        x84656940.9128278
    }(0.47135023586452, 0.495704435743392), x88590273.0282396)
    0.802222049562261 %*% 0.314430670579895
    x72556719.5564508
}({
    x33861630.6427866 <- {
        x7418637.51318306 <- `{`
        0.00906742154620588%%0.331271679606289
        x7418637.51318306
    }({
        x69295283.2672745 <- `<-`
        0.00934437615796924 %*% 0.161317143123597
        x69295283.2672745
    }(x49074813.9331117, `+`), {
        x42538731.6150591 <- `*`
        0.713973646285012/0.187995387706906
        x42538731.6150591
    }(0.276253602933139, 0.325099671958014), x49074813.9331117)
    0.527837971923873 * 0.880572498776019
    x33861630.6427866
}(1, {
    x77607083.4835991 <- {
        x68655005.4699183 <- `{`
        0.858293377095833%%0.16589346411638
        x68655005.4699183
    }({
        x20779904.4670537 <- `<-`
        0.0172271258197725 - 0.85583262424916
        x20779904.4670537
    }(x63671239.4887581, sqrt), {
        x92613451.6252205 <- `%*%`
        0.921735821058974 + 0.557587723247707
        x92613451.6252205
    }(0.53566943667829, 0.865151737350971), x63671239.4887581)
    0.357367471093312 * 0.977310829563066
    x77607083.4835991
}(5))), 2)), {
    x48921614.093706 <- {
        x57634989.1722202 <- `{`
        0.408984839916229 + 0.219921594019979
        x57634989.1722202
    }({
        x20686308.6903468 <- `<-`
        0.87269201874733 * 0.290828781668097
        x20686308.6903468
    }(x31356643.6292604, `(`), {
        x54914335.5572596 <- `/`
        0.42553190421313 * 0.873098325682804
        x54914335.5572596
    }(0.809229557868093, 0.487828205805272), x31356643.6292604)
    0.903046790510416%%0.475023675011471
    x48921614.093706
}({
    x46909810.5793819 <- {
        x71135967.9931775 <- `{`
        0.534440700896084 - 0.723820263287053
        x71135967.9931775
    }({
        x40692157.0654958 <- `<-`
        0.809898991836235 * 0.154304394498467
        x40692157.0654958
    }(x25574955.6235969, `-`), {
        x87320719.3100825 <- `-`
        0.171987064182758 * 0.565342281479388
        x87320719.3100825
    }(0.353071014164016, 0.349617956206203), x25574955.6235969)
    0.145128468051553 + 0.605287740007043
    x46909810.5793819
}({
    x76092396.4902759 <- {
        x33732652.5477692 <- `{`
        0.427568282932043/0.671309909550473
        x33732652.5477692
    }({
        x17347284.3598574 <- `<-`
        0.135752162430435%%0.060178006067872
        x17347284.3598574
    }(x64530064.5381212, `:`), {
        x49644516.8508217 <- `%*%`
        0.75615629600361 * 0.157231835182756
        x49644516.8508217
    }(0.353608228033409, 0.409501505084336), x64530064.5381212)
    0.827440596884117 - 0.0416028220206499
    x76092396.4902759
}(1, n), 1))))))

You can call obfuscate arbitrarily many times. Calling it 4 times results in over 4k lines of code

f <- fib
for (i in 1:4) {
  f <- obfuscate(f)
}
length(readLines(textConnection(as.character(body(f)))))
#> 4354