import httpclient, strutils, xmltree, xmlparser, cgi

proc count(s, sub: string): int =
  var i = 0
  while true:
    i = s.find(sub, i)
    if i < 0: break
    inc i
    inc result

const
  mainSite = "http://www.rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
  subSite = "http://www.rosettacode.org/mw/index.php?title=$#&action=raw"

var client = newHttpClient()
var sum = 0
for node in client.getContent(mainSite).parseXml().findAll("cm"):
  let t = node.attr("title").replace(" ", "_")
  let c = client.getContent(subSite % encodeUrl(t)).toLower().count("{{header|")
  echo t.replace("_", " "), ": ", c, " examples."
  inc sum, c

echo "\nTotal: ", sum, " examples."


use HTTP;
use XML;

class RosettaCount {
  function : Main(args : String[]) ~ Nil {
    taks_xml := HttpGet("http://rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml");
    parser := XmlParser->New(taks_xml);
    if(parser->Parse()) {
      task_names := parser->FindElements("/api/query/categorymembers/cm");
      if(task_names <> Nil) {
        each(i : task_names) {
          task_name := task_names->Get(i)->As(XmlElement)->GetAttribute("title")->GetValue();
          task_url := "http://rosettacode.org/mw/index.php?title=";
          task_url->Append(task_name);
          task_url->Append("&action=raw");

          task := HttpGet(task_url);
          counts := task->FindAll("=={{header|");
          if(counts->Size() > 0) {
            IO.Console->Print(UrlUtility->Decode(task_name))->Print(": ")->PrintLine(counts->Size());
          };
        };
      };
    };
  }

  function : HttpGet(url : String) ~ String {
    xml := "";

    client := HttpClient->New();
    lines := client->Get(url);
    each(i : lines) {
      xml->Append(lines->Get(i)->As(String));
    };

    return xml;
  }
}


ocaml str.cma unix.cma  -I +pcre pcre.cma  -I +netsys netsys.cma  -I +equeue equeue.cma \
  -I +netstring netstring.cma  -I +netclient netclient.cma  -I +xml-light xml-light.cma  countex.ml


