knitr-is_html_output

Here are the examples of the r api knitr-is_html_output taken from open source projects. By voting up you can indicate which examples are most useful and appropriate.

6 Examples 7

 check_hint  < - function(hint_text, hint_title = "Click here to see/close the hint",  

     hint_id = sample(1e+05:1, 1)) { 

     if (knitr::is_html_output()) { 

         if (grepl("\\.", hint_id)) { 

             hint_id  < - gsub("\\.", "_", hint_id) 

         } 

         hint_text  < - (markdown::markdownToHTML(text = hint_text,  

             output = NULL, fragment.only = TRUE)) 

         hint_text  < - gsub("( < .?p>)|(\n)|(\\#)", "", hint_text) 

         hint_title  < - as.character(hint_title) 

         hint_title  < - (markdown::markdownToHTML(text = hint_title,  

             output = NULL, fragment.only = TRUE)) 

         hint_title  < - gsub("( < .?p>)|(\n)|(\\#)", "", hint_title) 

         cat(paste0(c(" < p id=\"hint_", hint_id, "\", onclick=\"return show_hint_",  

             hint_id, "()\">", hint_title, " < /p> < p id=\"result_",  

             hint_id, "\"> < /p>", " < script> function show_hint_",  

             hint_id, "() {", "var x = document.getElementById(\"result_",  

             hint_id, "\").innerHTML;", "if(!x){document.getElementById('result_",  

             hint_id, "').innerHTML = '", hint_text, "';}", "else {document.getElementById(\"result_",  

             hint_id, "\").innerHTML = \"\";}}", " < /script>"),  

             collapse = "")) 

     } 

 } 

 check_hints  < - function(hint_text, hint_title = "Click here to see/close the hint",  

     hint_title_prefix = "", hint_title_suffix = "", list_title = "Click here to see/close the list of hints",  

     hint_id) { 

     if (knitr::is_html_output()) { 

         hint_title  < - paste0(hint_title_prefix, hint_title, hint_title_suffix) 

         df  < - data.frame(hint_text, hint_title, stringsAsFactors = FALSE) 

         df$hint_id  < - sample(1:1e+05, nrow(df)) 

         df$hint_text  < - unlist(lapply(seq_along(df$hint_text),  

             function(i) { 

                 x  < - as.character(df$hint_text[i]) 

                 x  < - (markdown::markdownToHTML(text = x, output = NULL,  

                   fragment.only = TRUE)) 

                 x  < - gsub("( < .?p>)|(\n)|(\\#)", "", x) 

                 x 

             })) 

         df$hint_title  < - unlist(lapply(seq_along(df$hint_title),  

             function(i) { 

                 x  < - as.character(df$hint_title[i]) 

                 x  < - (markdown::markdownToHTML(text = x, output = NULL,  

                   fragment.only = TRUE)) 

                 x  < - gsub("( < .?p>)|(\n)|(\\#)", "", x) 

                 x 

             })) 

         list_title  < - (markdown::markdownToHTML(text = list_title,  

             output = NULL, fragment.only = TRUE)) 

         list_title  < - gsub("( < .?p>)|(\n)|(\\#)", "", list_title) 

         hints  < - paste0(" < p id=\"hint_", df$hint_id, "\", onclick=\"return show_hint_",  

             df$hint_id, "()\">", df$hint_title, " < /p> < p id=\"result_",  

             df$hint_id, "\"> < /p>", collapse = "") 

         id  < - sample(2e+05:1e+05, 1) 

         cat(paste0(c(" < p id=\"hint_", id, "\", onclick=\"return show_hint_",  

             id, "()\">", list_title, " < /p> < p id=\"result_", id,  

             "\"> < /p>", " < script> function show_hint_", id, "() {",  

             "var x = document.getElementById(\"result_", id,  

             "\").innerHTML;", "if(!x){document.getElementById('result_",  

             id, "').innerHTML = '", hints, "';}", "else {document.getElementById(\"result_",  

             id, "\").innerHTML = \"\";}}", paste0("function show_hint_",  

                 df$hint_id, "() {", "var x = document.getElementById(\"result_",  

                 df$hint_id, "\").innerHTML;", "if(!x){document.getElementById('result_",  

                 df$hint_id, "').innerHTML = '", df$hint_text,  

                 "';}", "else {document.getElementById(\"result_",  

                 df$hint_id, "\").innerHTML = \"\";}}", collapse = ""),  

             " < /script>"), collapse = "")) 

     } 

 } 

 check_question  < - function(answer, right = "Correct", wrong = "I have a different answer",  

     options = NULL, type = "select", alignment = FALSE, button_label = "check",  

     random_answer_order = FALSE, question_id = sample(1:1e+05,  

         1)) { 

     if (knitr::is_html_output()) { 

         if (grepl("\\.", question_id)) { 

             question_id  < - gsub("\\.", "_", question_id) 

         } 

         right  < - (markdown::markdownToHTML(text = right, output = NULL,  

             fragment.only = TRUE)) 

         right  < - gsub("( < .?p>)|(\n)|(\\#)", "", right) 

         wrong  < - (markdown::markdownToHTML(text = wrong, output = NULL,  

             fragment.only = TRUE)) 

         wrong  < - gsub("( < .?p>)|(\n)|(\\#)", "", wrong) 

         options  < - if (random_answer_order) { 

             sample(options) 

         } 

         else { 

             options 

         } 

         options_value  < - if (TRUE %in% grepl("^ < img src=", options)) { 

             seq_along(options) 

         } 

         else { 

             options 

         } 

         alignment  < - ifelse(alignment, " ", " < br>") 

         answer  < - if (!is.null(answer))  

             as.character(answer) 

         if (TRUE %in% grepl("^ < img src=", options) & type ==  

             "select") { 

             stop("It is imposible to use images with type = \"select\". Please use type = \"radio\" or type = \"checkbox\"") 

         } 

         if (is.null(options)) { 

             form  < - paste(c(" < input type=\"text\" name=\"answer_",  

                 question_id, "\">"), collapse = "") 

         } 

         else if (type == "select") { 

             form  < - paste(c(" < select name=\"answer_", question_id,  

                 "\">", paste(" < option>", options, " < /option>"),  

                 " < /select>"), collapse = "") 

         } 

         else if (type == "radio") { 

             form  < - paste0(" < input type=\"radio\" name=\"answer_",  

                 question_id, "\" id=\"", question_id, "_", seq_along(options),  

                 "\" value=\"", options_value, "\"> < label for=\"",  

                 seq_along(options), "\">", options, " < /label>",  

                 alignment, collapse = "") 

         } 

         else if (type == "checkbox") { 

             form  < - paste0(" < input type=\"checkbox\" id=\"answer_",  

                 question_id, "_", seq_along(options), "\" value=\"",  

                 options_value, "\"> < label for=\"answer_", question_id,  

                 "_", seq_along(options), "\">", options, " < /label>",  

                 alignment, collapse = "") 

         } 

         else { 

             stop("Possible values for the type variable: 'select', 'radio' or 'checkbox'") 

         } 

         form  < - gsub(x = form, pattern = " < br>$", replacement = "") 

         cat(paste0(c(" < form name=\"form_", question_id, "\" onsubmit=\"return validate_form_",  

             question_id, "()\" method=\"post\">", form, " < br>",  

             if (!is.null(answer)) { 

                 c(" < input type=\"submit\" value=\"", button_label,  

                   "\"> < /form> < p id=\"result_", question_id, "\"> < /p>") 

             }), collapse = "")) 

         if (type != "checkbox") { 

             cat(paste(" < script>", paste("function validate_form_",  

                 question_id, "() {var x, text; var x = document.forms[\"form_",  

                 question_id, "\"][\"answer_", question_id, "\"].value;",  

                 "if (", paste0("x == \"", answer, "\"", collapse = "|"),  

                 "){", "text = '", right, "';", "} else {", "text = '",  

                 wrong, "';} document.getElementById('result_",  

                 question_id, "').innerHTML = text; return false;}",  

                 sep = "", collapse = "\n"), " < /script>", collapse = "\n")) 

         } 

         else { 

             cat(paste0(" < script> ", "function validate_form_",  

                 question_id, "() {", "var text;", paste0("var x",  

                   seq_along(options), " = document.getElementById(\"",  

                   "answer_", question_id, "_", seq_along(options),  

                   "\");", collapse = ""), "if (", paste0("x",  

                   seq_along(options), ".checked == ", tolower(options_value %in%  

                     answer), collapse = "&"), "){text = \"",  

                 right, "\";} else {text = \"", wrong, "\";} document.getElementById(\"result_",  

                 question_id, "\").innerHTML = text; return false;}",  

                 " < /script>")) 

         } 

     } 

 } 

 ruby  < - function(word, ruby) { 

     if (knitr::is_html_output()) { 

         paste0("` < ruby>", word, " < rp>( < /rp> < rt>", ruby, " < /rt> < rp>) < /rp> < /ruby>`{=html}") 

     } 

     else if (knitr::is_latex_output()) { 

         paste0("`\\ruby[g]{", word, "}{", ruby, "}`{=latex}") 

     } 

     else { 

         paste0(word, " (", ruby, ")") 

     } 

 } 

 tts_speak_engine = function(options) { 

     if (!options$eval) { 

         return(knitr::engine_output(options, options$code, "")) 

     } 

     output_format = options$output_format 

     service = options$service 

     voice = options$voice 

     if (is.null(service)) { 

         service = "google" 

     } 

     if (is.null(voice)) { 

         voice = tts_default_voice(service = service) 

     } 

     if (is.null(output_format)) { 

         output_format = "mp3" 

     } 

     out_path = dirname(options$fig.path) 

     dir.create(out_path, showWarnings = FALSE, recursive = TRUE) 

     output = file.path(out_path, paste0(options$label, ".", output_format)) 

     if (!file.exists(output)) { 

         options$cache = FALSE 

     } 

     key_or_json_file = options$key_or_json_file 

     if (!is.null(key_or_json_file)) { 

         text2speech::tts_auth(service = service, key_or_json_file = key_or_json_file) 

     } 

     text = paste0(options$code, collapse = " ") 

     result = text2speech::tts(text = text, output_format = output_format,  

         service = service, voice = voice) 

     file.copy(result$file, output, overwrite = TRUE) 

     out = utils::capture.output(output) 

     if (knitr::is_html_output()) { 

         if (options$results != "hide") { 

             options$results = "asis" 

             out = c(" < audio controls>", paste0(" < source src=\"",  

                 output, "\">"), " < /audio>", "") 

         } 

         else { 

             out = "" 

         } 

     } 

     print(out) 

     knitr::engine_output(options, options$code, out) 

 } 

 knit_print.psGrid  < - function(x, header = TRUE, footer = TRUE,  

     aspect_ratio_cards = 85/54, inline = FALSE, ...) { 

     if (is.null(colnames(x))) { 

         colnames(x)  < - make_pos_names(max_pos = ncol(x)) 

     } 

     if (is.null(rownames(x))) { 

         rownames(x)  < - LETTERS[1:nrow(x)] 

     } 

     if (!is.null(attr(x = x, which = "offset"))) { 

         stop("Sorry, do not know how to print non-square tiled grids.\n         If you need this feature, contact the package author.") 

     } 

     if (inline) { 

         NextMethod() 

     } 

     else { 

         if (knitr::is_html_output()) { 

             res  < - inanimatus(grid = x, header = header, footer = footer,  

                 aspect_ratio_cards = aspect_ratio_cards) 

             knit_print(res, ...) 

         } 

         else { 

             NextMethod() 

         } 

     } 

 } 

Categories r Tags