declare
  [HTTPClient] = {Module.link ['x-ozlib://mesaros/net/HTTPClient.ozf']}
  [XMLParser] = {Module.link ['x-oz://system/xml/Parser.ozf']}
  [StringX] = {Module.link ['x-oz://system/String.ozf']}
  [Regex] = {Module.link ['x-oz://contrib/regex']}

  AllTasksUrl = "http://rosettacode.org/mw/api.php?action=query&list="#
  "categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"

  proc {Main}
     AllTasks = {Parse {GetPage AllTasksUrl}}
     TaskTitles = {GetTitles AllTasks}
     Total = {NewCell 0}
  in
     for Task in TaskTitles do
        TaskPage = {GetPage {TaskUrl Task}}
        RE = {Regex.compile "{{header\\|" [extended newline icase]}
        NumMatches = {Length {Regex.allMatches RE TaskPage}}
     in
        {System.showInfo Task#": "#NumMatches#" examples."}
        Total := @Total + NumMatches
     end
     {System.showInfo "Total: "#@Total#" examples."}
  end

  fun {TaskUrl Task}
     "http://rosettacode.org/mw/index.php?"#
     "title="#{PercentEncode {StringX.replace Task " " "_"}}#
     "&action=raw"
  end

  %% GetPage
  local
     Client = {New HTTPClient.urlGET init(inPrms(toFile:false toStrm:true) _)}
  in
     fun {GetPage RawUrl}
        Url = {VirtualString.toString RawUrl}
        OutParams
        HttpResponseParams
     in
        {Client getService(Url ?OutParams ?HttpResponseParams)}
        OutParams.sOut
     end
  end

  %% Parse
  local
     Parser = {New XMLParser.parser init}
  in
     fun {Parse Xs} {Parser parseVS(Xs $)} end
  end

  fun {GetTitles Doc}
     CMs = Doc.2.1.children.1.children.1.children
     fun {Attributes element(attributes:As ...)} As end
     fun {IsTitle attribute(name:N ...)} N == title end
  in
     {Map {Filter {Flatten {Map CMs Attributes}} IsTitle}
      fun {$ A} {Atom.toString A.value} end}
  end

  fun {PercentEncode Xs}
     case Xs of nil then nil
     [] X|Xr then
        if {Char.isDigit X} orelse {Member X [&- &_ &.  &~]}
           orelse X >= &a andthen X =< &z
           orelse X >= &z andthen X =< &Z then
           X|{PercentEncode Xr}
        else
           {Append &%|{ToHex2 X} {PercentEncode Xr}}
        end
     end
  end

  fun {ToHex2 X}
     [{ToHex1 X div 16} {ToHex1 X mod 16}]
  end

  fun {ToHex1 X}
     if X >= 0 andthen X =< 9 then &0 + X
     elseif X >= 10 andthen X =< 15 then &A + X - 10
     end
  end
in
  {Main}


use HTTP::Tiny;

my $site = "http://rosettacode.org";
my $list_url = "/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml";

my $response = HTTP::Tiny->new->get("$site$list_url");
for ($response->{content} =~ /cm.*?title="(.*?)"/g) {
    (my $slug = $_) =~ tr/ /_/;
    my $response = HTTP::Tiny->new->get("$site/wiki/$slug");
    my $count = () = $response->{content} =~ /toclevel-1/g;
    print "$_: $count examples\n";
}


--
-- demo\rosetta\rosettacode_cache.e
-- ================================
--
-- Common routines for handling rc_cache etc.
--
without js -- (libcurl, file i/o, peek, progress..)
include builtins\timedate.e
constant day = timedelta(days:=1)
integer refresh_cache = 21*day -- 0 for always [NB refresh_cache += timedelta(days:=1) below]

function days(atom delta)
    integer d = ceil(delta/day)
    return sprintf("%d day%s",{d,iff(d=1?"":"s")})
end function

constant {hex,ascii} = columnize({{"%22",`"`},
                                  {"%27","'"},
                                  {"%2A","*"},
                                  {"%2B","+"},
                                  {"%3A",":"},
                                  {"%5E",`^`},
                                  {"%E2%80%93","-"},
                                  {"%E2%80%99","'"},
                                  {"%C3%A8","e"},
                                  {"%C3%A9","e"},
                                  {"%C3%B6","o"},
                                  {"%C5%91","o"},
                                  {""",`"`},
                                  {"'","'"},
                                  {"_"," "}})

global function html_clean(string s)
    return substitute_all(s,hex,ascii)
end function

include builtins\libcurl.e
atom curl = NULL, pErrorBuffer

function write_callback(atom pData, integer size, nmemb, fn)
    integer bytes_written = size * nmemb
    puts(fn,peek({pData,bytes_written}))
    return bytes_written
end function
constant write_cb = call_back({'+', write_callback})

global string wastitle = "" -- don't clobber "NEED EDITING"/Downloading messages
global integer show_title = progress

global function open_download(string filename, url, integer i=0, n=0)
    object text
    bool refetch = false
    string why = "not found"
    filename = join_path({"rc_cache",filename})
    if file_exists(filename) then
        -- use existing file if <= refresh_cache days old
        sequence last_mod = get_file_date(filename)
        atom delta = timedate_diff(last_mod,date())
        refetch = true
        if delta>refresh_cache
        and not match(".hist",filename) then
            why = days(delta) & " > " & days(refresh_cache)
        elsif get_file_size(filename)=0 then
            why = "filesize of 0"
        else
            text = trim(get_text(filename))
            if not sequence(text) then
                why = "no text"
            elsif length(text)<10 then
                why = "<10 bytes"
            else
                refetch = false
            end if
        end if
    else
        refetch = true
        string directory = get_file_path(filename)
        if get_file_type(directory)!=FILETYPE_DIRECTORY then
            if not create_directory(directory,make_parent:=true) then
                crash("cannot create %s directory",{directory})
            end if
        end if
    end if
    if refetch then
        wastitle = "x" -- don't clobber
        string nofn = iff(n?sprintf("(%d/%d, %.1f%%) ",{i,n,i/n*100}):""),
               title = sprintf("Downloading %s%s (%s)...",{nofn,html_clean(filename),why})
        show_title(title)
        if curl=NULL then
            curl_global_init()
            curl = curl_easy_init()
            pErrorBuffer = allocate(CURL_ERROR_SIZE)
            curl_easy_setopt(curl, CURLOPT_ERRORBUFFER, pErrorBuffer)
            curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_cb)
        end if
        url = substitute(url,"%3A",":")
        url = substitute(url,"%2A","*")
        curl_easy_setopt(curl, CURLOPT_URL, url)
        integer fn = open(filename,"wb")
        assert(fn!=-1,"cannot open "&filename)
        curl_easy_setopt(curl, CURLOPT_WRITEDATA, fn)
        while true do
            CURLcode res = curl_easy_perform(curl)
            if res=CURLE_OK then exit end if
            string error = sprintf("%d",res)
            if res=CURLE_COULDNT_RESOLVE_HOST then
                error &= " [CURLE_COULDNT_RESOLVE_HOST]"
            end if
            progress("Error %s downloading file, retry?(Y/N):",{error})
            if lower(wait_key())!='y' then abort(0) end if
            printf(1,"Y\n")
        end while
        close(fn)
        refresh_cache += timedelta(days:=1) -- did I mention it is slow?
        text = get_text(filename)
    end if
    return text
end function

global function open_category(string filename, integer i=0, n=0)
    return open_download(filename&".htm","http://rosettacode.org/wiki/Category:"&filename,i,n)
end function

global function dewiki(string s, sequence exclude={})
    -- extract tasks from eg `<li><a href="/wiki/100_doors"`
    sequence tasks = {}
    integer start = 1, finish = match(`<div class="printfooter">`,s)
    s = s[1..finish-1]
    while true do
        start = match(`<li><a href="/wiki/`,s,start)
        if start=0 then exit end if
        start += length(`<li><a href="/wiki/`)
        finish = find('"',s,start)
        string task = s[start..finish-1]
        task = substitute_all(task,{"*",":"},{"%2A","%3A"})
        tasks = append(tasks,task)
        start = finish+1
    end while
    return tasks
end function

global procedure curl_cleanup()
    if curl!=NULL then
        curl_easy_cleanup(curl)
        free(pErrorBuffer)
        curl = NULL
        pErrorBuffer = NULL
    end if
end procedure


(load "@lib/http.l")

(client "rosettacode.org" 80
   "mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
   (while (from " title=\"")
      (let Task (till "\"")
         (client "rosettacode.org" 80 (pack "wiki/" (replace Task " " "_"))
            (let Cnt 0
               (while (from "<span class=\"tocnumber\">")
                  (unless (sub? "." (till "<" T))
                     (inc 'Cnt) ) )
               (out NIL (prinl (ht:Pack Task) ": " Cnt)) ) ) ) ) )


Procedure handleError(value, msg.s)
  If value = 0
    MessageRequester("Error", msg)
    End
  EndIf
EndProcedure

handleError(InitNetwork(), "Unable to initialize network functions.")
If OpenConsole()
  Define url$, x1$, y1$, title$, unescapedTitle$, encodedURL$
  Define x2, i, j, totalExamples, totalTasks
  url$ = "http://www.rosettacode.org/mw/api.php?action=query" +
         "&list=categorymembers&cmtitle=Category:Programming_Tasks" +
         "&cmlimit=500&format=xml"

  Repeat
    handleError(ReceiveHTTPFile(url$, "tasks.xml"), "Unable to access tasks URL.")

    handleError(ReadFile(0, "tasks.xml"), "Unable to read 'task.xml' file.")
    x1$ =  ReadString(0)
    CloseFile(0)

    Repeat
      x2 = FindString(x1$, "title=", x2 + 1)
      If x2
        title$ = Mid(x1$, x2 + 7, 99)
        title$ = Left(title$, FindString(title$, ">", 1) - 4)
        unescapedTitle$ = UnescapeString(ReplaceString(title$, "'", "'"), #PB_String_EscapeXML)
        encodedURL$ = URLEncoder("http://www.rosettacode.org/mw/index.php?title=" + unescapedTitle$ + "&action=raw")
        If ReceiveHTTPFile(encodedURL$, "task.xml")
          ReadFile(0, "task.xml")
          While Not Eof(0)
            y1$ =  ReadString(0)
            If FindString(y1$, "=={{header|", 1, #PB_String_NoCase)
              totalExamples + 1
            EndIf
          Wend
          CloseFile(0)

          PrintN(unescapedTitle$ +": " + Str(totalExamples) + " examples")

          totalTasks + totalExamples
          totalExamples = 0
        EndIf
      EndIf
    Until x2 = 0

    ;check for additional pages of tasks
    x2 = FindString(x1$, "cmcontinue=")
    If x2
      i = FindString(x1$, #DQUOTE$, x2 + 1)
      j = FindString(x1$, #DQUOTE$, i + 1)
      url$ = URLEncoder("http://www.rosettacode.org/mw/api.php?action=query" +
                        "&list=categorymembers&cmtitle=Category:Programming_Tasks" +
                        "&cmlimit=500&format=xml&cmcontinue=" + Mid(x1$, i + 1, j - i))
    Else
      Break ;all done
    EndIf
  ForEver

  PrintN("Total: " + Str(totalTasks) + " examples")
  Input()
  CloseConsole()
EndIf


from urllib.request import urlopen, Request
import xml.dom.minidom

r = Request(
 'https://www.rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml',
 headers={'User-Agent': 'Mozilla/5.0'})
x = urlopen(r)

tasks = []
for i in xml.dom.minidom.parseString(x.read()).getElementsByTagName('cm'):
    t = i.getAttribute('title').replace(' ', '_')
    r = Request(f'https://www.rosettacode.org/mw/index.php?title={t}&action=raw',
         headers={'User-Agent': 'Mozilla/5.0'})
    y = urlopen(r)
    tasks.append( y.read().lower().count(b'{{header|') )
    print(t.replace('_', ' ') + f': {tasks[-1]} examples.')

print(f'\nTotal: {sum(tasks)} examples.')


library(XML)
library(RCurl)
doc <- xmlInternalTreeParse("http://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml")
nodes <- getNodeSet(doc,"//cm")
titles = as.character( sapply(nodes, xmlGetAttr, "title") )
headers <- list()
counts <- list()
for (i in 1:length(titles)){
	headers[[i]] <- getURL( paste("http://rosettacode.org/mw/index.php?title=", gsub(" ", "_", titles[i]), "&action=raw", sep="") )
	counts[[i]] <- strsplit(headers[[i]],split=" ")[[1]]
	counts[[i]] <- grep("\\{\\{header", counts[[i]])
	cat(titles[i], ":", length(counts[[i]]), "examples\n")
}
cat("Total: ", length(unlist(counts)), "examples\n")


#lang racket

(require net/url net/uri-codec json (only-in racket/dict [dict-ref ref]))

(define (RC-get verb params)
  ((compose1 get-pure-port string->url format)
   "http://rosettacode.org/mw/~a.php?~a" verb (alist->form-urlencoded params)))

(define (get-category catname)
  (let loop ([c #f])
    (define t
      ((compose1 read-json RC-get) 'api
       `([action . "query"] [format . "json"]
         [list . "categorymembers"] [cmtitle . ,(format "Category:~a" catname)]
         [cmcontinue . ,(and c (ref c 'cmcontinue))] [cmlimit . "500"])))
    (define (c-m key) (ref (ref t key '()) 'categorymembers #f))
    (append (for/list ([page (c-m 'query)]) (ref page 'title))
            (cond [(c-m 'query-continue) => loop] [else '()]))))

(printf "Total: ~a\n"
  (for/sum ([task (get-category 'Programming_Tasks)])
    (define s ((compose1 length regexp-match-positions*)
               #rx"=={{" (RC-get 'index `([action . "raw"] [title . ,task]))))
    (printf "~a: ~a\n" task s)
    s))


use HTTP::UserAgent;
use URI::Escape;
use JSON::Fast;
use Lingua::EN::Numbers :short;

unit sub MAIN ( Bool :nf(:$no-fetch) = False, :t(:$tier) = 1 );

# Friendlier descriptions for task categories
my %cat = (
    'Programming_Tasks' => 'Task',
    'Draft_Programming_Tasks' => 'Draft'
);

my $client = HTTP::UserAgent.new;
$client.timeout = 10;

my $url = 'http://rosettacode.org/mw';

my $hashfile  = './RC_Task_count.json';
my $tablefile = "./RC_Task_count-{$tier}.txt";

my %tasks;

my @places = <① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ⑩ ⑪ ⑫ ⑬ ⑭ ⑮ ⑯ ⑰ ⑱ ⑲ ⑳ ㉑ ㉒ ㉓ ㉔ ㉕
      ㉖ ㉗ ㉘ ㉙ ㉚ ㉛ ㉜ ㉝ ㉞ ㉟ ㊱ ㊲ ㊳ ㊴ ㊵ ㊶ ㊷ ㊸ ㊹ ㊺ ㊺ ㊻ ㊼ ㊽ ㊾ ㊿>;

# clear screen
run($*DISTRO.is-win ?? 'cls' !! 'clear') unless $no-fetch;

my %counts =
    mediawiki-query(
        $url, 'pages',
        :generator<categorymembers>,
        :gcmtitle<Category:Programming Languages>,
        :gcmlimit<350>,
        :rawcontinue(),
        :prop<categoryinfo>
    )
    .map({ .<title>.subst(/^'Category:'/, '') => .<categoryinfo><pages> || 0 });

my $per-tier = 10;

my $which = (^$per-tier) »+» $per-tier * ($tier - 1);

my @top-n = %counts.sort( {-.value, .key} )[|$which].map: *.key.trans(' ' => '_');

# dump a copy to STDOUT, mostly for debugging purposes
say "
{tc $tier.&ord-n} {$per-tier.&card} programming languages by number of task examples completed:";
say '    ', join ' ', .map( {("{(@places[|$which])[$_]} {@top-n[$_]}").fmt("%-15s")} ) for (^@top-n).batch(5);
say "
\n";

unless $no-fetch {

    note 'Retrieving task information...';

    mkdir('./pages') unless './pages'.IO.e;

    @top-n = %counts.sort( {-.value, .key} )[^@places].map: *.key.trans(' ' => '_');;

    for %cat.keys.sort -> $cat {
        mediawiki-query(
            $url, 'pages',
            :generator<categorymembers>,
            :gcmtitle("Category:$cat"),
            :gcmlimit<350>,
            :rawcontinue(),
            :prop<title>
        ).map({
            my $page;
            my $response;

            loop {
                $response = $client.get("{ $url }/index.php?title={ uri-escape .<title> }&action=raw");
                if $response.is-success {
                    $page = $response.content;
                    last;
                } else {
                    redo;
                }
            }

            "./pages/{ uri-escape .<title>.subst(/' '/, '_', :g) }".IO.spurt($page);
            my $lc = $page.lc.trans(' ' => '_');
            my $count = +$lc.comb(/ ^^'==' <-[\n=]>* '{{header|' <-[}]>+? '}}==' \h* $$ /);
            %tasks{.<title>} = {'cat' => %cat{$cat}, :$count};
            %tasks{.<title>}<top-n> = (^@top-n).map( {
                ($lc.contains("==\{\{header|{@top-n[$_].lc}}}") or
                 # Deal with 3 part headers - {{header|F_Sharp|F#}}, {{header|C_Sharp|C#}}, etc.
                 $lc.contains("==\{\{header|{@top-n[$_].lc}|")  or
                 # Icon and Unicon are their own special flowers
                 $lc.contains("}}_and_\{\{header|{@top-n[$_].lc}}}==") or
                 # Language1 / Language2 for shared entries (e.g. C / C++)
                 $lc.contains(rx/'}}''_'*'/''_'*'{{header|'$(@top-n[$_].lc)'}}=='/)) ??
                (@places[$_]) !!
                 # Check if the task was omitted
                 $lc.contains("\{\{omit_from|{@top-n[$_].lc}") ?? 'O' !!
                 # The task is neither done or omitted
                 ' '
            } ).join;
            print clear, 1 + $++, ' ', %cat{$cat}, ' ', .<title>;
        })
    }

    print clear;

    note "\nTask information saved to local file: {$hashfile.IO.absolute}";
    $hashfile.IO.spurt(%tasks.&to-json);

}

# Load information from local file
%tasks = $hashfile.IO.e ?? $hashfile.IO.slurp.&from-json !! ( );

@top-n = %counts.sort( {-.value, .key} )[|$which].map: *.key.trans(' ' => '_');

# Convert saved task info to a table
note "\nBuilding table...";
my $count    = +%tasks;
my $taskcnt  = +%tasks.grep: *.value.<cat> eq %cat<Programming_Tasks>;
my $draftcnt = $count - $taskcnt;
my $total    = sum %tasks{*}»<count>;

# Dump table to a file
my $out = open($tablefile, :w)  or die "$!\n";

$out.say: "
{tc $tier.&ord-n} {$per-tier.&card} programming languages by number of task examples completed:";
$out.say: '    ', join ' ', .map( {("{(@places[|$which])[$_]} {@top-n[$_]}").fmt("%-15s")} ) for (^@top-n).batch(5);
$out.say: "
\n\n
";

# Add table boilerplate and caption
$out.say:
    '{|class="wikitable sortable"', "\n",
    "|+ As of { DateTime.new(time) } :: Tasks: { $taskcnt } :: Draft Tasks:",
    "{ $draftcnt } :: Total Tasks: { $count } :: Total Examples: { $total }\n",
    "!Count!!Task!!{(@places[|$which]).join('!!')}"
;

# Sort tasks by count then add row
for %tasks.sort: { [-.value<count>, .key] } -> $task {
    $out.say:
      ( $task.value<cat> eq 'Draft'
        ?? "|- style=\"background-color: #ffc\"\n"
        !! "|-\n"
      ),
      "| { $task.value<count> }\n",
      ( $task.key ~~ /\d/
        ?? "|data-sort-value=\"{ $task.key.&naturally }\"| [[{uri-escape $task.key}|{$task.key}]]\n"
        !! "| [[{uri-escape $task.key}|{$task.key}]]\n"
      ),
      "|{ $task.value<top-n>.comb[|$which].join('||') }"
}

$out.say( "|}\n
" );
$out.close;

note "Table file saved as: {$tablefile.IO.absolute}";

sub mediawiki-query ($site, $type, *%query) {
    my $url = "$site/api.php?" ~ uri-query-string(
        :action<query>, :format<json>, :formatversion<2>, |%query);
    my $continue = '';

    gather loop {
        my $response = $client.get("$url&$continue");
        my $data = from-json($response.content);
        take $_ for $data.<query>.{$type}.values;
        $continue = uri-query-string |($data.<query-continue>{*}».hash.hash or last);
    }
}

sub uri-query-string (*%fields) { %fields.map({ "{.key}={uri-escape .value}" }).join("&") }

sub naturally ($a) { $a.lc.subst(/(\d+)/, ->$/ {0~(65+$0.chars).chr~$0},:g) }

sub clear { "\r" ~ ' ' x 116 ~ "\r" }


# Project: Rosetta Code/Count examples

load "stdlib.ring"
ros= download("http://rosettacode.org/wiki/Category:Programming_Tasks")
pos = 1
num = 0
totalros = 0
rosname = ""
rostitle = ""
for n = 1 to len(ros)
        nr = searchstring(ros,'
',sn)
       nr3 = searchstring(ros,"
",sn)
       rosname = substr(ros,nr2+2,nr3-nr2-2)
       return sn

func searchtitle(sn)
        st = searchstring(ros,"title=",sn)
        rostitle = substr(ros,sn+19,st-sn-21)
        rostitle = "rosettacode.org/wiki/" + rostitle
        rostitle = download(rostitle)
        sum = count(rostitle,"Edit section:")
        num = num + 1
        see "" + num + ". " + rosname + ": " + sum + " examples." + nl
        totalros = totalros + sum
        return sn

func count(cstring,dstring)
       sum = 0
       while substr(cstring,dstring) > 0
               sum = sum + 1
              cstring = substr(cstring,substr(cstring,dstring)+len(string(sum)))
       end
       return sum


require 'open-uri'
require 'rexml/document'

module RosettaCode

  URL_ROOT = "http://rosettacode.org/mw"

  def self.get_url(page, query)
    begin
      # Ruby 1.9.2
      pstr = URI.encode_www_form_component(page)
      qstr = URI.encode_www_form(query)
    rescue NoMethodError
      require 'cgi'
      pstr = CGI.escape(page)
      qstr = query.map {|k,v|
        "%s=%s" % [CGI.escape(k.to_s), CGI.escape(v.to_s)]}.join("&")
    end
    url = "#{URL_ROOT}/#{pstr}?#{qstr}"
    p url if $DEBUG
    url
  end

  def self.get_api_url(query)
    get_url "api.php", query
  end

  def self.category_members(category)
    query = {
      "action" => "query",
      "list" => "categorymembers",
      "cmtitle" => "Category:#{category}",
      "format" => "xml",
      "cmlimit" => 500,
    }
    while true
      url = get_api_url query
      doc = REXML::Document.new open(url)

      REXML::XPath.each(doc, "//cm") do |task|
        yield task.attribute("title").value
      end

      continue = REXML::XPath.first(doc, "//query-continue")
      break if continue.nil?
      cm = REXML::XPath.first(continue, "categorymembers")
      query["cmcontinue"] = cm.attribute("cmcontinue").value
    end
  end

end


html "

Num	Task	Examples
"

a$	= httpGet$("http://rosettacode.org/wiki/Category:Programming_Tasks")
a$	= word$(a$,1,"

")
i	= instr(a$,"<a href=""/wiki/")
i	= instr(a$," 0
  count	= count + 1
  i	= instr(a$,"",i+5)
  a1$	= mid$(a$,i+15,j-i)
  taskId$ = word$(a1$,1,"""")
  task$   = word$(a1$,3,"""")
  url$	= "http://rosettacode.org/wiki/";taskId$
  a2$	= httpGet$(url$)
  ii	= instr(a2$,"")
  jj	= 0
  while ii > 0
    jj	= ii
    ii	= instr(a2$,"",ii+10)
  wend
  if jj = 0 then
    examp = 0
   else
    kk	= instr(a2$,"<",jj+24)
    examp = int(val(mid$(a2$,jj+24,kk-jj-24)))
  end if
  html "
";count;"	";task$;"	";examp;"
"
  totExamp = totExamp + examp
wend
html "
**	** Total **	";totExamp;"

"
end


extern crate reqwest;
extern crate url;
extern crate rustc_serialize;

use std::io::Read;
use self::url::Url;
use rustc_serialize::json::{self, Json};

pub struct Task {
    page_id: u64,
    pub title: String,
}

#[derive(Debug)]
enum ParseError {
    /// Something went wrong with the HTTP request to the API.
    Http(reqwest::Error),

    /// There was a problem parsing the API response into JSON.
    Json(json::ParserError),

    /// Unexpected JSON format from response
    UnexpectedFormat,
}
impl From<json::ParserError> for ParseError {
    fn from(error: json::ParserError) -> Self {
        ParseError::Json(error)
    }
}

impl From<reqwest::Error> for ParseError {
    fn from(error: reqwest::Error) -> Self {
        ParseError::Http(error)
    }
}

fn construct_query_category(category: &str) -> Url {
    let mut base_url = Url::parse("http://rosettacode.org/mw/api.php").unwrap();
    let cat = format!("Category:{}", category);
    let query_pairs = vec![("action", "query"),
                           ("format", "json"),
                           ("list", "categorymembers"),
                           ("cmlimit", "500"),
                           ("cmtitle", &cat),
                           ("continue", "")];
    base_url.query_pairs_mut().extend_pairs(query_pairs.into_iter());
    base_url
}

fn construct_query_task_content(task_id: &str) -> Url {
    let mut base_url = Url::parse("http://rosettacode.org/mw/api.php").unwrap();
    let mut query_pairs =
        vec![("action", "query"), ("format", "json"), ("prop", "revisions"), ("rvprop", "content")];
    query_pairs.push(("pageids", task_id));
    base_url.query_pairs_mut().extend_pairs(query_pairs.into_iter());
    base_url
}

fn query_api(url: Url) -> Result<Json, ParseError> {
    let mut response = try!(reqwest::get(url.as_str()));
    // Build JSON
    let mut body = String::new();
    response.read_to_string(&mut body).unwrap();

    Ok(try!(Json::from_str(&body)))
}

fn parse_all_tasks(reply: &Json) -> Result<Vec<Task>, ParseError> {
    let json_to_task = |json: &Json| -> Result<Task, ParseError> {
        let page_id: u64 = try!(json.find("pageid")
            .and_then(|id| id.as_u64())
            .ok_or(ParseError::UnexpectedFormat));
        let title: &str = try!(json.find("title")
            .and_then(|title| title.as_string())
            .ok_or(ParseError::UnexpectedFormat));

        Ok(Task {
            page_id: page_id,
            title: title.to_owned(),
        })
    };
    let tasks_json = try!(reply.find_path(&["query", "categorymembers"])
        .and_then(|tasks| tasks.as_array())
        .ok_or(ParseError::UnexpectedFormat));

    // Convert into own type
    tasks_json.iter().map(json_to_task).collect()
}
fn count_number_examples(task: &Json, task_id: u64) -> Result<u32, ParseError> {
    let revisions =
        try!(task.find_path(&["query", "pages", task_id.to_string().as_str(), "revisions"])
            .and_then(|content| content.as_array())
            .ok_or(ParseError::UnexpectedFormat));
    let content = try!(revisions[0]
        .find("*")
        .and_then(|content| content.as_string())
        .ok_or(ParseError::UnexpectedFormat));
    Ok(content.split("=={{header").count() as u32)
}

pub fn query_all_tasks() -> Vec<Task> {
    let query = construct_query_category("Programming_Tasks");
    let json: Json = query_api(query).unwrap();
    parse_all_tasks(&json).unwrap()
}

pub fn query_a_task(task: &Task) -> u32 {
    let query = construct_query_task_content(&task.page_id.to_string());
    let json: Json = query_api(query).unwrap();
    count_number_examples(&json, task.page_id).unwrap()
}


import scala.language.postfixOps

object TaskCount extends App {
  import java.net.{ URL, URLEncoder }
  import scala.io.Source.fromURL

  System.setProperty("http.agent", "*")
  val allTasksURL =
    "http://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
  val allTasks = xml.parsing.XhtmlParser(fromURL(new URL(allTasksURL)))

  val regexExpr = "(?i)==\\{\\{header\\|".r

  def oneTaskURL(title: String) = {
    println(s"Check $title")
    "http://www.rosettacode.org/w/index.php?title=%s&action=raw" format URLEncoder.encode(title.replace(' ', '_'), "UTF-8")
  }

  def count(title: String) = regexExpr findAllIn fromURL(new URL(oneTaskURL(title)))(io.Codec.UTF8).mkString length

  val counts = for (task <- allTasks \\ "cm" \\ "@title" map (_.text)) yield scala.actors.Futures.future((task, count(task)))

  counts map (_.apply) map Function.tupled("%s: %d examples." format (_, _)) foreach println
  println("\nTotal: %d examples." format (counts map (_.apply._2) sum))
}


var lwp = require('LWP::UserAgent').new(agent => 'Mozilla/5.0');

var site = 'http://rosettacode.org';
var list_url = '/mw/api.php?action=query&list=categorymembers&'+
               'cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml';

var content = lwp.get(site + list_url).decoded_content;

while (var m = content.match(/cm.*?title="(.*?)"/g)) {
    (var slug = m[0]).gsub!(' ', '_');
    var count = lwp.get("#{site}/wiki/#{slug}").decoded_content.count(/toclevel-1/g);
    say "#{m[0]}: #{count} examples";
}


package require Tcl 8.5
package require http
package require json

fconfigure stdout -buffering none

proc get_tasks {category} {
    set start [clock milliseconds]
    puts -nonewline "getting $category members..."
    set base_url http://www.rosettacode.org/w/api.php
    set query {action query list categorymembers cmtitle Category:%s format json cmlimit 500}
    set this_query [dict create {*}[split [format $query $category]]]
    set tasks [list]

    while {1} {
        set url [join [list $base_url [http::formatQuery {*}$this_query]] ?]
        set response [http::geturl $url]
        if {[set s [http::status $response]] ne "ok" || [http::ncode $response] != 200} {
            error "Oops: url=$url\nstatus=$s\nhttp code=[http::code $response]"
        }
        set data [json::json2dict [http::data $response]]
        http::cleanup $response

        # add tasks to list
        foreach task [dict get $data query categorymembers] {
            lappend tasks [dict get [dict create {*}$task] title]
        }

        if {[catch {dict get $data query-continue categorymembers cmcontinue} continue_task] != 0} {
            # no more continuations, we're done
            break
        }
        dict set this_query cmcontinue $continue_task
    }
    puts " found [llength $tasks] tasks in [expr {[clock milliseconds] - $start}] milliseconds"
    return $tasks
}

# This proc can be replaced by a single regexp command:
#     set count [regexp -all "***=$needle" $haystack]
# However this proc is more efficient -- we're dealing with plain strings only.
proc count_substrings {needle haystack} {
    set count 0
    set idx 0
    while {[set idx [string first $needle $haystack $idx]] != -1} {
        incr count
        incr idx
    }
    return $count
}

set total 0
foreach task [get_tasks Programming_Tasks] {
    set url [format "http://www.rosettacode.org/w/index.php?title=%s&action=raw" [string map {{ } _} $task]]
    set response [http::geturl $url]
    if {[set s [http::status $response]] ne "ok" || [http::ncode $response] != 200} {
        error "Oops: url=$url\nstatus=$s\nhttp code=[http::code $response]"
    }
    set count [count_substrings "\{\{header|" [http::data $response]]
    puts [format "%3d examples in %s" $count $task]
    http::cleanup $response
    incr total $count
}

puts "\nTotal: $total examples"


$$ MODE TUSCRIPT
url="http://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
data=REQUEST (url)

BUILD S_TABLE beg=*
DATA :title=":
BUILD S_TABLE end=*
DATA :":

titles=EXTRACT (data,beg|,end,1,0,"~~")
titles=SPLIT (titles,":~~:")
sz_titles=SIZE (titles)

BUILD R_TABLE header=":==\{\{header|:"
all=*

ERROR/STOP CREATE ("tasks",seq-e,-std-)

COMPILE
LOOP title=titles
ask=*
ask      =SET_VALUE(ask,"title",title)
ask      =SET_VALUE(ask,"action","raw")
ask      =ENCODE (ask,cgi)
http     ="http://www.rosettacode.org/mw/index.php"
url      =CONCAT (http,"?",ask)
data     =REQUEST (url)
header   =FILTER_INDEX (data,header,-)
sz_header=SIZE(header)
line     =CONCAT (title,"=",sz_header," members")
FILE "tasks" = line
all      =APPEND(all,sz_header)
ENDLOOP

ENDCOMPILE
all =JOIN(all),sum=SUM(all),time=time()
line=CONCAT (time,": ", sz_titles, " Programing Tasks: ", sum, " solutions")

FILE "tasks" = line


#!/usr/bin/env bash
SITE=https://www.rosettacode.org
API=$SITE/mw/api.php
PAGES=$SITE/mw/index.php
query="$API?action=query"
query+=$(printf '&%s' \
          list=categorymembers \
          cmtitle=Category:Programming_Tasks \
          cmlimit=500)
total=0
while read title; do
  t=${title// /_}
  tasks=$(curl -s "$PAGES?title=$t&action=raw" \
          | grep -c '{{header|')
  printf '%s: %d examples.\n' "$title" "$tasks"
  let total+=tasks
done < <(curl -s "$query&format=json" \
         | jq -r '.query.categorymembers[].title')

printf '\nTotal: %d examples.\n' "$total"


/* rc_count_examples.wren */

import "./pattern" for Pattern

var CURLOPT_URL = 10002
var CURLOPT_FOLLOWLOCATION = 52
var CURLOPT_WRITEFUNCTION = 20011
var CURLOPT_WRITEDATA = 10001

foreign class Buffer {
    construct new() {}  // C will allocate buffer of a suitable size

    foreign value       // returns buffer contents as a string
}

foreign class Curl {
    construct easyInit() {}

    foreign easySetOpt(opt, param)

    foreign easyPerform()

    foreign easyCleanup()
}

var curl = Curl.easyInit()

var getContent = Fn.new { |url|
    var buffer = Buffer.new()
    curl.easySetOpt(CURLOPT_URL, url)
    curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1)
    curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0)  // write function to be supplied by C
    curl.easySetOpt(CURLOPT_WRITEDATA, buffer)
    curl.easyPerform()
    return buffer.value
}

var url = "https://www.rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
var content = getContent.call(url)
var p = Pattern.new("title/=\"[+1^\"]\"")
var matches = p.findAll(content)
for (m in matches) {
    var title = m.capsText[0].replace("'", "'").replace(""", "\"")
    var title2 = title.replace(" ", "_").replace("+", "\%2B")
    var taskUrl = "https://www.rosettacode.org/mw/index.php?title=%(title2)&action=raw"
    var taskContent = getContent.call(taskUrl)
    var lines = taskContent.split("\n")
    var count = lines.count { |line| line.trim().startsWith("=={{header|") }
    System.print("%(title) : %(count) examples")
}

curl.easyCleanup()


var [const] YAJL=Import("zklYAJL")[0], CURL=Import("zklCurl");

fcn getTasks(language){
   continueValue,tasks:="",Data(0,String);  // "nm\0nm\0...."
   do{
      page:=CURL().get(("http://rosettacode.org/mw/api.php?"
         "action=query&cmlimit=500"
	 "&format=json"
	 "&list=categorymembers"
	 "&cmtitle=Category:%s"
	 "&cmcontinue=%s").fmt(language,continueValue));
      page=page[0].del(0,page[1]);  // get rid of HTML header
      json:=YAJL().write(page).close();
      json["query"]["categorymembers"].pump(tasks,T("get","title"));
      continueValue=json.find("continue") //continue:-||,cmcontinue:page|954|19)
          .toList().apply("concat","=").concat("&");
   }while(continueValue);
   tasks
}
re:=RegExp(0'!\s+==\s*{{\s*header\s*\|!);  // == {{ header | zkl
foreach task in (getTasks("Programming_Tasks")){
   page:=CURL().get(
      "http://www.rosettacode.org/mw/index.php?title=%s&action=raw"
      .fmt(CURL.urlEncode(task)));
   page=page[0].del(0,page[1]);  // get rid of HTML header
   cnt,n:=0,0;  while(re.search(page,True,n)){ cnt+=1; n=re.matched[0].sum(0); }
   "%4d: %s".fmt(cnt,task).println();
}


with Ada.Text_IO;                        use Ada.Text_IO;
with Ada.Numerics.Elementary_Functions;  use Ada.Numerics.Elementary_Functions;

procedure Quadratic_Equation is
   type Roots is array (1..2) of Float;
   function Solve (A, B, C : Float) return Roots is
      SD : constant Float := sqrt (B**2 - 4.0 * A * C);
      X  : Float;
   begin
      if B < 0.0 then
         X := (- B + SD) / (2.0 * A);
         return (X, C / (A * X));
      else
         X := (- B - SD) / (2.0 * A);
         return (C / (A * X), X);
      end if;
   end Solve;

   R : constant Roots := Solve (1.0, -10.0E5, 1.0);
begin
   Put_Line ("X1 =" & Float'Image (R (1)) & " X2 =" & Float'Image (R (2)));
end Quadratic_Equation;


quadratic equation:
BEGIN

  MODE ROOTS  = UNION([]REAL, []COMPL);
  MODE QUADRATIC = STRUCT(REAL a,b,c);

  PROC solve  = (QUADRATIC q)ROOTS:
  BEGIN
    REAL a = a OF q, b = b OF q, c = c OF q;
    REAL sa = b**2 - 4*a*c;
    IF sa >=0 THEN # handle the +ve case as REAL #
      REAL sqrt sa = ( b<0 | sqrt(sa) | -sqrt(sa));
      REAL r1 = (-b + sqrt sa)/(2*a),
           r2 = (-b - sqrt sa)/(2*a);
      []REAL((r1,r2))
    ELSE # handle the -ve case as COMPL conjugate pairs #
      COMPL compl sqrt sa = ( b<0 | complex sqrt(sa) | -complex sqrt(sa));
      COMPL r1 = (-b + compl sqrt sa)/(2*a),
            r2 = (-b - compl sqrt sa)/(2*a);
      []COMPL (r1, r2)
    FI
  END # solve #;

  PROC real  evaluate = (QUADRATIC q, REAL x )REAL:  (a OF q*x + b OF q)*x + c OF q;
  PROC compl evaluate = (QUADRATIC q, COMPL x)COMPL: (a OF q*x + b OF q)*x + c OF q;

  # only a very tiny difference between the 2 examples #
  []QUADRATIC test = ((1, -10e5, 1), (1, 0, 1), (1,-3,2), (1,3,2), (4,0,4), (3,4,5));

  FORMAT real fmt = $g(-0,8)$;
  FORMAT compl fmt = $f(real fmt)"+"f(real fmt)"i"$;
  FORMAT quadratic fmt = $f(real fmt)" x**2 + "f(real fmt)" x + "f(real fmt)" = 0"$;

  FOR index TO UPB test DO
    QUADRATIC quadratic = test[index];
    ROOTS r = solve(quadratic);

# Output the two different scenerios #
    printf(($"Quadratic: "$, quadratic fmt, quadratic, $l$));
    CASE r IN
      ([]REAL r):
        printf(($"REAL x1 = "$, real fmt, r[1],
                   $", x2 = "$, real fmt, r[2],  $"; "$,
                $"REAL y1 = "$, real fmt, real evaluate(quadratic,r[1]),
                   $", y2 = "$, real fmt, real evaluate(quadratic,r[2]), $";"ll$
        )),
      ([]COMPL c):
        printf(($"COMPL x1,x2 = "$, real fmt, re OF c[1], $"+/-"$,
                                    real fmt, ABS im OF c[1], $"; "$,
                  $"COMPL y1 = "$, compl fmt, compl evaluate(quadratic,c[1]),
                      $", y2 = "$, compl fmt, compl evaluate(quadratic,c[2]), $";"ll$
        ))
    ESAC
  OD
END # quadratic_equation #


MsgBox % quadratic(u,v, 1,-3,2) ", " u ", " v
MsgBox % quadratic(u,v, 1,3,2) ", " u ", " v
MsgBox % quadratic(u,v, -2,4,-2) ", " u ", " v
MsgBox % quadratic(u,v, 1,0,1) ", " u ", " v
SetFormat FloatFast, 0.15e
MsgBox % quadratic(u,v, 1,-1.0e8,1) ", " u ", " v

quadratic(ByRef x1, ByRef x2, a,b,c) { ; -> #real roots {x1,x2} of ax²+bx+c
   If (a = 0)
      Return -1 ; ERROR: not quadratic
   d := b*b - 4*a*c
   If (d < 0) {
      x1 := x2 := ""
      Return 0
   }
   If (d = 0) {
      x1 := x2 := -b/2/a
      Return 1
   }
   x1 := (-b - (b<0 ? -sqrt(d) : sqrt(d)))/2/a
   x2 := c/a/x1
   Return 2
}


      FOR test% = 1 TO 7
        READ a$, b$, c$
        PRINT "For a = " ; a$ ", b = " ; b$ ", c = " ; c$ TAB(32) ;
        PROCsolvequadratic(EVAL(a$), EVAL(b$), EVAL(c$))
      NEXT
      END

      DATA 1, -1E9, 1
      DATA 1, 0, 1
      DATA 2, -1, -6
      DATA 1, 2, -2
      DATA 0.5, SQR(2), 1
      DATA 1, 3, 2
      DATA 3, 4, 5

      DEF PROCsolvequadratic(a, b, c)
      LOCAL d, f
      d = b^2 - 4*a*c
      CASE SGN(d) OF
        WHEN 0:
          PRINT "the single root is " ; -b/2/a
        WHEN +1:
          f = (1 + SQR(1-4*a*c/b^2))/2
          PRINT "the real roots are " ; -f*b/a " and " ; -c/b/f
        WHEN -1:
          PRINT "the complex roots are " ; -b/2/a " +/- " ; SQR(-d)/2/a "*i"
      ENDCASE
      ENDPROC


#include <stdio.h>
#include <stdlib.h>
#include <complex.h>
#include <math.h>

typedef double complex cplx;

void quad_root
(double a, double b, double c, cplx * ra, cplx *rb)
{
	double d, e;
	if (!a) {
		*ra = b ? -c / b : 0;
		*rb = 0;
		return;
	}
	if (!c) {
		*ra = 0;
		*rb = -b / a;
		return;
	}

	b /= 2;
	if (fabs(b) > fabs(c)) {
		e = 1 - (a / b) * (c / b);
		d = sqrt(fabs(e)) * fabs(b);
	} else {
		e = (c > 0) ? a : -a;
		e = b * (b / fabs(c)) - e;
		d = sqrt(fabs(e)) * sqrt(fabs(c));
	}

	if (e < 0) {
		e = fabs(d / a);
		d = -b / a;
		*ra = d + I * e;
		*rb = d - I * e;
		return;
	}

	d = (b >= 0) ? d : -d;
	e = (d - b) / a;
	d = e ? (c / e) / a : 0;
	*ra = d;
	*rb = e;
	return;
}

int main()
{
	cplx ra, rb;
	quad_root(1, 1e12 + 1, 1e12, &ra, &rb);
	printf("(%g + %g i), (%g + %g i)\n",
		creal(ra), cimag(ra), creal(rb), cimag(rb));

	quad_root(1e300, -1e307 + 1, 1e300, &ra, &rb);
	printf("(%g + %g i), (%g + %g i)\n",
		creal(ra), cimag(ra), creal(rb), cimag(rb));

	return 0;
}


using System;
using System.Numerics;

class QuadraticRoots
{
    static Tuple<Complex, Complex> Solve(double a, double b, double c)
    {
        var q = -(b + Math.Sign(b) * Complex.Sqrt(b * b - 4 * a * c)) / 2;
        return Tuple.Create(q / a, c / q);
    }

    static void Main()
    {
        Console.WriteLine(Solve(1, -1E20, 1));
    }
}


#include <iostream>
#include <utility>
#include <complex>

typedef std::complex<double> complex;

std::pair<complex, complex>
 solve_quadratic_equation(double a, double b, double c)
{
  b /= a;
  c /= a;
  double discriminant = b*b-4*c;
  if (discriminant < 0)
    return std::make_pair(complex(-b/2, std::sqrt(-discriminant)/2),
                          complex(-b/2, -std::sqrt(-discriminant)/2));

  double root = std::sqrt(discriminant);
  double solution1 = (b > 0)? (-b - root)/2
                            : (-b + root)/2;

  return std::make_pair(solution1, c/solution1);
}

int main()
{
  std::pair<complex, complex> result = solve_quadratic_equation(1, -1e20, 1);
  std::cout << result.first << ", " << result.second << std::endl;
}


(defn quadratic
  "Compute the roots of a quadratic in the form ax^2 + bx + c = 1.
   Returns any of nil, a float, or a vector."
  [a b c]
  (let [sq-d (Math/sqrt (- (* b b) (* 4 a c)))
        f    #(/ (% b sq-d) (* 2 a))]
    (cond
       (neg? sq-d)  nil
       (zero? sq-d) (f +)
       (pos? sq-d)  [(f +) (f -)]
       :else nil))) ; maybe our number ended up as NaN


import std.math, std.traits;

CommonType!(T1, T2, T3)[] naiveQR(T1, T2, T3)
                                 (in T1 a, in T2 b, in T3 c)
pure nothrow if (isFloatingPoint!T1) {
    alias ReturnT = typeof(typeof(return).init[0]);
    if (a == 0)
        return [ReturnT(c / b)]; // It's a linear function.
    immutable ReturnT det = b ^^ 2 - 4 * a * c;
    if (det < 0)
        return []; // No real number root.
    immutable SD = sqrt(det);
    return [(-b + SD) / 2 * a, (-b - SD) / 2 * a];
}

CommonType!(T1, T2, T3)[] cautiQR(T1, T2, T3)
                                 (in T1 a, in T2 b, in T3 c)
pure nothrow if (isFloatingPoint!T1) {
    alias ReturnT = typeof(typeof(return).init[0]);
    if (a == 0)
        return [ReturnT(c / b)]; // It's a linear function.
    immutable ReturnT det = b ^^ 2 - 4 * a * c;
    if (det < 0)
        return []; // No real number root.
    immutable SD = sqrt(det);

    if (b * a < 0) {
        immutable x = (-b + SD) / 2 * a;
        return [x, c / (a * x)];
    } else {
        immutable x = (-b - SD) / 2 * a;
        return [c / (a * x), x];
    }
}

void main() {
    import std.stdio;
    writeln("With 32 bit float type:");
    writefln("   Naive: [%(%g, %)]", naiveQR(1.0f, -10e5f, 1.0f));
    writefln("Cautious: [%(%g, %)]", cautiQR(1.0f, -10e5f, 1.0f));
    writeln("\nWith 64 bit double type:");
    writefln("   Naive: [%(%g, %)]", naiveQR(1.0, -10e5, 1.0));
    writefln("Cautious: [%(%g, %)]", cautiQR(1.0, -10e5, 1.0));
    writeln("\nWith real type:");
    writefln("   Naive: [%(%g, %)]", naiveQR(1.0L, -10e5L, 1.0L));
    writefln("Cautious: [%(%g, %)]", cautiQR(1.0L, -10e5L, 1.0L));
}


defmodule Quadratic do
  def roots(a, b, c) do
    IO.puts "Roots of a quadratic function (#{a}, #{b}, #{c})"
    d = b * b - 4 * a * c
    a2 = a * 2
    cond do
      d > 0 ->
        sd = :math.sqrt(d)
        IO.puts "  the real roots are #{(- b + sd) / a2} and #{(- b - sd) / a2}"
      d == 0 ->
        IO.puts "  the single root is #{- b / a2}"
      true ->
        sd = :math.sqrt(-d)
        IO.puts "  the complex roots are #{- b / a2} +/- #{sd / a2}*i"
    end
  end
end

Quadratic.roots(1, -2, 1)
Quadratic.roots(1, -3, 2)
Quadratic.roots(1, 0, 1)
Quadratic.roots(1, -1.0e10, 1)
Quadratic.roots(1, 2, 3)
Quadratic.roots(2, -1, -6)


PROGRAM QUADRATIC

PROCEDURE SOLVE_QUADRATIC
  D=B*B-4*A*C
  IF ABS(D)<1D-6 THEN D=0 END IF
  CASE SGN(D) OF
    0->
       PRINT("the single root is ";-B/2/A)
    END ->
    1->
       F=(1+SQR(1-4*A*C/(B*B)))/2
       PRINT("the real roots are ";-F*B/A;"and ";-C/B/F)
    END ->
    -1->
       PRINT("the complex roots are ";-B/2/A;"+/-";SQR(-D)/2/A;"*i")
    END ->
  END CASE
END PROCEDURE

BEGIN
  PRINT(CHR$(12);) ! CLS
  FOR TEST%=1 TO 7 DO
     READ(A,B,C)
     PRINT("For a=";A;",b=";B;",c=";C;TAB(32);)
     SOLVE_QUADRATIC
  END FOR
  DATA(1,-1E9,1)
  DATA(1,0,1)
  DATA(2,-1,-6)
  DATA(1,2,-2)
  DATA(0.5,1.4142135,1)
  DATA(1,3,2)
  DATA(3,4,5)
END PROGRAM


:: quadratic-equation ( a b c -- x1 x2 )
    b sq a c * 4 * - sqrt :> sd
    b 0 <
    [ b neg sd + a 2 * / ]
    [ b neg sd - a 2 * / ] if :> x
    x c a x * / ;


: quadratic ( fa fb fc -- r1 r2 )
  frot frot
  ( c a b )
  fover 3 fpick f* -4e f*  fover fdup f* f+
  ( c a b det )
  fdup f0< if abort" imaginary roots" then
  fsqrt
  fover f0< if fnegate then
  f+ fnegate
  ( c a b-det )
  2e f/ fover f/
  ( c a r1 )
  frot frot f/ fover f/ ;


PROGRAM QUADRATIC

 IMPLICIT NONE
 INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15)
 REAL(dp) :: a, b, c, e, discriminant, rroot1, rroot2
 COMPLEX(dp) :: croot1, croot2

 WRITE(*,*) "Enter the coefficients of the equation ax^2 + bx + c"
 WRITE(*, "(A)", ADVANCE="NO") "a = "
 READ *, a
 WRITE(*,"(A)", ADVANCE="NO") "b = "
 READ *, b
 WRITE(*,"(A)", ADVANCE="NO") "c = "
 READ *, c

 WRITE(*,"(3(A,E23.15))") "Coefficients are: a = ", a, "   b = ", b, "   c = ", c
 e = 1.0e-9_dp
 discriminant = b*b - 4.0_dp*a*c

 IF (ABS(discriminant) < e) THEN
    rroot1 = -b / (2.0_dp * a)
    WRITE(*,*) "The roots are real and equal:"
    WRITE(*,"(A,E23.15)") "Root = ", rroot1
 ELSE IF (discriminant > 0) THEN
    rroot1 = -(b + SIGN(SQRT(discriminant), b)) / (2.0_dp * a)
    rroot2 = c / (a * rroot1)
    WRITE(*,*) "The roots are real:"
    WRITE(*,"(2(A,E23.15))") "Root1 = ", rroot1, "  Root2 = ", rroot2
 ELSE
    croot1 = (-b + SQRT(CMPLX(discriminant))) / (2.0_dp*a)
    croot2 = CONJG(croot1)
    WRITE(*,*) "The roots are complex:"
    WRITE(*,"(2(A,2E23.15,A))") "Root1 = ", croot1, "j ", "  Root2 = ", croot2, "j"
 END IF


' version 20-12-2020
' compile with: fbc -s console

#Include Once "gmp.bi"

Sub solvequadratic_n(a As Double ,b As Double, c As Double)

    Dim As Double f, d = b ^ 2 - 4 * a * c

    Select Case Sgn(d)
        Case 0
            Print "1: the single root is "; -b / 2 / a
        Case 1
            Print "1: the real roots are "; (-b + Sqr(d)) / 2 * a; " and ";(-b - Sqr(d)) / 2 * a
        Case -1
            Print "1: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i"
    End Select

End Sub

Sub solvequadratic_c(a As Double ,b As Double, c As Double)

    Dim As Double f, d = b ^ 2 - 4 * a * c
    Select Case Sgn(d)
        Case 0
            Print "2: the single root is "; -b / 2 / a
        Case 1
            f = (1 + Sqr(1 - 4 * a *c / b ^ 2)) / 2
            Print "2: the real roots are ";  -f * b / a; " and "; -c / b / f
        Case -1
            Print "2: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i"
    End Select
End Sub

Sub solvequadratic_gmp(a_ As Double ,b_ As Double, c_ As Double)

    #Define PRECISION 1024 ' about 300 digits
    #Define MAX 25

    Dim As ZString Ptr text
    text = Callocate (1000)
    Mpf_set_default_prec(PRECISION)

    Dim As Mpf_ptr a, b, c, d, t
    a = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(a, a_)
    b = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(b, b_)
    c = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(c, c_)
    d = Allocate(Len(__mpf_struct)) : Mpf_init(d)
    t = Allocate(Len(__mpf_struct)) : Mpf_init(t)

    mpf_mul(d, b, b)
    mpf_set_ui(t, 4)
    mpf_mul(t, t, a)
    mpf_mul(t, t, c)
    mpf_sub(d, d, t)

    Select Case mpf_sgn(d)
        Case 0
            mpf_neg(t, b)
            mpf_div_ui(t, t, 2)
            mpf_div(t, t, a)
            Gmp_sprintf(text,"%.*Fe", MAX, t)
            Print "3: the single root is "; *text
        Case Is > 0
            mpf_sqrt(d, d)
            mpf_add(a, a, a)
            mpf_neg(t, b)
            mpf_add(t, t, d)
            mpf_div(t, t, a)
            Gmp_sprintf(text,"%.*Fe", MAX, t)
            Print "3: the real roots are "; *text; " and ";
            mpf_neg(t, b)
            mpf_sub(t, t, d)
            mpf_div(t, t, a)
            Gmp_sprintf(text,"%.*Fe", MAX, t)
            Print *text
        Case Is < 0
            mpf_neg(t, b)
            mpf_div_ui(t, t, 2)
            mpf_div(t, t, a)
            Gmp_sprintf(text,"%.*Fe", MAX, t)
            Print "3: the complex roots are "; *text; " +/- ";
            mpf_neg(t, d)
            mpf_sqrt(t, t)
            mpf_div_ui(t, t, 2)
            mpf_div(t, t, a)
            Gmp_sprintf(text,"%.*Fe", MAX, t)
            Print *text; "*i"
    End Select

End Sub

' ------=< MAIN >=------

Dim As Double a, b, c
Print "1: is the naieve way"
Print "2: is the cautious way"
Print "3: is the naieve way with help of GMP"
Print

For i As Integer = 1 To 10
    Read a, b, c
    Print "Find root(s) for "; Str(a); "X^2"; IIf(b < 0, "", "+");
    Print Str(b); "X"; IIf(c < 0, "", "+"); Str(c)
    solvequadratic_n(a, b , c)
    solvequadratic_c(a, b , c)
    solvequadratic_gmp(a, b , c)
    Print
Next

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

Data 1, -1E9, 1
Data 1, 0, 1
Data 2, -1, -6
Data 1, 2, -2
Data 0.5, 1.4142135623731, 1
Data 1, 3, 2
Data 3, 4, 5
Data 1, -1e100, 1
Data 1, -1e200, 1
Data 1, -1e300, 1


package main

import (
    "fmt"
    "math"
)

func qr(a, b, c float64) ([]float64, []complex128) {
    d := b*b-4*a*c
    switch {
    case d == 0:
        // single root
        return []float64{-b/(2*a)}, nil
    case d > 0:
        // two real roots
        if b < 0 {
            d = math.Sqrt(d)-b
        } else {
            d = -math.Sqrt(d)-b
        }
        return []float64{d/(2*a), (2*c)/d}, nil
    case d < 0:
        // two complex roots

        den := 1/(2*a)
        t1 := complex(-b*den, 0)
        t2 := complex(0, math.Sqrt(-d)*den)
        return nil, []complex128{t1+t2, t1-t2}
    }
    // otherwise d overflowed or a coefficient was NAN
    return []float64{d}, nil
}

func test(a, b, c float64) {
    fmt.Print("coefficients: ", a, b, c, " -> ")
    r, i := qr(a, b, c)
    switch len(r) {
    case 1:
        fmt.Println("one real root:", r[0])
    case 2:
        fmt.Println("two real roots:", r[0], r[1])
    default:
        fmt.Println("two complex roots:", i[0], i[1])
    }
}

func main() {
    for _, c := range [][3]float64{
        {1, -2, 1},
        {1, 0, 1},
        {1, -10, 1},
        {1, -1000, 1},
        {1, -1e9, 1},
    } {
        test(c[0], c[1], c[2])
    }
}


import Data.Complex (Complex, realPart)

type CD = Complex Double

quadraticRoots :: (CD, CD, CD) -> (CD, CD)
quadraticRoots (a, b, c)
  | 0 < realPart b =
    ( (2 * c) / (- b - d),
      (- b - d) / (2 * a)
    )
  | otherwise =
    ( (- b + d) / (2 * a),
      (2 * c) / (- b + d)
    )
  where
    d = sqrt $ b ^ 2 - 4 * a * c

main :: IO ()
main =
  mapM_
    (print . quadraticRoots)
    [ (3, 4, 4 / 3),
      (3, 2, -1),
      (3, 2, 1),
      (1, -10e5, 1),
      (1, -10e9, 1)
    ]


procedure main()
    solve(1.0, -10.0e5, 1.0)
end

procedure solve(a,b,c)
    d := sqrt(b*b - 4.0*a*c)
    roots := if b < 0 then [r1 := (-b+d)/(2.0*a), c/(a*r1)]
                      else [r1 := (-b-d)/(2.0*a), c/(a*r1)]
    write(a,"*x^2 + ",b,"*x + ",c," has roots ",roots[1]," and ",roots[2])
end


compile_OPT IDL2

print, "input a, press enter, input b, press enter, input c, press enter"
read,a,b,c
Promt='Enter values of a,b,c and hit enter'

a0=0.0
b0=0.0
c0=0.0   ;make them floating point variables

x=-b+sqrt((b^2)-4*a*c)
y=-b-sqrt((b^2)-4*a*c)
z=2*a
d= x/z
e= y/z

print, d,e


100 PROGRAM "Quadratic.bas"
110 PRINT "Enter coefficients a, b and c:":INPUT PROMPT "a= ,b= ,c= ":A,B,C
120 IF A=0 THEN
130   PRINT "The coefficient of x^2 can not be 0."
140 ELSE
150   LET D=B^2-4*A*C
160   SELECT CASE SGN(D)
170   CASE 0
180     PRINT "The single root is ";-B/2/A
190   CASE 1
200     PRINT "The real roots are ";(-B+SQR(D))/(2*A);"and ";(-B-SQR(D))/(2*A)
210   CASE -1
220     PRINT "The complex roots are ";-B/2/A;"+/- ";STR$(SQR(-D)/2/A);"*i"
230   END SELECT
240 END IF


public class QuadraticRoots {
    private static class Complex {
        double re, im;

        public Complex(double re, double im) {
            this.re = re;
            this.im = im;
        }

        @Override
        public boolean equals(Object obj) {
            if (obj == this) {return true;}
            if (!(obj instanceof Complex)) {return false;}
            Complex other = (Complex) obj;
            return (re == other.re) && (im == other.im);
        }

        @Override
        public String toString() {
            if (im == 0.0) {return String.format("%g", re);}
            if (re == 0.0) {return String.format("%gi", im);}
            return String.format("%g %c %gi", re,
                (im < 0.0 ? '-' : '+'), Math.abs(im));
        }
    }

    private static Complex[] quadraticRoots(double a, double b, double c) {
        Complex[] roots = new Complex[2];
        double d = b * b - 4.0 * a * c;  // discriminant
        double aa = a + a;

        if (d < 0.0) {
            double re = -b / aa;
            double im = Math.sqrt(-d) / aa;
            roots[0] = new Complex(re, im);
            roots[1] = new Complex(re, -im);
        } else if (b < 0.0) {
            // Avoid calculating -b - Math.sqrt(d), to avoid any
            // subtractive cancellation when it is near zero.
            double re = (-b + Math.sqrt(d)) / aa;
            roots[0] = new Complex(re, 0.0);
            roots[1] = new Complex(c / (a * re), 0.0);
        } else {
            // Avoid calculating -b + Math.sqrt(d).
            double re = (-b - Math.sqrt(d)) / aa;
            roots[1] = new Complex(re, 0.0);
            roots[0] = new Complex(c / (a * re), 0.0);
        }
        return roots;
    }

    public static void main(String[] args) {
        double[][] equations = {
            {1.0, 22.0, -1323.0},   // two distinct real roots
            {6.0, -23.0, 20.0},     //   with a != 1.0
            {1.0, -1.0e9, 1.0},     //   with one root near zero
            {1.0, 2.0, 1.0},        // one real root (double root)
            {1.0, 0.0, 1.0},        // two imaginary roots
            {1.0, 1.0, 1.0}         // two complex roots
        };
        for (int i = 0; i < equations.length; i++) {
            Complex[] roots = quadraticRoots(
                equations[i][0], equations[i][1], equations[i][2]);
            System.out.format("%na = %g   b = %g   c = %g%n",
                equations[i][0], equations[i][1], equations[i][2]);
            if (roots[0].equals(roots[1])) {
                System.out.format("X1,2 = %s%n", roots[0]);
            } else {
                System.out.format("X1 = %s%n", roots[0]);
                System.out.format("X2 = %s%n", roots[1]);
            }
        }
    }
}


# If there are infinitely many solutions, emit true;
# if none, emit empty;
# otherwise always emit two.
# For numerical accuracy, Middlebrook's approach is adopted:
def quadratic_roots(a; b; c):
  if a == 0 and b == 0 then
     if c == 0 then true # infinitely many
     else empty          # none
     end
  elif a == 0 then [-c/b, 0]
  elif b == 0 then (complex_sqrt(1/a) | (., negate(.)))
  else
    divide( plus(1.0; complex_sqrt( minus(1.0; (4 * a * c / (b*b))))); 2) as $f
    | negate(divide(multiply(b; $f); a)),
      negate(divide(c; multiply(b; $f)))
  end
;


using Printf

function quadroots(x::Real, y::Real, z::Real)
    a, b, c = promote(float(x), y, z)
    if a ≈ 0.0 return [-c / b] end
    Δ = b ^ 2 - 4a * c
    if Δ ≈ 0.0 return [-sqrt(c / a)] end
    if Δ < 0.0 Δ = complex(Δ) end
    d = sqrt(Δ)
    if b < 0.0
        d -= b
        return [d / 2a, 2c / d]
    else
        d = -d - b
        return [2c / d, d / 2a]
    end
end

a = [1, 1, 1.0, 10]
b = [10, 2, -10.0 ^ 9, 1]
c = [1, 1, 1, 1]

for (x, y, z) in zip(a, b, c)
    @printf "The roots of %.2fx² + %.2fx + %.2f\n\tx₀ = (%s)\n" x y z join(round.(quadroots(x, y, z), 2), ", ")
end


import java.lang.Math.*

data class Equation(val a: Double, val b: Double, val c: Double) {
    data class Complex(val r: Double, val i: Double) {
        override fun toString() = when {
            i == 0.0 -> r.toString()
            r == 0.0 -> "${i}i"
            else -> "$r + ${i}i"
        }
    }

    data class Solution(val x1: Any, val x2: Any) {
        override fun toString() = when(x1) {
            x2 -> "X1,2 = $x1"
            else -> "X1 = $x1, X2 = $x2"
        }
    }

    val quadraticRoots by lazy {
        val _2a = a + a
        val d = b * b - 4.0 * a * c  // discriminant
         if (d < 0.0) {
            val r = -b / _2a
            val i = sqrt(-d) / _2a
            Solution(Complex(r, i), Complex(r, -i))
        } else {
            // avoid calculating -b +/- sqrt(d), to avoid any
            // subtractive cancellation when it is near zero.
            val r = if (b < 0.0) (-b + sqrt(d)) / _2a else (-b - sqrt(d)) / _2a
            Solution(r, c / (a * r))
        }
    }
}

fun main(args: Array<String>) {
    val equations = listOf(Equation(1.0, 22.0, -1323.0),   // two distinct real roots
                           Equation(6.0, -23.0, 20.0),     //  with a != 1.0
                           Equation(1.0, -1.0e9, 1.0),     //  with one root near zero
                           Equation(1.0, 2.0, 1.0),        // one real root (double root)
                           Equation(1.0, 0.0, 1.0),        // two imaginary roots
                           Equation(1.0, 1.0, 1.0))        // two complex roots

    equations.forEach { println("$it\n" + it.quadraticRoots) }
}


1) using lambdas:

{def equation
 {lambda {:a :b :c}
  {b equation :a*x{sup 2}+:b*x+:c=0}
  {{lambda {:a' :b' :d}
   {if {> :d 0}
   then {{lambda {:b' :d'}
         {equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots}
        } :b' {/ {sqrt :d} :a'}}
   else {if {< :d 0}
   then {{lambda {:b' :d'}
         {equation.disp [:b',:d'] [:b',-:d'] 2 complex roots}
        } :b' {/ {sqrt {- :d}} :a'} }
   else {equation.disp :b'  :b' one real double root}
  }}
  } {* 2 :a} {/ {- :b} {* 2 :a}} {- {* :b :b} {* 4 :a :c}} } }}

2) using let:

{def equation
 {lambda {:a :b :c}
  {b equation :a*x{sup 2}+:b*x+:c=0}
  {let { {:a' {* 2 :a}}
         {:b' {/ {- :b} {* 2 :a}}}
         {:d  {- {* :b :b} {* 4 :a :c}}} }
   {if {> :d 0}
    then {let { {:b' :b'}
                {:d' {/ {sqrt :d} :a'}} }
          {equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots} }
    else {if {< :d 0}
    then {let { {:b' :b'}
                {:d' {/ {sqrt {- :d}} :a'}} }
          {equation.disp [:b',:d'] [:b',-:d'] 2 complex roots} }
    else  {equation.disp :b' :b' one real double root} }} }}}

3) a function to display results in an HTML table format

{def equation.disp
 {lambda {:x1 :x2 :txt}
  {table {@ style="background:#ffa"}
   {tr {td :txt:    }}
   {tr {td x1 = :x1 }}
   {tr {td x2 = :x2 }} } }}

4) testing:

equation 1*x2+1*x+-1=0
2 real roots:
 x1 = 0.6180339887498949
 x2 = -1.618033988749895

equation 1*x2+1*x+1=0
2 complex roots:
 x1 = [-0.5,0.8660254037844386]
 x2 = [-0.5,-0.8660254037844386]

equation 1*x2+-2*x+1=0
one real double root:
 x1 = 1
 x2 = 1


a=1:b=2:c=3
    'assume a<>0
    print quad$(a,b,c)
    end

function quad$(a,b,c)
    D=b^2-4*a*c
    x=-1*b
    if D<0 then
        quad$=str$(x/(2*a));" +i";str$(sqr(abs(D))/(2*a));" , ";str$(x/(2*a));" -i";str$(sqr(abs(D))/abs(2*a))
    else
        quad$=str$(x/(2*a)+sqr(D)/(2*a));" , ";str$(x/(2*a)-sqr(D)/(2*a))
    end if
end function


to quadratic :a :b :c
  localmake "d sqrt (:b*:b - 4*:a*:c)
  if :b < 0 [make "d minus :d]
  output list (:d-:b)/(2*:a) (2*:c)/(:d-:b)
end


function qsolve(a, b, c)
  if b < 0 then return qsolve(-a, -b, -c) end
  val = b + (b^2 - 4*a*c)^(1/2) --this never exhibits instability if b > 0
  return -val / (2 * a), -2 * c / val --2c / val is the same as the "unstable" second root
end

for i = 1, 12 do
  print(qsolve(1, 0-10^i, 1))
end


solve(a*x^2+b*x+c,x);

solve(1.0*x^2-10.0^9*x+1.0,x,explicit,allsolutions);

fsolve(x^2-10^9*x+1,x,complex);


roots([1 -3 2])    % coefficients in decreasing order of power e.g. [x^n ... x^2 x^1 x^0]


MODULE Quad EXPORTS Main;

IMPORT IO, Fmt, Math;

TYPE Roots = ARRAY [1..2] OF LONGREAL;

VAR r: Roots;

PROCEDURE Solve(a, b, c: LONGREAL): Roots =
  VAR sd: LONGREAL := Math.sqrt(b * b - 4.0D0 * a * c);
      x: LONGREAL;
  BEGIN
    IF b < 0.0D0 THEN
      x := (-b + sd) / (2.0D0 * a);
      RETURN Roots{x, c / (a * x)};
    ELSE
      x := (-b - sd) / (2.0D0 * a);
      RETURN Roots{c / (a * x), x};
    END;
  END Solve;

BEGIN
  r := Solve(1.0D0, -10.0D5, 1.0D0);
  IO.Put("X1 = " & Fmt.LongReal(r[1]) & " X2 = " & Fmt.LongReal(r[2]) & "\n");
END Quad.


import math, complex, strformat

const Epsilon = 1e-15

type

  SolKind = enum solDouble, solFloat, solComplex

  Roots = object
    case kind: SolKind
    of solDouble:
      fvalue: float
    of solFloat:
      fvalues: (float, float)
    of solComplex:
      cvalues: (Complex64, Complex64)

func quadRoots(a, b, c: float): Roots =
  if a == 0:
    raise newException(ValueError, "first coefficient cannot be null.")
  let den = a * 2
  let Δ = b * b - a * c * 4
  if abs(Δ) < Epsilon:
    result = Roots(kind: solDouble, fvalue: -b / den)
  elif Δ < 0:
    let r = -b / den
    let i = sqrt(-Δ) / den
    result = Roots(kind: solComplex, cvalues: (complex64(r, i), complex64(r, -i)))
  else:
    let r = (if b < 0: -b + sqrt(Δ) else: -b - sqrt(Δ)) / den
    result = Roots(kind: solFloat, fvalues: (r, c / (a * r)))

func `$`(r: Roots): string =
  case r.kind
  of solDouble:
    result = $r.fvalue
  of solFloat:
    result = &"{r.fvalues[0]}, {r.fvalues[1]}"
  of solComplex:
    result = &"{r.cvalues[0].re} + {r.cvalues[0].im}i, {r.cvalues[1].re} + {r.cvalues[1].im}i"

when isMainModule:

  const Equations = [(1.0, -2.0, 1.0),
                    (10.0, 1.0, 1.0),
                    (1.0, -10.0, 1.0),
                    (1.0, -1000.0, 1.0),
                    (1.0, -1e9, 1.0)]

  for (a, b, c) in Equations:
    echo &"Equation: {a=}, {b=}, {c=}"
    let roots = quadRoots(a, b, c)
    let plural = if roots.kind == solDouble: "" else: "s"
    echo &"    root{plural}: {roots}"


type quadroots =
  | RealRoots of float * float
  | ComplexRoots of Complex.t * Complex.t ;;

let quadsolve a b c =
  let d = (b *. b) -. (4.0 *. a *. c) in
  if d < 0.0
  then
    let r = -. b /. (2.0 *. a)
    and i = sqrt(-. d) /. (2.0 *. a) in
    ComplexRoots ({ Complex.re = r; Complex.im = i },
                  { Complex.re = r; Complex.im = (-.i) })
  else
    let r =
      if b < 0.0
      then ((sqrt d) -. b) /. (2.0 *. a)
      else ((sqrt d) +. b) /. (-2.0 *. a)
    in
    RealRoots (r, c /. (r *. a))
;;


procedure solve_quadratic(sequence t3)
    atom {a,b,c} = t3,
         d = b*b-4*a*c, f
    string s = sprintf("for a=%g,b=%g,c=%g",t3), t
    sequence u
    if abs(d)<1e-6 then d=0 end if
    switch sign(d) do
        case 0: t = "single root is %g"
                u = {-b/2/a}
        case 1: t = "real roots are %g and %g"
                f = (1+sqrt(1-4*a*c/(b*b)))/2
                u = {-f*b/a,-c/b/f}
        case-1: t = "complex roots are %g +/- %g*i"
                u = {-b/2/a,sqrt(-d)/2/a}
    end switch
    printf(1,"%-25s the %s\n",{s,sprintf(t,u)})
end procedure

constant tests = {{1,-1E9,1},
                  {1,0,1},
                  {2,-1,-6},
                  {1,2,-2},
                  {0.5,1.4142135,1},
                  {1,3,2},
                  {3,4,5}}

papply(tests,solve_quadratic)


#!/usr/bin/env python3

import math
import cmath
import numpy

def quad_discriminating_roots(a,b,c, entier = 1e-5):
    """For reference, the naive algorithm which shows complete loss of
    precision on the quadratic in question.  (This function also returns a
    characterization of the roots.)"""
    discriminant = b*b - 4*a*c
    a,b,c,d =complex(a), complex(b), complex(c), complex(discriminant)
    root1 = (-b + cmath.sqrt(d))/2./a
    root2 = (-b - cmath.sqrt(d))/2./a
    if abs(discriminant) < entier:
        return "real and equal", abs(root1), abs(root1)
    if discriminant > 0:
        return "real", root1.real, root2.real
    return "complex", root1, root2

def middlebrook(a, b, c):
    try:
        q = math.sqrt(a*c)/b
        f = .5+ math.sqrt(1-4*q*q)/2
    except ValueError:
        q = cmath.sqrt(a*c)/b
        f = .5+ cmath.sqrt(1-4*q*q)/2
    return (-b/a)*f, -c/(b*f)

def whatevery(a, b, c):
    try:
        d = math.sqrt(b*b-4*a*c)
    except ValueError:
        d = cmath.sqrt(b*b-4*a*c)
    if b > 0:
        return div(2*c, (-b-d)), div((-b-d), 2*a)
    else:
        return div((-b+d), 2*a), div(2*c, (-b+d))

def div(n, d):
    """Divide, with a useful interpretation of division by zero."""
    try:
        return n/d
    except ZeroDivisionError:
        if n:
            return n*float('inf')
        return float('nan')

testcases = [
    (3, 4, 4/3),    # real, equal
    (3, 2, -1),     # real, unequal
    (3, 2, 1),      # complex
    (1, -1e9, 1),   # ill-conditioned "quadratic in question" required by task.
    (1, -1e100, 1),
    (1, -1e200, 1),
    (1, -1e300, 1),
]

print('Naive:')
for c in testcases:
    print("{} {:.5} {:.5}".format(*quad_discriminating_roots(*c)))

print('\nMiddlebrook:')
for c in testcases:
    print(("{:.5} "*2).format(*middlebrook(*c)))

print('\nWhat Every...')
for c in testcases:
    print(("{:.5} "*2).format(*whatevery(*c)))

print('\nNumpy:')
for c in testcases:
    print(("{:.5} "*2).format(*numpy.roots(c)))


/*REXX program finds the  roots  (which may be complex)  of a quadratic function.       */
parse arg  a b c .                               /*obtain the specified arguments: A B C*/
call quad  a,b,c                                 /*solve quadratic function via the sub.*/
r1= r1/1;  r2= r2/1;   a= a/1;  b= b/1;  c= c/1  /*normalize numbers to a new precision.*/
if r1j\=0  then r1=r1||left('+',r1j>0)(r1j/1)"i" /*Imaginary part? Handle complex number*/
if r2j\=0  then r2=r2||left('+',r2j>0)(r2j/1)"i" /*   "        "      "       "      "  */
              say '    a ='   a                  /*display the normalized value of   A. */
              say '    b ='   b                  /*   "     "       "       "    "   B. */
              say '    c ='   c                  /*   "     "       "       "    "   C. */
      say;    say 'root1 ='   r1                 /*   "     "       "       "   1st root*/
              say 'root2 ='   r2                 /*   "     "       "       "   2nd root*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
quad: parse arg aa,bb,cc;     numeric digits 200 /*obtain 3 args; use enough dec. digits*/
      $= sqrt(bb**2-4*aa*cc);       L= length($) /*compute  SQRT (which may be complex).*/
      r= 1 /(aa+aa);   ?= right($, 1)=='i'       /*compute reciprocal of 2*aa;  Complex?*/
      if ?  then do;  r1= -bb   *r;   r2=r1;          r1j= left($,L-1)*r;   r2j=-r1j;  end
            else do;  r1=(-bb+$)*r;   r2=(-bb-$)*r;   r1j= 0;               r2j= 0;    end
      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x 1 ox; if x=0  then return 0; d= digits(); m.= 9; numeric form
      numeric digits 9; h= d+6; x=abs(x); parse value format(x,2,1,,0) 'E0' with g 'E' _ .
      g=g*.5'e'_%2;   do j=0  while h>9;      m.j=h;              h=h%2+1;       end /*j*/
                      do k=j+5  to 0  by -1;  numeric digits m.k; g=(g+x/g)*.5;  end /*k*/
      numeric digits d;         return (g/1)left('i', ox<0)     /*make complex if OX<0. */


import ArithmeticComplex._
object QuadraticRoots {
  def solve(a:Double, b:Double, c:Double)={
    val d = b*b-4.0*a*c
    val aa = a+a

    if (d < 0.0) {  // complex roots
      val re= -b/aa;
      val im = math.sqrt(-d)/aa;
      (Complex(re, im), Complex(re, -im))
    }
    else { // real roots
      val re=if (b < 0.0) (-b+math.sqrt(d))/aa else (-b -math.sqrt(d))/aa
      (re, (c/(a*re)))
    }
  }
}


$ include "seed7_05.s7i";
  include "float.s7i";
  include "math.s7i";

const type: roots is new struct
    var float: x1 is 0.0;
    var float: x2 is 0.0;
  end struct;

const func roots: solve (in float: a, in float: b, in float: c) is func
  result
    var roots: solution is roots.value;
  local
    var float: sd is 0.0;
    var float: x is 0.0;
  begin
    sd := sqrt(b**2 - 4.0 * a * c);
    if b < 0.0 then
      x := (-b + sd) / 2.0 * a;
      solution.x1 := x;
      solution.x2 := c / (a * x);
    else
      x := (-b - sd) / 2.0 * a;
      solution.x1 := c / (a * x);
      solution.x2 := x;
    end if;
  end func;

const proc: main is func
  local
    var roots: r is roots.value;
  begin
    r := solve(1.0, -10.0E5, 1.0);
    writeln("X1 = " <& r.x1 digits 6 <& " X2 = " <& r.x2 digits 6);
  end func;


var sets = [
            [1,    2,  1],
            [1,    2,  3],
            [1,   -2,  1],
            [1,    0, -4],
            [1, -1e6,  1],
           ]

func quadroots(a, b, c) {
    var root = sqrt(b**2 - 4*a*c)

    [(-b + root) / (2 * a),
     (-b - root) / (2 * a)]
}

sets.each { |coefficients|
    say ("Roots for #{coefficients}",
        "=> (#{quadroots(coefficients...).join(', ')})")
}


package require math::complexnumbers
namespace import math::complexnumbers::complex math::complexnumbers::tostring

proc quadratic {a b c} {
    set discrim [expr {$b**2 - 4*$a*$c}]
    set roots [list]
    if {$discrim < 0} {
        set term1 [expr {(-1.0*$b)/(2*$a)}]
        set term2 [expr {sqrt(abs($discrim))/(2*$a)}]
        lappend roots [tostring [complex $term1 $term2]] \
                [tostring [complex $term1 [expr {-1 * $term2}]]]
    } elseif {$discrim == 0} {
        lappend roots [expr {-1.0*$b / (2*$a)}]
    } else {
        lappend roots [expr {(-1*$b + sqrt($discrim)) / (2 * $a)}] \
                [expr {(-1*$b - sqrt($discrim)) / (2 * $a)}]
    }
    return $roots
}

proc report_quad {a b c} {
    puts [format "%sx**2 + %sx + %s = 0" $a $b $c]
    foreach root [quadratic $a $b $c] {
        puts "    x = $root"
    }
}

# examples on this page
report_quad 3 4 [expr {4/3.0}] ;# {-2/3}
report_quad 3 2 -1    ;# {1/3, -1}
report_quad 3 2  1    ;# {(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)}
report_quad 1 0  1    ;# {(0+i), (0-i)}
report_quad 1 -1e6 1  ;# {1e6, 1e-6}
# examples from http://en.wikipedia.org/wiki/Quadratic_equation
report_quad -2  7 15  ;# {5, -3/2}
report_quad  1 -2  1  ;# {1}
report_quad  1  3  3  ;# {(-3 - sqrt(3)i)/2), (-3 + sqrt(3)i)/2)}


import "/complex" for Complex

var quadratic = Fn.new { |a, b, c|
    var d = b*b - 4*a*c
    if (d == 0) {
        // single root
        return [[-b/(2*a)], null]
    }
    if (d > 0) {
        // two real roots
        var sr = d.sqrt
        d = (b < 0) ? sr - b : -sr - b
        return [[d/(2*a), 2*c/d], null]
    }
    // two complex roots
    var den = 1 / (2*a)
    var t1 = Complex.new(-b*den, 0)
    var t2 = Complex.new(0, (-d).sqrt * den)
    return [[], [t1+t2, t1-t2]]
}

var test = Fn.new { |a, b, c|
    System.write("coefficients: %(a), %(b), %(c) -> ")
    var roots = quadratic.call(a, b, c)
    var r = roots[0]
    if (r.count == 1) {
        System.print("one real root: %(r[0])")
    } else if (r.count == 2) {
        System.print("two real roots: %(r[0]) and %(r[1])")
    } else {
        var i = roots[1]
        System.print("two complex roots: %(i[0]) and %(i[1])")
    }
}

var coeffs = [
    [1, -2, 1],
    [1,  0, 1],
    [1, -10, 1],
    [1, -1000, 1],
    [1, -1e9, 1]
]

for (c in coeffs) test.call(c[0], c[1], c[2])


fcn quadratic(a,b,c){ b=b.toFloat();
   println("Roots of a quadratic function %s, %s, %s".fmt(a,b,c));
   d,a2:=(b*b - 4*a*c), a+a;
   if(d>0){
      sd:=d.sqrt();
      println("  the real roots are %s and %s".fmt((-b + sd)/a2,(-b - sd)/a2));
   }
   else if(d==0) println("  the single root is ",-b/a2);
   else{
      sd:=(-d).sqrt();
      println("  the complex roots are %s and \U00B1;%si".fmt(-b/a2,sd/a2));
   }
}


with Ada.Text_IO;

with CryptAda.Pragmatics;
with CryptAda.Digests.Message_Digests.RIPEMD_160;
with CryptAda.Digests.Hashes;
with CryptAda.Utils.Format;

procedure RC_RIPEMD_160 is
   use CryptAda.Pragmatics;
   use CryptAda.Digests.Message_Digests;
   use CryptAda.Digests;

   function To_Byte_Array (Item : String) return Byte_Array is
      Result : Byte_Array (Item'Range);
   begin
      for I in Result'Range loop
         Result (I) := Byte (Character'Pos (Item (I)));
      end loop;
      return Result;
   end To_Byte_Array;

   Text    : constant String                := "Rosetta Code";
   Bytes   : constant Byte_Array            := To_Byte_Array (Text);
   Handle  : constant Message_Digest_Handle := RIPEMD_160.Get_Message_Digest_Handle;
   Pointer : constant Message_Digest_Ptr    := Get_Message_Digest_Ptr (Handle);
   Hash    : Hashes.Hash;
begin
   Digest_Start  (Pointer);
   Digest_Update (Pointer, Bytes);
   Digest_End    (Pointer, Hash);

   Ada.Text_IO.Put_Line
     ("""" & Text & """: " & CryptAda.Utils.Format.To_Hex_String (Hashes.Get_Bytes (Hash)));
end RC_RIPEMD_160;


#ifndef RMDsize
#define RMDsize 160
#endif

#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <string.h>
#if RMDsize == 128
#include "rmd128.h"
#include "rmd128.c"  /* Added to remove errors during compilation */
#elif RMDsize == 160
#include "rmd160.h"
#include "rmd160.c"  /* Added to remove errors during compilation */
#endif


using System;
using System.Security.Cryptography;
using System.Text;

class Program
{
    static void Main(string[] args)
    {
        string text = "Rosetta Code";
        byte[] bytes = Encoding.ASCII.GetBytes(text);
        RIPEMD160 myRIPEMD160 = RIPEMD160Managed.Create();
        byte[] hashValue = myRIPEMD160.ComputeHash(bytes);
        var hexdigest = BitConverter.ToString(hashValue).Replace("-", "").ToLower();
        Console.WriteLine(hexdigest);
        Console.ReadLine();
    }
}


(use 'pandect.core)
(ripemd160 "Rosetta Code")


(ql:quickload 'ironclad)
(defun string-to-ripemd-160 (str)
  "Return the RIPEMD-160 digest of the given ASCII string."
  (ironclad:byte-array-to-hex-string
    (ironclad:digest-sequence :ripemd-160
                              (ironclad:ascii-string-to-byte-array str)))

(string-to-ripemd-160 "Rosetta Code")


void main() {
    import std.stdio, std.digest.ripemd;

    writefln("%(%02x%)", "Rosetta Code".ripemd160Of);
}


program RIPEMD160;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  DCPripemd160;

function HashRipemd160(const Input: Ansistring): TArray<byte>;
var
  Hasher: TDCP_ripemd160;
begin
  Hasher := TDCP_ripemd160.Create(nil);
  try
    Hasher.Init;
    Hasher.UpdateStr(Input);
    SetLength(Result, Hasher.HashSize div 8);
    Hasher.final(Result[0]);
  finally
    Hasher.Free;
  end;
end;

begin
  for var b in HashRipemd160('Rosetta Code') do
  begin
    write(b.ToHexString(2));
  end;
  readln;
end.


USING: checksums checksums.ripemd io math.parser ;

"Rosetta Code" ripemd-160 checksum-bytes bytes>hex-string print


package main

import (
    "golang.org/x/crypto/ripemd160"
    "fmt"
)

func main() {
    h := ripemd160.New()
    h.Write([]byte("Rosetta Code"))
    fmt.Printf("%x\n", h.Sum(nil))
}


import Data.Char (ord)
import Crypto.Hash.RIPEMD160 (hash)
import Data.ByteString (unpack, pack)
import Text.Printf (printf)

main = putStrLn $                     -- output to terminal
       concatMap (printf "%02x") $    -- to hex string
       unpack $                       -- to array of Word8
       hash $                         -- RIPEMD-160 hash to ByteString
       pack $                         -- to ByteString
       map (fromIntegral.ord)         -- to array of Word8
       "Rosetta Code"


import org.bouncycastle.crypto.digests.RIPEMD160Digest;
import org.bouncycastle.util.encoders.Hex;

public class RosettaRIPEMD160
{
    public static void main (String[] argv) throws Exception
    {
        byte[] r = "Rosetta Code".getBytes("US-ASCII");
        RIPEMD160Digest d = new RIPEMD160Digest();
        d.update (r, 0, r.length);
        byte[] o = new byte[d.getDigestSize()];
        d.doFinal (o, 0);
        Hex.encode (o, System.out);
        System.out.println();
    }
}


using Nettle

labels = ["\"\" (empty string)", "\"a\"", "\"abc\"",
        "\"message digest\"", "\"a...z\"",
        "\"abcdbcde...nopq\"", "\"A...Za...z0...9\"",
        "8 times \"1234567890\"", "1 million times \"a\""]
texts = ["", "a", "abc", "message digest", "abcdefghijklmnopqrstuvwxyz",
        "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq",
        "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
        "1234567890" ^ 8, "a" ^ 1_000_000]
expects = ["9c1185a5c5e9fc54612808977ee8f548b2258d31",
        "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe",
        "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc",
        "5d0689ef49d2fae572b881b123a85ffa21595f36",
        "f71c27109c692c1b56bbdceb5b9d2865b3708dbc",
        "12a053384a9c0c88e405a06c27dcf49ada62eb2b",
        "b0e20b6e3116640286ed3a87a5713079b21f5189",
        "9b752e45573d4b39f4dbd3323cab82bf63326bfb",
        "52783243c1697bdbe16d37f97f68f08325dc1528"]

for (lab, text, expect) in zip(labels, texts, expects)
    digest = hexdigest("ripemd160", text)
    println("# $lab\n -> digest: $digest\n -> expect: $expect")
end


import org.bouncycastle.crypto.digests.RIPEMD160Digest
import org.bouncycastle.util.encoders.Hex
import kotlin.text.Charsets.US_ASCII

fun RIPEMD160Digest.inOneGo(input : ByteArray) : ByteArray {
    val output = ByteArray(digestSize)

    update(input, 0, input.size)
    doFinal(output, 0)

    return output
}

fun main(args: Array<String>) {
    val input = "Rosetta Code".toByteArray(US_ASCII)
    val output = RIPEMD160Digest().inOneGo(input)

    Hex.encode(output, System.out)
    System.out.flush()
}


cipher_digest("Rosetta Code", -digest='RIPEMD160', -hex)


#!/usr/bin/lua

require "crypto"

print(crypto.digest("ripemd160", "Rosetta Code"))


import nimcrypto / [ripemd, hash]

echo ripemd160.digest("Rosetta Code")


class Hash {
  function : Main(args : String[]) ~ Nil {
    in := "Rosetta Code"->ToByteArray();
    hash := Encryption.Hash->RIPEMD160(in);
    hash->ToHexString()->PrintLine();
  }
}


#include <pari/pari.h>
#include <openssl/ripemd.h>

#define HEX(x)  (((x) < 10)? (x)+'0': (x)-10+'a')

GEN plug_ripemd160(char *text)
{
  char md[RIPEMD160_DIGEST_LENGTH];
  char hash[sizeof(md) * 2 + 1];
  int i;

  RIPEMD160((unsigned char*)text, strlen(text), (unsigned char*)md);

  for (i = 0; i < sizeof(md); i++) {
    hash[i+i]   = HEX((md[i] >> 4) & 0x0f);
    hash[i+i+1] = HEX(md[i] & 0x0f);
  }

  hash[sizeof(md) * 2] = 0;

  return strtoGENstr(hash);
}


use Crypt::RIPEMD160;
say unpack "H*", Crypt::RIPEMD160->hash("Rosetta Code");


include builtins\ripemd160.e

constant test = "Rosetta Code"
printf(1,"\n%s => %s\n",{test,ripemd160(test)})


function Get-Hash
{
    [CmdletBinding(DefaultParameterSetName="String")]
    [OutputType([string])]
    Param
    (
        [Parameter(Mandatory=$true,
                   ParameterSetName="String",
                   Position=0)]
        [string]
        $String,

        [Parameter(Mandatory=$true,
                   ParameterSetName="FileName",
                   Position=0)]
        [string]
        $FileName,

        [Parameter(Mandatory=$false,
                   Position=1)]
        [ValidateSet("MD5", "RIPEMD160", "SHA1", "SHA256", "SHA384", "SHA512")]
        [string]
        $HashType = "MD5"
    )

    $hashAlgorithm = [System.Security.Cryptography.HashAlgorithm]
    $stringBuilder = New-Object -TypeName System.Text.StringBuilder

    switch ($PSCmdlet.ParameterSetName)
    {
        "String"
        {
	    $hashAlgorithm::Create($HashType).ComputeHash([System.Text.Encoding]::UTF8.GetBytes($String)) | ForEach-Object {
	        $stringBuilder.Append($_.ToString("x2")) | Out-Null
	    }
        }
        "FileName"
        {
            $fileStream = New-Object -TypeName System.IO.FileStream -ArgumentList $FileName, ([System.IO.FileMode]::Open)

	    $hashAlgorithm::Create($HashType).ComputeHash($fileStream) | ForEach-Object {
	        $stringBuilder.Append($_.ToString("x2")) | Out-Null
	    }

	    $fileStream.Close()
	    $fileStream.Dispose()
        }
    }

    $stringBuilder.ToString()
}


Python 3.3.0 (v3.3.0:bd8afb90ebf2, Sep 29 2012, 10:57:17) [MSC v.1600 64 bit (AMD64)] on win32
Type "copyright", "credits" or "license()" for more information.
>>> import hashlib
>>> h = hashlib.new('ripemd160')
>>> h.update(b"Rosetta Code")
>>> h.hexdigest()
'b3be159860842cebaa7174c8fff0aa9e50a5199f'
>>>


#lang racket
(require (planet soegaard/digest:1:2/digest))
(ripemd160 #"Rosetta Code")


require 'digest'
puts Digest::RMD160.hexdigest('Rosetta Code')


use ripemd160::{Digest, Ripemd160};

/// Create a lowercase hexadecimal string using the
/// RIPEMD160 hashing algorithm
fn ripemd160(text: &str) -> String {
    // create a lowercase hexadecimal string
    // using the shortand for the format macro
    // https://doc.rust-lang.org/std/fmt/trait.LowerHex.html
    format!("{:x}", Ripemd160::digest(text.as_bytes()))
}

fn main() {
    println!("{}", ripemd160("Rosetta Code"));
}


import org.bouncycastle.crypto.digests.RIPEMD160Digest

object RosettaRIPEMD160 extends App {
  val (raw, messageDigest) = ("Rosetta Code".getBytes("US-ASCII"), new RIPEMD160Digest())
  messageDigest.update(raw, 0, raw.length)
  val out = Array.fill[Byte](messageDigest.getDigestSize())(0)
  messageDigest.doFinal(out, 0)

  assert(out.map("%02x".format(_)).mkString == "b3be159860842cebaa7174c8fff0aa9e50a5199f")
}


$ include "seed7_05.s7i";
  include "msgdigest.s7i";

const proc: main is func
  begin
    writeln(hex(ripemd160("Rosetta Code")));
  end func;


// Circular left shift: http://en.wikipedia.org/wiki/Circular_shift
// Precendence should be the same as <<
infix operator  ~<< { precedence 160 associativity none }

public func ~<< (lhs: UInt32, rhs: Int) -> UInt32 {
    return (lhs << UInt32(rhs)) | (lhs >> UInt32(32 - rhs));
}

    public struct Block {
        public init() {}

        var message: [UInt32] = [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]

        // Initial values
        var h₀: UInt32 = 0x67452301
        var h₁: UInt32 = 0xEFCDAB89
        var h₂: UInt32 = 0x98BADCFE
        var h₃: UInt32 = 0x10325476
        var h₄: UInt32 = 0xC3D2E1F0

        public var hash: [UInt32] {
            return [h₀, h₁, h₂, h₃, h₄]
        }

        // FIXME: Make private as soon as tests support that
        public mutating func compress (message: [UInt32]) -> () {
            assert(count(message) == 16, "Wrong message size")

            var Aᴸ = h₀
            var Bᴸ = h₁
            var Cᴸ = h₂
            var Dᴸ = h₃
            var Eᴸ = h₄

            var Aᴿ = h₀
            var Bᴿ = h₁
            var Cᴿ = h₂
            var Dᴿ = h₃
            var Eᴿ = h₄

            for j in 0...79 {
                // Left side
                let wordᴸ = message[r.Left[j]]
                let functionᴸ = f(j)

                let Tᴸ: UInt32 = ((Aᴸ &+ functionᴸ(Bᴸ,Cᴸ,Dᴸ) &+ wordᴸ &+ K.Left[j]) ~<< s.Left[j]) &+ Eᴸ

                Aᴸ = Eᴸ
                Eᴸ = Dᴸ
                Dᴸ = Cᴸ ~<< 10
                Cᴸ = Bᴸ
                Bᴸ = Tᴸ

                // Right side
                let wordᴿ = message[r.Right[j]]
                let functionᴿ = f(79 - j)

                let Tᴿ: UInt32 = ((Aᴿ &+ functionᴿ(Bᴿ,Cᴿ,Dᴿ) &+ wordᴿ &+ K.Right[j]) ~<< s.Right[j]) &+ Eᴿ

                Aᴿ = Eᴿ
                Eᴿ = Dᴿ
                Dᴿ = Cᴿ ~<< 10
                Cᴿ = Bᴿ
                Bᴿ = Tᴿ
            }

            let T = h₁ &+ Cᴸ &+ Dᴿ
            h₁ = h₂ &+ Dᴸ &+ Eᴿ
            h₂ = h₃ &+ Eᴸ &+ Aᴿ
            h₃ = h₄ &+ Aᴸ &+ Bᴿ
            h₄ = h₀ &+ Bᴸ &+ Cᴿ
            h₀ = T
        }

        public func f (j: Int) -> ((UInt32, UInt32, UInt32) -> UInt32) {
            switch j {
            case let index where j < 0:
                assert(false, "Invalid j")
                return {(_, _, _) in 0 }
            case let index where j <= 15:
                return {(x, y, z) in  x ^ y ^ z }
            case let index where j <= 31:
                return {(x, y, z) in  (x & y) | (~x & z) }
            case let index where j <= 47:
                return {(x, y, z) in  (x | ~y) ^ z }
            case let index where j <= 63:
                return {(x, y, z) in  (x & z) | (y & ~z) }
            case let index where j <= 79:
                return {(x, y, z) in  x ^ (y | ~z) }
            default:
                assert(false, "Invalid j")
                return {(_, _, _) in 0 }
            }
        }

        public enum K {
            case Left, Right

            public subscript(j: Int) -> UInt32 {
                switch j {
                case let index where j < 0:
                    assert(false, "Invalid j")
                    return 0
                case let index where j <= 15:
                    return self == .Left ? 0x00000000 : 0x50A28BE6
                case let index where j <= 31:
                    return self == .Left ? 0x5A827999 : 0x5C4DD124
                case let index where j <= 47:
                    return self == .Left ? 0x6ED9EBA1 : 0x6D703EF3
                case let index where j <= 63:
                    return self == .Left ? 0x8F1BBCDC : 0x7A6D76E9
                case let index where j <= 79:
                    return self == .Left ? 0xA953FD4E : 0x00000000
                default:
                    assert(false, "Invalid j")
                    return 0
                    }
            }
        }

        public enum r {
            case Left, Right

            public subscript (j: Int) -> Int {
                switch j {
                case let index where j < 0:
                    assert(false, "Invalid j")
                    return 0
                case let index where j <= 15:
                    if self == .Left {
                        return index
                    } else {
                        return [5,14,7,0,9,2,11,4,13,6,15,8,1,10,3,12][index]
                    }
                case let index where j <= 31:
                    if self == .Left {
                        return [ 7, 4,13, 1,10, 6,15, 3,12, 0, 9, 5, 2,14,11, 8][index - 16]
                    } else {
                        return [ 6,11, 3, 7, 0,13, 5,10,14,15, 8,12, 4, 9, 1, 2][index - 16]
                    }
                case let index where j <= 47:
                    if self == .Left {
                        return [3,10,14,4,9,15,8,1,2,7,0,6,13,11,5,12][index - 32]
                    } else {
                        return [15,5,1,3,7,14,6,9,11,8,12,2,10,0,4,13][index - 32]
                    }
                case let index where j <= 63:
                    if self == .Left {
                        return [1,9,11,10,0,8,12,4,13,3,7,15,14,5,6,2][index - 48]
                    } else {
                        return [8,6,4,1,3,11,15,0,5,12,2,13,9,7,10,14][index - 48]
                    }
                case let index where j <= 79:
                    if self == .Left {
                        return [ 4,0,5,9,7,12,2,10,14,1,3,8,11,6,15,13][index - 64]
                    } else {
                        return [12,15,10,4,1,5,8,7,6,2,13,14,0,3,9,11][index - 64]
                    }

                default:
                    assert(false, "Invalid j")
                    return 0
                }
            }

        }

        public enum s {
            case Left, Right

            public subscript(j: Int) -> Int {
                switch j {
                case let index where j < 0:
                    assert(false, "Invalid j")
                    return 0
                case let index where j <= 15:
                    return (self == .Left ? [11,14,15,12,5,8,7,9,11,13,14,15,6,7,9,8] : [8,9,9,11,13,15,15,5,7,7,8,11,14,14,12,6])[j]
                case let index where j <= 31:
                    return (self == .Left ? [7,6,8,13,11,9,7,15,7,12,15,9,11,7,13,12] : [9,13,15,7,12,8,9,11,7,7,12,7,6,15,13,11])[j - 16]
                case let index where j <= 47:
                    return (self == .Left ? [11,13,6,7,14,9,13,15,14,8,13,6,5,12,7,5] : [9,7,15,11,8,6,6,14,12,13,5,14,13,13,7,5])[j - 32]
                case let index where j <= 63:
                    return (self == .Left ? [11,12,14,15,14,15,9,8,9,14,5,6,8,6,5,12] : [15,5,8,11,14,14,6,14,6,9,12,9,12,5,15,8])[j - 48]
                case let index where j <= 79:
                    return (self == .Left ? [9,15,5,11,6,8,13,12,5,12,13,14,11,8,5,6] : [8,5,12,9,12,5,14,6,8,13,6,5,15,13,11,11])[j - 64]
                default:
                    assert(false, "Invalid j")
                    return 0
                    }
            }

        }

    }


package require ripemd160

puts [ripemd::ripemd160 -hex "Rosetta Code"]


import "/crypto" for Ripemd160
import "/fmt" for Fmt

var strings = [
    "",
    "a",
    "abc",
    "message digest",
    "abcdefghijklmnopqrstuvwxyz",
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
    "12345678901234567890123456789012345678901234567890123456789012345678901234567890",
    "The quick brown fox jumps over the lazy dog",
     "The quick brown fox jumps over the lazy cog",
    "Rosetta Code"
]

for (s in strings) {
    var hash = Ripemd160.digest(s)
    Fmt.print("$s <== '$0s'", hash, s)
}


var MsgHash=Import("zklMsgHash");
MsgHash.RIPEMD160("Rosetta Code")


F rot13(string)
   V r = ‘ ’ * string.len
   L(c) string
      r[L.index] = S c
                      ‘a’..‘z’
                         Char(code' (c.code - ‘a’.code + 13) % 26 + ‘a’.code)
                      ‘A’..‘Z’
                         Char(code' (c.code - ‘A’.code + 13) % 26 + ‘A’.code)
                      E
                         c
   R r

print(rot13(‘foo’))
print(rot13(‘sbb’))


ROT13    CSECT
         USING  ROT13,R15          use calling register
         XPRNT  CC,L'CC
         TR     CC,TABLE           translate
         XPRNT  CC,L'CC
         TR     CC,TABLE           translate
         XPRNT  CC,L'CC
         BR     R14                return to caller
CC       DC     CL10'{NOWHERE!}'
TABLE    DC     CL64' '
*                    0123456789ABCDEF
         DC     CL16'           .<(+|'   X'4.'
         DC     CL16'          !$*);^'   X'5.'
         DC    CL16'&&          ,%_>?'   X'6.'
         DC     CL16'-/       `:#@''="'   X'7.'
         DC     CL16' nopqrstuv      '   X'8.'
         DC     CL16' wxyzabcde      '   X'9.'
         DC     CL16' ~fghijklm   [  '   X'A.'
         DC     CL16'             ]  '   X'B.'
         DC     CL16'{NOPQRSTUV      '   X'C.'
         DC     CL16'}WXYZABCDE      '   X'D.'
         DC     CL16'\ FGHIJKLM      '   X'E.'
         DC     CL16'0123456789      '   X'F.'
*                    0123456789ABCDEF
         YREGS
         END    ROT13


buffer = $fa               ; or anywhere in zero page that's good
maxpage = $95              ; if non-terminated that's bad

org $1900
.rot13
          stx buffer
          sty buffer+1
          ldy #0
          beq readit
.loop     cmp #$7b          ; high range
          bcs next          ; >= {
          cmp #$41          ; low range
          bcc next          ; < A
          cmp #$4e
          bcc add13         ; < N
          cmp #$5b
          bcc sub13set      ; < [
          cmp #$61
          bcc next          ; < a
          cmp #$6e
          bcs sub13         ; >= n
.add13    adc #13           ; we only get here via bcc; so clc not needed
          bne storeit
.sub13set sec               ; because we got here via bcc; so sec is needed
.sub13    sbc #13           ; we can get here via bcs; so sec not needed
.storeit  sta (buffer),y
.next     iny
          bne readit
          ldx buffer+1
          cpx maxpage
          beq done
          inx
          stx buffer+1
.readit   lda (buffer),y    ; quit on ascii 0
          bne loop
.done     rts
.end
save "rot-13", rot13, end


(include-book "arithmetic-3/top" :dir :system)

(defun char-btn (c low high)
   (and (char>= c low)
        (char<= c high)))

(defun rot-13-cs (cs)
   (cond ((endp cs) nil)
         ((or (char-btn (first cs) #\a #\m)
              (char-btn (first cs) #\A #\M))
          (cons (code-char (+ (char-code (first cs)) 13))
                (rot-13-cs (rest cs))))
         ((or (char-btn (first cs) #\n #\z)
              (char-btn (first cs) #\N #\Z))
          (cons (code-char (- (char-code (first cs)) 13))
                (rot-13-cs (rest cs))))
         (t (cons (first cs) (rot-13-cs (rest cs))))))

(defun rot-13 (s)
   (coerce (rot-13-cs (coerce s 'list)) 'string))


with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Command_Line; use Ada.Command_Line;

procedure Rot_13 is

   From_Sequence : Character_Sequence := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
   Result_Sequence : Character_Sequence := "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM";
   Rot_13_Mapping : Character_Mapping := To_Mapping(From_Sequence, Result_Sequence);

   In_Char : Character;
   Stdio : Stream_Access := Stream(Ada.Text_IO.Standard_Input);
   Stdout : Stream_Access := Stream(Ada.Text_Io.Standard_Output);
   Input : Ada.Text_Io.File_Type;

begin
   if Argument_Count > 0 then
      for I in 1..Argument_Count loop
         begin
            Ada.Text_Io.Open(File => Input, Mode => Ada.Text_Io.In_File, Name => Argument(I));
            Stdio := Stream(Input);
             while not Ada.Text_Io.End_Of_File(Input) loop
               In_Char :=Character'Input(Stdio);
               Character'Output(Stdout, Value(Rot_13_Mapping, In_Char));
            end loop;
            Ada.Text_IO.Close(Input);
         exception
            when Ada.Text_IO.Name_Error =>
               Ada.Text_Io.Put_Line(File => Ada.Text_Io.Standard_Error, Item => "File " & Argument(I) & " is not a file.");
            when Ada.Text_Io.Status_Error =>
               Ada.Text_Io.Put_Line(File => Ada.Text_Io.Standard_Error, Item => "File " & Argument(I) & " is already opened.");
         end;
      end loop;
   else
      while not Ada.Text_Io.End_Of_File loop
         In_Char :=Character'Input(Stdio);
         Character'Output(Stdout, Value(Rot_13_Mapping, In_Char));
      end loop;
   end if;
end Rot_13;


BEGIN
  CHAR c;
  on logical file end(stand in, (REF FILE f)BOOL: (stop; SKIP));
  on line end(stand in, (REF FILE f)BOOL: (print(new line); FALSE));
  DO
    read(c);
    IF c >= "A" AND c <= "M" OR c >= "a" AND c <= "m" THEN
      c := REPR(ABS c + 13)
    ELIF c >= "N" AND c <= "Z" OR c >= "n" AND c <= "z" THEN
      c := REPR(ABS c - 13)
    FI;
    print(c)
  OD
END # rot13 #


to rot13(textString)
    do shell script "tr a-zA-Z n-za-mN-ZA-M <<<" & quoted form of textString
end rot13


rot13: function [c][
    case [in? lower c]
        when? -> `a`..`m` -> return to :char (to :integer c) + 13
        when? -> `n`..`z` -> return to :char (to :integer c) - 13
        else  -> return c
]

loop "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" 'ch
    -> prints rot13 ch

print ""


ROT13(string) ; by Raccoon July-2009
{
  Static a := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ "
  Static b := "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM "
  s=
  Loop, Parse, string
  {
    c := substr(b,instr(a,A_LoopField,True),1)
    if (c != " ")
      s .= c
    else
      s .= A_LoopField
  }
  Return s
}


# usage: awk -f rot13.awk
BEGIN {
  for(i=0; i < 256; i++) {
    amap[sprintf("%c", i)] = i
  }
  for(l=amap["a"]; l <= amap["z"]; l++) {
    rot13[l] = sprintf("%c", (((l-amap["a"])+13) % 26 ) + amap["a"])
  }
  FS = ""
}
{
  o = ""
  for(i=1; i <= NF; i++) {
    if ( amap[tolower($i)] in rot13 ) {
      c = rot13[amap[tolower($i)]]
      if ( tolower($i) != $i ) c = toupper(c)
      o = o c
    } else {
      o = o $i
    }
  }
  print o
}


INPUT "String: ", s$
PRINT "Output: ", REPLACE$(s$, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM", 2)


CLS
INPUT "Enter a string: ", s$
ans$ = ""
FOR a = 1 TO LEN(s$)
        letter$ = MID$(s$, a, 1)
        IF letter$ >= "A" AND letter$ <= "Z" THEN
                char$ = CHR$(ASC(letter$) + 13)
                IF char$ > "Z" THEN char$ = CHR$(ASC(char$) - 26)
        ELSEIF letter$ >= "a" AND letter$ <= "z" THEN
                char$ = CHR$(ASC(letter$) + 13)
                IF char$ > "z" THEN char$ = CHR$(ASC(char$) - 26)
        ELSE
                char$ = letter$
        END IF
        ans$ = ans$ + char$
NEXT a
PRINT ans$


# rot13 Cipher v2.0
# basic256 1.1.4.0
# 2101031238

dec$ = ""
TYPE$ = "cleartext "
ctext$ = ""
sp = 0
iOffset = 13             #offset assumed TO be 13 - uncomment LINE 11 TO change

INPUT "For decrypt enter " + "<d> " + " -- else press enter > ",dec$
# INPUT "Enter offset > ", iOffset

IF dec$ = "d" OR dec$ = "D" THEN
    iOffset = 26 - iOffset
    TYPE$ = "ciphertext "
END IF

INPUT "Enter " + TYPE$ + "> ", STR$
STR$ = upper(STR$)

FOR i = 1 TO length(STR$)
    iTemp =  ASC(mid(STR$,i,1))
    IF iTemp > 64 AND iTemp < 91 THEN
           iTemp = ((iTemp - 65) + iOffset) % 26
           PRINT chr(iTemp + 65);
           sp = sp + 1
           IF sp = 5 THEN
              PRINT(' ');
              sp = 0
           endif
    endif
NEXT i