" < \v-1/<>">elb"
+<^ >:#,_$10 |!:<>\#v_ vv"ta"
+v-",":\-"&":\-"<":\<>5#05#"/"v
+>#v_$$$0">dt<>dt/<"vv"tr>"+<5 v"<"<
+>^>\#v_$$0";pma&" v>"/<>d"v5 v , <
+$ > \#v_$0";tl&"v v" : |
+^_>#!,#:<>#<0#<\#<<< >:#,_$#^_v@ $<
diff --git a/Task/CSV-to-HTML-translation/Befunge/csv-to-html-translation-2.bf b/Task/CSV-to-HTML-translation/Befunge/csv-to-html-translation-2.bf
new file mode 100644
index 0000000000..0b77e5d433
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Befunge/csv-to-html-translation-2.bf
@@ -0,0 +1,8 @@
+
+| Character | Speech |
+| The multitude | The messiah! Show us the messiah! |
+| Brians mother | <angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry> |
+| The multitude | Who are you? |
+| Brians mother | I'm his mother; that's who! |
+| The multitude | Behold his mother! Behold his mother! |
+
diff --git a/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-1.bracmat b/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-1.bracmat
new file mode 100644
index 0000000000..76229ed672
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-1.bracmat
@@ -0,0 +1,31 @@
+( ( CSVtoHTML
+ = p q Character Speech swor rows row
+ . 0:?p
+ & :?swor:?rows
+ & ( @( !arg
+ : ?
+ ( [!p ?Character "," ?Speech \n [?q ?
+ & !q:?p
+ & (tr.,(td.,!Character) (td.,!Speech))
+ !swor
+ : ?swor
+ & ~
+ )
+ )
+ | whl
+ ' ( !swor:%?row %?swor
+ & !row \n !rows:?rows
+ )
+ & toML
+ $ (table.,(thead.,!swor) \n (tbody.,!rows))
+ )
+ )
+& CSVtoHTML
+ $ "Character,Speech
+The multitude,The messiah! Show us the messiah!
+Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!
+The multitude,Who are you?
+Brians mother,I'm his mother; that's who!
+The multitude,Behold his mother! Behold his mother!
+"
+)
diff --git a/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-2.bracmat b/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-2.bracmat
new file mode 100644
index 0000000000..0b206f3076
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Bracmat/csv-to-html-translation-2.bracmat
@@ -0,0 +1,7 @@
+| Character | Speech |
+| The multitude | The messiah! Show us the messiah! |
+| Brians mother | <angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry> |
+| The multitude | Who are you? |
+| Brians mother | I'm his mother; that's who! |
+| The multitude | Behold his mother! Behold his mother! |
+
diff --git a/Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation.euphoria b/Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation-1.euphoria
similarity index 100%
rename from Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation.euphoria
rename to Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation-1.euphoria
diff --git a/Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation-2.euphoria b/Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation-2.euphoria
new file mode 100644
index 0000000000..0964db10ff
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Euphoria/csv-to-html-translation-2.euphoria
@@ -0,0 +1,8 @@
+
+| Character | Speech |
+| The multitude | The messiah! Show us the messiah! |
+| Brians mother | <angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry> |
+| The multitude | Who are you? |
+| Brians mother | I'm his mother; that's who! |
+| The multitude | Behold his mother! Behold his mother! |
+
diff --git a/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-1.julia b/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-1.julia
new file mode 100644
index 0000000000..1aed96274e
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-1.julia
@@ -0,0 +1,66 @@
+function csv2html(fname::ASCIIString; header::Bool=false)
+ csv = readcsv(fname)
+ @assert(length(csv) > 0)
+ str = """
+
+
+
+
+
+
+
+ csv2html Example
+
+
+"""
+ tags = header ? ("| ", " | ") : ("", " | ")
+
+ for i=1:size(csv, 2)
+ str *= " " * tags[1] * csv[1, i] * tags[2] * "\n"
+ end
+
+ str *= " "^8 * " \n"
+
+ for i=2:size(csv, 1)
+ str *= " \n"
+
+ for j=1:size(csv, 2)
+ str *= " " * "| " * csv[i, j] * " | \n"
+ end
+
+ str *= " \n"
+ end
+
+ str * " \n\n\n\n"
+end
+
+print(csv2html("input.csv", header=true))
diff --git a/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-2.julia b/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-2.julia
new file mode 100644
index 0000000000..930691c88b
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/Julia/csv-to-html-translation-2.julia
@@ -0,0 +1,66 @@
+
+
+
+
+
+
+
+ csv2html Example
+
+
+ | Character |
+ Speech |
+
+
+ | The multitude |
+ The messiah! Show us the messiah! |
+
+
+ | Brians mother |
+ Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! |
+
+
+ | The multitude |
+ Who are you? |
+
+
+ | Brians mother |
+ I'm his mother; that's who! |
+
+
+ | The multitude |
+ Behold his mother! Behold his mother! |
+
+
+
+
+
diff --git a/Task/CSV-to-HTML-translation/Perl-6/csv-to-html-translation-1.pl6 b/Task/CSV-to-HTML-translation/Perl-6/csv-to-html-translation-1.pl6
index 488d58fcf5..c171689eae 100644
--- a/Task/CSV-to-HTML-translation/Perl-6/csv-to-html-translation-1.pl6
+++ b/Task/CSV-to-HTML-translation/Perl-6/csv-to-html-translation-1.pl6
@@ -8,7 +8,7 @@ The multitude,Behold his mother! Behold his mother!";
# comment the next line out, if you want to read from standard input instead of the hard-coded $str above
# my $str = $*IN.slurp;
-my &escape = *.trans([ <& < \>>] => [<& < >> ]); # a function with one argument that escapes the entities
+my &escape = *.trans(« & < > » => « & < > »); # a function with one argument that escapes the entities
my &tag = {"<$^tag>"~$^what~""};
printf
diff --git a/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx b/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx
index 718c9ae479..8c082edb34 100644
--- a/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx
+++ b/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx
@@ -1,17 +1,17 @@
-/*REXX program to convert CSV ───► HTML table representing the CSV data.*/
-arg header_ . /*see if the user wants a header.*/
-wantsHdr= (header_=='HEADER') /*arg (low/upp/mix case)=HEADER ?*/
+/*REXX program converts CSV ───► HTML table representing the CSV data. */
+arg header_ . /*determine if the user wants a header.*/
+wantsHdr= (header_=='HEADER') /*is the arg (low/upp/mix case)=HEADER?*/
- iFID= 'CSV_HTML.TXT' /*the input fileID. */
-if wantsHdr then oFID= 'OUTPUTH.HTML' /*output fileID with header, */
- else oFID= 'OUTPUT.HTML' /* " " without header. */
+ iFID= 'CSV_HTML.TXT' /*the input fileID to be used. */
+if wantsHdr then oFID= 'OUTPUTH.HTML' /*the output fileID with header.*/
+ else oFID= 'OUTPUT.HTML' /* " " " without " */
- do rows=0 while lines(iFID)\==0 /*read the rows from a (txt) file*/
+ do rows=0 while lines(iFID)\==0 /*read the rows from a (text/txt) file.*/
row.rows=strip(linein(iFID))
end /*rows*/
-convFrom= '& < > "' /*special characters to convert. */
-convTo = '& < > "' /*what they are converted into. */
+convFrom= '& < > "' /*special characters to be converted. */
+convTo = '& < > "' /*display what they are converted into.*/
call write , ''
call write , ''
@@ -22,7 +22,7 @@ call write , ''
do while row.j\==''; parse var row.j yyy ',' row.j
do k=1 for words(convFrom)
- yyy=changestr(word(convFrom,k),yyy,word(convTo,k))
+ yyy=changestr(word(convFrom, k), yyy, word(convTo, k))
end /*k*/
call write 10, '<'tx">"yyy'"
end /*forever*/
@@ -31,6 +31,6 @@ call write , ''
call write 5, ''
call write , ' '
call write , ''
-exit /*stick a fork in it, we're done.*/
-/*──────────────────────────────────WRITE subroutine────────────────────*/
-write: call lineout oFID, left('', 0 || arg(1))arg(2); return
+exit /*stick a fork in it, we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+write: call lineout oFID, left('', 0 || arg(1))arg(2); return
diff --git a/Task/CSV-to-HTML-translation/VBScript/csv-to-html-translation.vb b/Task/CSV-to-HTML-translation/VBScript/csv-to-html-translation.vb
new file mode 100644
index 0000000000..2eadb9ed6f
--- /dev/null
+++ b/Task/CSV-to-HTML-translation/VBScript/csv-to-html-translation.vb
@@ -0,0 +1,33 @@
+Set objfso = CreateObject("Scripting.FileSystemObject")
+
+parent_folder = objfso.GetParentFolderName(WScript.ScriptFullName) & "\"
+
+Set objcsv = objfso.OpenTextFile(parent_folder & "in.csv",1,False)
+Set objhtml = objfso.OpenTextFile(paren_folder & "out.html",2,True)
+
+objhtml.Write(csv_to_html(objcsv.ReadAll))
+
+objcsv.Close
+objhtml.Close
+Set objfso = Nothing
+
+Function csv_to_html(s)
+ row = Split(s,vbCrLf)
+ 'write the header
+ tmp = " "
+ For i = 0 To UBound(row)
+ field = Split(row(i),",")
+ If i = 0 Then
+ tmp = tmp & "| " & replace_chars(field(0)) & " | " & replace_chars(field(1)) & " |
|---|
"
+ Else
+ tmp = tmp & " | " & replace_chars(field(0)) & " | " & replace_chars(field(1)) & " | "
+ End If
+ Next
+ 'write the footer
+ tmp = tmp & " "
+ csv_to_html = tmp
+End Function
+
+Function replace_chars(s)
+ replace_chars = Replace(Replace(s,"<","<"),">",">")
+End Function
diff --git a/Task/Caesar-cipher/00DESCRIPTION b/Task/Caesar-cipher/00DESCRIPTION
index eba31cd869..56ad11ee6f 100644
--- a/Task/Caesar-cipher/00DESCRIPTION
+++ b/Task/Caesar-cipher/00DESCRIPTION
@@ -9,3 +9,9 @@ This simple "monoalphabetic substitution cipher" provides almost no security, be
Caesar cipher is identical to [[Vigenère cipher]] with a key of length 1.
Also, [[Rot-13]] is identical to Caesar cipher with key 13.
+
+;See also:
+* [[Rot-13]]
+* [[Substitution Cipher]]
+* [[Vigenère Cipher/Cryptanalysis]]
+
diff --git a/Task/Caesar-cipher/Befunge/caesar-cipher-1.bf b/Task/Caesar-cipher/Befunge/caesar-cipher-1.bf
new file mode 100644
index 0000000000..850897e5a3
--- /dev/null
+++ b/Task/Caesar-cipher/Befunge/caesar-cipher-1.bf
@@ -0,0 +1,3 @@
+65+>>>>10p100p1>:v:+>#*,#g1#0-#0:#!<<
+"`"::_@#!`\*84:<~<$<^+"A"%*2+9\`*48
diff --git a/Task/Caesar-cipher/Befunge/caesar-cipher-2.bf b/Task/Caesar-cipher/Befunge/caesar-cipher-2.bf
new file mode 100644
index 0000000000..ff3597d146
--- /dev/null
+++ b/Task/Caesar-cipher/Befunge/caesar-cipher-2.bf
@@ -0,0 +1,3 @@
+65+>>>>10p100p1>:v:+>#*,#g1#0-#0:#!<<
+"`"::_@#!`\*84:<~<$<^+"A"%*2+9\`*48
diff --git a/Task/Caesar-cipher/Elena/caesar-cipher.elena b/Task/Caesar-cipher/Elena/caesar-cipher.elena
index 9df8aff7d5..cc3b8381b7 100644
--- a/Task/Caesar-cipher/Elena/caesar-cipher.elena
+++ b/Task/Caesar-cipher/Elena/caesar-cipher.elena
@@ -1,74 +1,71 @@
#define system.
#define system'routines.
-#define extensions.
#define system'math.
-
-// --- Constants ---
+#define extensions.
#symbol Letters = "abcdefghijklmnopqrstuvwxyz".
#symbol BigLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
#symbol TestText = "Pack my box with five dozen liquor jugs.".
#symbol Key = 12.
-// --- Encrypt / Decript ---
-
-#class Encrypting
+#class Encrypting :: Enumerator
{
#field theKey.
- #field theExtendee.
+ #field theEnumerator.
- #constructor new : aKey &extending:anObject
+ #constructor new &key:aKey &text:aText
[
theKey := aKey.
- theExtendee := anObject.
+ theEnumerator := aText enumerator.
]
- #method eval : aChar
+ #method next => theEnumerator.
+
+ #method reset => theEnumerator.
+
+ #method get
[
- #var anIndex := Letters indexOf &index:0 &char:aChar.
+ #var aChar := theEnumerator get.
+
+ #var anIndex := Letters indexOf:0:aChar.
(-1 < anIndex)
? [
- theExtendee eval:(Letters @ ((theKey+anIndex) int mod:26))
+ ^ Letters @ ((theKey+anIndex) mod:26).
]
! [
- anIndex := BigLetters indexOf &index:0 &char:aChar.
+ anIndex := BigLetters indexOf:0:aChar.
(-1 < anIndex)
? [
- theExtendee eval:(BigLetters @ ((theKey+anIndex) int mod:26))
+ ^ BigLetters @ ((theKey+anIndex) mod:26).
]
! [
- theExtendee eval:aChar.
+ ^ aChar.
].
].
]
-
- #method => theExtendee.
}
-// --- Functions ---
+#class(extension)encryptOp
+{
+ #method encrypt : aKey
+ = Encrypting new &key:aKey &text:self summarize:(String new).
-#symbol encrypt = (:aText:aKey)
- [ Encrypting new:aKey &extending:(Summing new:(String new)) foreach:aText literal ].
-
-#symbol decrypt = (:aText:aKey)
- [ Encrypting new:(26 - aKey) &extending:(Summing new:(String new)) foreach:aText literal ].
-
-// --- Program ---
+ #method decrypt :aKey
+ = Encrypting new &key:(26 - aKey) &text:self summarize:(String new).
+}
#symbol program =
[
- #var anS := TestText.
+ console writeLine:"Original text :" :TestText.
- consoleEx writeLine:"Original text :" :anS.
+ #var anEncryptedText := TestText encrypt:Key.
- anS := encrypt:anS:Key.
+ console writeLine:"Encrypted text:" :anEncryptedText.
- consoleEx writeLine:"Encrypted text:" :anS.
+ #var aDecryptedText := anEncryptedText decrypt:Key.
- anS := decrypt:anS:Key.
+ console writeLine:"Decrypted text:" :aDecryptedText.
- consoleEx writeLine:"Decrypted text:" :anS.
-
- consoleEx readChar.
+ console readChar.
].
diff --git a/Task/Caesar-cipher/Elixir/caesar-cipher.elixir b/Task/Caesar-cipher/Elixir/caesar-cipher.elixir
new file mode 100644
index 0000000000..7c6141999a
--- /dev/null
+++ b/Task/Caesar-cipher/Elixir/caesar-cipher.elixir
@@ -0,0 +1,18 @@
+defmodule Caesar_cipher do
+ defp set_map(map, range, key) do
+ org = Enum.map(range, &List.to_string [&1])
+ {a, b} = Enum.split(org, key)
+ Enum.zip(org, b ++ a) |> Enum.into(map)
+ end
+
+ def encode(text, key) do
+ map = Map.new |> set_map(?a..?z, key) |> set_map(?A..?Z, key)
+ String.codepoints(text) |> Enum.map_join(fn c -> Dict.get(map, c, c) end)
+ end
+end
+
+text = "The five boxing wizards jump quickly"
+key = 3
+IO.puts "Original: #{text}"
+IO.puts "Encrypted: #{enc = Caesar_cipher.encode(text, key)}"
+IO.puts "Decrypted: #{Caesar_cipher.encode(enc, -key)}"
diff --git a/Task/Caesar-cipher/R/caesar-cipher.r b/Task/Caesar-cipher/R/caesar-cipher.r
new file mode 100644
index 0000000000..283d761aa9
--- /dev/null
+++ b/Task/Caesar-cipher/R/caesar-cipher.r
@@ -0,0 +1,26 @@
+# based on Rot-13 solution: http://rosettacode.org/wiki/Rot-13#R
+ceasar <- function(x, key)
+{
+ # if key is negative, wrap to be positive
+ if (key < 0) {
+ key <- 26 + key
+ }
+
+ old <- paste(letters, LETTERS, collapse="", sep="")
+ new <- paste(substr(old, key * 2 + 1, 52), substr(old, 1, key * 2), sep="")
+ chartr(old, new, x)
+}
+
+# simple examples from description
+print(ceasar("hi",2))
+print(ceasar("hi",20))
+
+# more advanced example
+key <- 3
+plaintext <- "The five boxing wizards jump quickly."
+cyphertext <- ceasar(plaintext, key)
+decrypted <- ceasar(cyphertext, -key)
+
+print(paste(" Plain Text: ", plaintext, sep=""))
+print(paste(" Cypher Text: ", cyphertext, sep=""))
+print(paste("Decrypted Text: ", decrypted, sep=""))
diff --git a/Task/Calendar---for-REAL-programmers/Common-Lisp/calendar---for-real-programmers.lisp b/Task/Calendar---for-REAL-programmers/Common-Lisp/calendar---for-real-programmers.lisp
new file mode 100644
index 0000000000..779ecb7bef
--- /dev/null
+++ b/Task/Calendar---for-REAL-programmers/Common-Lisp/calendar---for-real-programmers.lisp
@@ -0,0 +1,75 @@
+(QL:QUICKLOAD '(DATE-CALC))
+
+(DEFPARAMETER *DAY-ROW* "SU MO TU WE TH FR SA")
+(DEFPARAMETER *CALENDAR-MARGIN* 3)
+
+(DEFUN MONTH-TO-WORD (MONTH)
+ "TRANSLATE A MONTH FROM 1 TO 12 INTO ITS WORD REPRESENTATION."
+ (SVREF #("JANUARY" "FEBRUARY" "MARCH" "APRIL"
+ "MAY" "JUNE" "JULY" "AUGUST"
+ "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER")
+ (1- MONTH)))
+
+(DEFUN MONTH-STRINGS (YEAR MONTH)
+ "COLLECT ALL OF THE STRINGS THAT MAKE UP A CALENDAR FOR A GIVEN
+MONTH AND YEAR."
+ `(,(DATE-CALC:CENTER (MONTH-TO-WORD MONTH) (LENGTH *DAY-ROW*))
+ ,*DAY-ROW*
+ ;; WE CAN ASSUME THAT A MONTH CALENDAR WILL ALWAYS FIT INTO A 7 BY 6 BLOCK
+ ;; OF VALUES. THIS MAKES IT EASY TO FORMAT THE RESULTING STRINGS.
+ ,@ (LET ((DAYS (MAKE-ARRAY (* 7 6) :INITIAL-ELEMENT NIL)))
+ (LOOP :FOR I :FROM (DATE-CALC:DAY-OF-WEEK YEAR MONTH 1)
+ :FOR DAY :FROM 1 :TO (DATE-CALC:DAYS-IN-MONTH YEAR MONTH)
+ :DO (SETF (AREF DAYS I) DAY))
+ (LOOP :FOR I :FROM 0 :TO 5
+ :COLLECT
+ (FORMAT NIL "~{~:[ ~;~2,D~]~^ ~}"
+ (LOOP :FOR DAY :ACROSS (SUBSEQ DAYS (* I 7) (+ 7 (* I 7)))
+ :APPEND (IF DAY (LIST DAY DAY) (LIST DAY))))))))
+
+(DEFUN CALC-COLUMNS (CHARACTERS MARGIN-SIZE)
+ "CALCULATE THE NUMBER OF COLUMNS GIVEN THE NUMBER OF CHARACTERS PER
+COLUMN AND THE MARGIN-SIZE BETWEEN THEM."
+ (MULTIPLE-VALUE-BIND (COLS EXCESS)
+ (TRUNCATE CHARACTERS (+ MARGIN-SIZE (LENGTH *DAY-ROW*)))
+ (INCF EXCESS MARGIN-SIZE)
+ (IF (>= EXCESS (LENGTH *DAY-ROW*))
+ (1+ COLS)
+ COLS)))
+
+(DEFUN TAKE (N LIST)
+ "TAKE THE FIRST N ELEMENTS OF A LIST."
+ (LOOP :REPEAT N :FOR X :IN LIST :COLLECT X))
+
+(DEFUN DROP (N LIST)
+ "DROP THE FIRST N ELEMENTS OF A LIST."
+ (COND ((OR (<= N 0) (NULL LIST)) LIST)
+ (T (DROP (1- N) (CDR LIST)))))
+
+(DEFUN CHUNKS-OF (N LIST)
+ "SPLIT THE LIST INTO CHUNKS OF SIZE N."
+ (ASSERT (> N 0))
+ (LOOP :FOR X := LIST :THEN (DROP N X)
+ :WHILE X
+ :COLLECT (TAKE N X)))
+
+(DEFUN PRINT-CALENDAR (YEAR &KEY (CHARACTERS 80) (MARGIN-SIZE 3))
+ "PRINT OUT THE CALENDAR FOR A GIVEN YEAR, OPTIONALLY SPECIFYING
+A WIDTH LIMIT IN CHARACTERS AND MARGIN-SIZE BETWEEN MONTHS."
+ (ASSERT (>= CHARACTERS (LENGTH *DAY-ROW*)))
+ (ASSERT (>= MARGIN-SIZE 0))
+ (LET* ((CALENDARS (LOOP :FOR MONTH :FROM 1 :TO 12
+ :COLLECT (MONTH-STRINGS YEAR MONTH)))
+ (COLUMN-COUNT (CALC-COLUMNS CHARACTERS MARGIN-SIZE))
+ (TOTAL-SIZE (+ (* COLUMN-COUNT (LENGTH *DAY-ROW*))
+ (* (1- COLUMN-COUNT) MARGIN-SIZE)))
+ (FORMAT-STRING (CONCATENATE 'STRING
+ "~{~A~^~" (WRITE-TO-STRING MARGIN-SIZE) ",0@T~}~%")))
+ (FORMAT T "~A~%~A~%~%"
+ (DATE-CALC:CENTER "[SNOOPY]" TOTAL-SIZE)
+ (DATE-CALC:CENTER (WRITE-TO-STRING YEAR) TOTAL-SIZE))
+ (LOOP :FOR ROW :IN (CHUNKS-OF COLUMN-COUNT CALENDARS)
+ :DO (APPLY 'MAPCAR
+ (LAMBDA (&REST HEADS)
+ (FORMAT T FORMAT-STRING HEADS))
+ ROW))))
diff --git a/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena b/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena
index c06d704c47..3981855392 100644
--- a/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena
+++ b/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena
@@ -6,8 +6,6 @@
#define extensions'math.
#define extensions'routines.
-// --- calendar ---
-
#symbol MonthNames = ("JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER").
#symbol DayNames = ("MO", "TU", "WE", "TH", "FR", "SA", "SU").
@@ -19,60 +17,67 @@
#field theYear.
#field theRow.
- #constructor new &Year:aYear &Month:aMonth
+ #constructor new &year:aYear &month:aMonth
[
theMonth := aMonth.
theYear := aYear.
theLine := TextBuffer new.
- theRow := Integer new.
+ theRow := Integer new &int:0.
]
- #method firstLine : aDay
+ #method writeTitle
[
theRow << 0.
- theDate := Date new &Year:theYear &Month:theMonth &Day:aDay.
- control foreach:DayNames &do: aName
- [ theLine write:" " write:aName ].
+ theDate := Date new &year:(theYear int) &month:(theMonth int) &day:1.
+ DayNames run &each: aName
+ [ theLine writeLiteral:" ":aName ].
]
- #method nextLine
+ #method writeLine
[
theLine clear.
- (theDate Month == theMonth)
+ (theDate month == theMonth)
? [
- theLine~stringOp write:" " &length:(((theDate DayOfWeek) => 0 ? [ 7 ] ! [ theDate DayOfWeek ]) subtract:1 int).
+ theLine write:" " &length:(((theDate dayOfWeek) => 0 ? [ 7 ] ! [ theDate dayOfWeek ]) - 1).
control do:
[
- theLine~stringOp write:(theDate Day) &paddingLeft:3 &with:" ".
+ theLine write:(theDate day literal) &paddingLeft:3 &with:#32.
- theDate := theDate add &Days:1.
+ theDate := theDate add &days:1.
]
- &until:[(theDate Month != theMonth)or:[theDate DayOfWeek == 1]].
+ &until:[(theDate month != theMonth)or:[theDate dayOfWeek == 1]].
].
#var(type:int) aLength := theLine length.
(aLength < 21)
- ? [ theLine~stringOp write:" " &length:(21 - aLength). ].
+ ? [ theLine write:" " &length:(21 - aLength). ].
theRow += 1.
-
- ^ theRow < 7.
]
- #method enumerator =
+ #method iterator = Iterator
{
- set &index:anIndex [ self firstLine:(anIndex + 1) ]
+ available = theRow < 7.
- next [ ^ self nextLine. ]
+ readIndex &vint:anIndex [ anIndex << theRow int. ]
+
+ write &index:anIndex
+ [
+ (anIndex <= theRow)
+ ? [ self writeTitle. ].
+
+ #loop (anIndex > theRow) ?
+ [ self writeLine. ].
+ ]
get = self.
}.
#method printTitleTo : anOutput
[
- anOutput~stringOp write:(MonthNames @(theMonth - 1)) &padding:21 &with:" ".
+ anOutput write:(MonthNames @(theMonth - 1)) &padding:21 &with:#32.
]
#method printTo : anOutput
@@ -83,8 +88,8 @@
#class Calendar
{
- #field theYear.
- #field theRowLength.
+ #field(type:int) theYear.
+ #field(type:int) theRowLength.
#constructor new : aYear
[
@@ -94,15 +99,19 @@
#method printTo:anOutput
[
- anOutput~stringOp write:"[SNOOPY]" &padding:(theRowLength * 25) &with:" " writeLine.
- anOutput~stringOp write:theYear &padding:(theRowLength * 25) &with:" " writeLine writeLine.
+ anOutput write:"[SNOOPY]" &padding:(theRowLength * 25) &with:#32.
+ anOutput writeLine.
+ anOutput write:(theYear literal) &padding:(theRowLength * 25) &with:#32.
+ anOutput writeLine writeLine.
#var aRowCount := 12 / theRowLength.
- #var Months := matrixControl new &m:aRowCount &n:theRowLength &each: (:i:j) [ CalendarMonthPrinter new &Year:theYear &Month:(i * theRowLength + j + 1) ].
+ #var Months := Array new &length:aRowCount set &every:(&index:i)
+ [ Array new &length:theRowLength set &every:(&index:j)
+ [ CalendarMonthPrinter new &year:(theYear int) &month:((i * theRowLength + j + 1) int) ]].
- control foreach:Months &do: aRow
+ Months run &each: aRow
[
- control foreach:aRow &do: aMonth
+ aRow run &each: aMonth
[
aMonth printTitleTo:anOutput.
@@ -111,9 +120,9 @@
anOutput writeLine.
- control for:(ParallelEnumerator new:aRow) &do: aLine
+ ParallelEnumerator new:aRow run &each: aLine
[
- control foreach:aLine &do: aPrinter
+ aLine run &each: aPrinter
[
aPrinter printTo:anOutput.
@@ -123,17 +132,14 @@
anOutput writeLine.
].
].
-
]
}
-// --- program ---
-
#symbol program =
[
- #var aCalender := Calendar new:(consoleEx write:"Enter the year:" readLine:(Integer new)).
+ #var aCalender := Calendar new:(console write:"ENTER THE YEAR:" readLine:(Integer new)).
- aCalender printTo:consoleEx.
+ aCalender printTo:console.
- consoleEx readChar.
+ console readChar.
].
diff --git a/Task/Calendar---for-REAL-programmers/Fortran/calendar---for-real-programmers.f b/Task/Calendar---for-REAL-programmers/Fortran/calendar---for-real-programmers.f
new file mode 100644
index 0000000000..a7c32fe603
--- /dev/null
+++ b/Task/Calendar---for-REAL-programmers/Fortran/calendar---for-real-programmers.f
@@ -0,0 +1,175 @@
+ MODULE DATEGNASH
+
+ TYPE DATEBAG
+ INTEGER DAY,MONTH,YEAR
+ END TYPE DATEBAG
+
+ CHARACTER*9 MONTHNAME(12),DAYNAME(0:6)
+ PARAMETER (MONTHNAME = (/"JANUARY","FEBRUARY","MARCH","APRIL",
+ 1 "MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER",
+ 2 "DECEMBER"/))
+ PARAMETER (DAYNAME = (/"SUNDAY","MONDAY","TUESDAY","WEDNESDAY",
+ 1 "THURSDAY","FRIDAY","SATURDAY"/))
+
+ INTEGER*4 JDAYSHIFT
+ PARAMETER (JDAYSHIFT = 2415020)
+ CONTAINS
+ INTEGER FUNCTION LSTNB(TEXT)
+ CHARACTER*(*),INTENT(IN):: TEXT
+ INTEGER L
+ L = LEN(TEXT)
+ 1 IF (L.LE.0) GO TO 2
+ IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2
+ L = L - 1
+ GO TO 1
+ 2 LSTNB = L
+ RETURN
+ END FUNCTION LSTNB
+ CHARACTER*2 FUNCTION I2FMT(N)
+ INTEGER*4 N
+ IF (N.LT.0) THEN
+ IF (N.LT.-9) THEN
+ I2FMT = "-!"
+ ELSE
+ I2FMT = "-"//CHAR(ICHAR("0") - N)
+ END IF
+ ELSE IF (N.LT.10) THEN
+ I2FMT = " " //CHAR(ICHAR("0") + N)
+ ELSE IF (N.LT.100) THEN
+ I2FMT = CHAR(N/10 + ICHAR("0"))
+ 1 //CHAR(MOD(N,10) + ICHAR("0"))
+ ELSE
+ I2FMT = "+!"
+ END IF
+ END FUNCTION I2FMT
+ CHARACTER*8 FUNCTION I8FMT(N)
+ INTEGER*4 N
+ CHARACTER*8 HIC
+ WRITE (HIC,1) N
+ 1 FORMAT (I8)
+ I8FMT = HIC
+ END FUNCTION I8FMT
+
+ SUBROUTINE SAY(OUT,TEXT)
+ INTEGER OUT
+ CHARACTER*(*) TEXT
+ WRITE (6,1) TEXT(1:LSTNB(TEXT))
+ 1 FORMAT (A)
+ END SUBROUTINE SAY
+
+ INTEGER*4 FUNCTION DAYNUM(YY,M,D)
+ INTEGER*4 JDAYN
+ INTEGER YY,Y,M,MM,D
+ Y = YY
+ IF (Y.LT.1) Y = Y + 1
+ MM = (M - 14)/12
+ JDAYN = D - 32075
+ A + 1461*(Y + 4800 + MM)/4
+ B + 367*(M - 2 - MM*12)/12
+ C - 3*((Y + 4900 + MM)/100)/4
+ DAYNUM = JDAYN - JDAYSHIFT
+ END FUNCTION DAYNUM
+
+ TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM)
+ INTEGER*4 DAYNUM,JDAYN
+ INTEGER Y,M,D,L,N
+ JDAYN = DAYNUM + JDAYSHIFT
+ L = JDAYN + 68569
+ N = 4*L/146097
+ L = L - (146097*N + 3)/4
+ Y = 4000*(L + 1)/1461001
+ L = L - 1461*Y/4 + 31
+ M = 80*L/2447
+ D = L - 2447*M/80
+ L = M/11
+ M = M + 2 - 12*L
+ Y = 100*(N - 49) + Y + L
+ IF (Y.LT.1) Y = Y - 1
+ MUNYAD%YEAR = Y
+ MUNYAD%MONTH = M
+ MUNYAD%DAY = D
+ END FUNCTION MUNYAD
+
+ INTEGER FUNCTION PMOD(N,M)
+ INTEGER N,M
+ PMOD = MOD(MOD(N,M) + M,M)
+ END FUNCTION PMOD
+
+ SUBROUTINE CALENDAR(Y1,Y2,COLUMNS)
+
+ INTEGER Y1,Y2,YEAR
+ INTEGER M,M1,M2,MONTH
+ INTEGER*4 DN1,DN2,DN,D
+ INTEGER W,G
+ INTEGER L,LINE
+ INTEGER COL,COLUMNS,COLWIDTH
+ CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE
+ W = 3
+ G = 1
+ COLWIDTH = 7*W + G
+ Y:DO YEAR = Y1,Y2
+ CALL SAY(MSG,"")
+ IF (YEAR.EQ.0) THEN
+ CALL SAY(MSG,"THERE IS NO YEAR ZERO.")
+ CYCLE Y
+ END IF
+ MLINE = ""
+ L = (COLUMNS*COLWIDTH - G - 8)/2
+ IF (YEAR.GT.0) THEN
+ MLINE(L:) = I8FMT(YEAR)
+ ELSE
+ MLINE(L - 1:) = I8FMT(-YEAR)//"BC"
+ END IF
+ CALL SAY(MSG,MLINE)
+ DO MONTH = 1,12,COLUMNS
+ M1 = MONTH
+ M2 = MIN(12,M1 + COLUMNS - 1)
+ MLINE = ""
+ DLINE = ""
+ STRIPE = ""
+ SPECIAL = ""
+ L0 = 1
+ DO M = M1,M2
+ L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1
+ MLINE(L0 + L:) = MONTHNAME(M)
+ DO D = 0,6
+ L = L0 + (3 - W) + D*W
+ DLINE(L:L + 2) = DAYNAME(D)(1:W - 1)
+ END DO
+ DN1 = DAYNUM(YEAR,M,1)
+ DN2 = DAYNUM(YEAR,M + 1,0)
+ COL = MOD(PMOD(DN1,7) + 7,7)
+ LINE = 1
+ D = 1
+ DO DN = DN1,DN2
+ L = L0 + COL*W
+ STRIPE(LINE)(L:L + 1) = I2FMT(D)
+ D = D + 1
+ COL = COL + 1
+ IF (COL.GT.6) THEN
+ LINE = LINE + 1
+ COL = 0
+ END IF
+ END DO
+ L0 = L0 + 7*W + G
+ END DO
+ CALL SAY(MSG,MLINE)
+ CALL SAY(MSG,DLINE)
+ DO LINE = 1,6
+ IF (STRIPE(LINE).NE."") THEN
+ CALL SAY(MSG,STRIPE(LINE))
+ END IF
+ END DO
+ END DO
+ END DO Y
+ CALL SAY(MSG,"")
+ END SUBROUTINE CALENDAR
+ END MODULE DATEGNASH
+
+ PROGRAM SHOW1968
+ USE DATEGNASH
+ INTEGER NCOL
+ DO NCOL = 1,6
+ CALL CALENDAR(1969,1969,NCOL)
+ END DO
+ END
diff --git a/Task/Calendar/Batch-File/calendar.bat b/Task/Calendar/Batch-File/calendar.bat
new file mode 100644
index 0000000000..b08ad43a36
--- /dev/null
+++ b/Task/Calendar/Batch-File/calendar.bat
@@ -0,0 +1,93 @@
+::Calender Task from Rosetta Code Wiki
+::Batch File Implementation
+
+@echo off
+setlocal enabledelayedexpansion
+
+ %== Set a valid year [will not be validated] ==%
+set y=1969
+
+ %== Set the variables for months (feb_l=the normal 28 days) ==%
+set jan_l=31&set apr_l=30
+set mar_l=31&set jun_l=30
+set may_l=31&set sep_l=30
+set jul_l=31&set nov_l=30
+set aug_l=31&set feb_l=28
+set oct_l=31
+set dec_l=31
+
+ %== Compute day for first day of the year ==%
+set /a d=(y/4+y)-(y/100-y/400)
+
+ %== Check if that year is a leap year ==%
+set /a "op1=y%%4","op2=y%%100","op3=y%%400"
+if not "%op1%"=="0" (goto :no_leap)
+if not "%op2%"=="0" (goto :yes_leap)
+if not "%op3%"=="0" (goto :no_leap)
+ :yes_leap
+ %== Ooops... Leap year. Change feb_l to 29. ==%
+ set feb_l=29
+ set/a d-=1
+ :no_leap
+
+ %== Compute weekday of the first day... ==%
+set /a d%%=7
+
+ %== Generate everything that's inside the calendar ==%
+for %%a in (jan feb mar apr may jun jul aug sep oct nov dec) do (
+ set %%a=
+ set chars_added=0
+ for /l %%b in (1,1,!d!) do (set "%%a=!%%a! "&set /a chars_added+=3)
+ for /l %%c in (1,1,!%%a_l!) do (
+ if %%c lss 10 (set "%%a=!%%a! %%c ") else (set "%%a=!%%a!%%c ")
+ set /a chars_added+=3
+ )
+ for /l %%d in (!chars_added!,1,124) do set "%%a=!%%a! "
+ set /a d=^(d+%%a_l^)%%7
+)
+
+ %== Display the calendar ==%
+cls
+echo.
+echo. [SNOOPY]
+echo.
+echo. YEAR = %y%
+echo.
+echo. January February March
+echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
+echo. %jan:~0,20% %feb:~0,20% %mar:~0,20%
+echo. %jan:~21,20% %feb:~21,20% %mar:~21,20%
+echo. %jan:~42,20% %feb:~42,20% %mar:~42,20%
+echo. %jan:~63,20% %feb:~63,20% %mar:~63,20%
+echo. %jan:~84,20% %feb:~84,20% %mar:~84,20%
+echo. %jan:~105% %feb:~105% %mar:~105%
+echo.
+echo. April May June
+echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
+echo. %apr:~0,20% %may:~0,20% %jun:~0,20%
+echo. %apr:~21,20% %may:~21,20% %jun:~21,20%
+echo. %apr:~42,20% %may:~42,20% %jun:~42,20%
+echo. %apr:~63,20% %may:~63,20% %jun:~63,20%
+echo. %apr:~84,20% %may:~84,20% %jun:~84,20%
+echo. %apr:~105% %may:~105% %jun:~105%
+echo.
+echo. July August September
+echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
+echo. %jul:~0,20% %aug:~0,20% %sep:~0,20%
+echo. %jul:~21,20% %aug:~21,20% %sep:~21,20%
+echo. %jul:~42,20% %aug:~42,20% %sep:~42,20%
+echo. %jul:~63,20% %aug:~63,20% %sep:~63,20%
+echo. %jul:~84,20% %aug:~84,20% %sep:~84,20%
+echo. %jul:~105% %aug:~105% %sep:~105%
+echo.
+echo. October November December
+echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
+echo. %oct:~0,20% %nov:~0,20% %dec:~0,20%
+echo. %oct:~21,20% %nov:~21,20% %dec:~21,20%
+echo. %oct:~42,20% %nov:~42,20% %dec:~42,20%
+echo. %oct:~63,20% %nov:~63,20% %dec:~63,20%
+echo. %oct:~84,20% %nov:~84,20% %dec:~84,20%
+echo. %oct:~105% %nov:~105% %dec:~105%
+echo.
+pause
+endlocal
diff --git a/Task/Calendar/Befunge/calendar.bf b/Task/Calendar/Befunge/calendar.bf
new file mode 100644
index 0000000000..d4992b71c2
--- /dev/null
+++ b/Task/Calendar/Befunge/calendar.bf
@@ -0,0 +1,11 @@
+"P"00p&>:::4%!\"d"%*\45*:*%!+!!65*+31p:1-:::"I"5**\4/+\"d"/-\45*:*/+1+7%:0v
+J!F?M!A M!J J!A!S O!N D!SaFrThWeTuMoSuvp01:_1#!-#%:#\>#+6:45**00g\-\1-:v:<<6>+7%:10g2+:38*\`|
+ May June July August v02-1:+4*-4\`\4:/_$:^^:/*2+92+2:g00$$$<
+September October November December>p:45*+10g*\--2/00g4-2/>:#,1#*-#8\#4_$v
+>20g>:#,1#*-#8\#4_$6"$S" v. .vp040\$_4#!8#\*#-,#1>#:<+5g03g01:,,:+55<0.p03<
+^_v#:-1$_v#!:,*84,g1+1,< < ^ >::4%9*40g:8`!#v_$$$1+v^+g02_#v$#,$#+5<^_v#`\<
+-#8\#4_$7>1-:2*64*+:1g>^ ^ ^,g+2/4\+p04+1:<>1#\-#<:66+\^ >>$10g30g>:#,1#*
+> > $$55+,6>>40p:10g30g>:#,1#*-#8\#4_$>\:2*:1+1g2-50p1g640g-7*1+\-7v v@,<6
+2:+g01$_55+,^ > > > > #^>#g>#0>#2_v v*2!!\%+55:\/+55:**`0\!`g05:::\< >2-^^
+->:> >#^>#<>#<^#!:-1g04$$ < < < < < >4+8*+\:!!2*4+8*+,,48*,1+\1-:>#^_$$1+\1
diff --git a/Task/Calendar/Common-Lisp/calendar.lisp b/Task/Calendar/Common-Lisp/calendar.lisp
new file mode 100644
index 0000000000..47e6c2cc7b
--- /dev/null
+++ b/Task/Calendar/Common-Lisp/calendar.lisp
@@ -0,0 +1,75 @@
+(ql:quickload '(date-calc))
+
+(defparameter *day-row* "Su Mo Tu We Th Fr Sa")
+(defparameter *calendar-margin* 3)
+
+(defun month-to-word (month)
+ "Translate a MONTH from 1 to 12 into its word representation."
+ (svref #("January" "February" "March" "April"
+ "May" "June" "July" "August"
+ "September" "October" "November" "December")
+ (1- month)))
+
+(defun month-strings (year month)
+ "Collect all of the strings that make up a calendar for a given
+MONTH and YEAR."
+ `(,(date-calc:center (month-to-word month) (length *day-row*))
+ ,*day-row*
+ ;; We can assume that a month calendar will always fit into a 7 by 6 block
+ ;; of values. This makes it easy to format the resulting strings.
+ ,@ (let ((days (make-array (* 7 6) :initial-element nil)))
+ (loop :for i :from (date-calc:day-of-week year month 1)
+ :for day :from 1 :to (date-calc:days-in-month year month)
+ :do (setf (aref days i) day))
+ (loop :for i :from 0 :to 5
+ :collect
+ (format nil "~{~:[ ~;~2,d~]~^ ~}"
+ (loop :for day :across (subseq days (* i 7) (+ 7 (* i 7)))
+ :append (if day (list day day) (list day))))))))
+
+(defun calc-columns (characters margin-size)
+ "Calculate the number of columns given the number of CHARACTERS per
+column and the MARGIN-SIZE between them."
+ (multiple-value-bind (cols excess)
+ (truncate characters (+ margin-size (length *day-row*)))
+ (incf excess margin-size)
+ (if (>= excess (length *day-row*))
+ (1+ cols)
+ cols)))
+
+(defun take (n list)
+ "Take the first N elements of a LIST."
+ (loop :repeat n :for x :in list :collect x))
+
+(defun drop (n list)
+ "Drop the first N elements of a LIST."
+ (cond ((or (<= n 0) (null list)) list)
+ (t (drop (1- n) (cdr list)))))
+
+(defun chunks-of (n list)
+ "Split the LIST into chunks of size N."
+ (assert (> n 0))
+ (loop :for x := list :then (drop n x)
+ :while x
+ :collect (take n x)))
+
+(defun print-calendar (year &key (characters 80) (margin-size 3))
+ "Print out the calendar for a given YEAR, optionally specifying
+a width limit in CHARACTERS and MARGIN-SIZE between months."
+ (assert (>= characters (length *day-row*)))
+ (assert (>= margin-size 0))
+ (let* ((calendars (loop :for month :from 1 :to 12
+ :collect (month-strings year month)))
+ (column-count (calc-columns characters margin-size))
+ (total-size (+ (* column-count (length *day-row*))
+ (* (1- column-count) margin-size)))
+ (format-string (concatenate 'string
+ "~{~a~^~" (write-to-string margin-size) ",0@T~}~%")))
+ (format t "~a~%~a~%~%"
+ (date-calc:center "[Snoopy]" total-size)
+ (date-calc:center (write-to-string year) total-size))
+ (loop :for row :in (chunks-of column-count calendars)
+ :do (apply 'mapcar
+ (lambda (&rest heads)
+ (format t format-string heads))
+ row))))
diff --git a/Task/Calendar/Fortran/calendar.f b/Task/Calendar/Fortran/calendar.f
new file mode 100644
index 0000000000..4b02df9822
--- /dev/null
+++ b/Task/Calendar/Fortran/calendar.f
@@ -0,0 +1,283 @@
+ MODULE DATEGNASH !Assorted vexations. Time and calendar games, with local flavourings added.
+
+ TYPE DateBag !Pack three parts into one.
+ INTEGER DAY,MONTH,YEAR !The usual suspects.
+ END TYPE DateBag !Simple enough.
+
+ CHARACTER*9 MONTHNAME(12),DAYNAME(0:6) !Re-interpretations.
+ PARAMETER (MONTHNAME = (/"January","February","March","April",
+ 1 "May","June","July","August","September","October","November",
+ 2 "December"/))
+ PARAMETER (DAYNAME = (/"Sunday","Monday","Tuesday","Wednesday",
+ 1 "Thursday","Friday","Saturday"/)) !Index this array with DayNum mod 7.
+ CHARACTER*3 MTHNAME(12) !The standard abbreviations.
+ PARAMETER (MTHNAME = (/"JAN","FEB","MAR","APR","MAY","JUN",
+ 1 "JUL","AUG","SEP","OCT","NOV","DEC"/))
+
+ INTEGER*4 JDAYSHIFT !INTEGER*2 just isn't enough.
+ PARAMETER (JDAYSHIFT = 2415020) !Thus shall 31/12/1899 give 0, a Sunday, via DAYNUM.
+ CONTAINS
+ INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank.
+Concocted yet again by R.N.McLean (whom God preserve) December MM.
+Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!
+Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces.
+Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.
+Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.
+Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.
+Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.
+Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!
+Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.
+ CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back.
+ INTEGER L !The length of the bumf.
+ L = LEN(TEXT) !So, what is it?
+ 1 IF (L.LE.0) GO TO 2 !Are we there yet?
+ IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also.
+ L = L - 1 !Step back one.
+ GO TO 1 !And try again.
+ 2 LSTNB = L !The last non-blank, possibly zero.
+ RETURN !Unsafe to use LSTNB as a variable.
+ END FUNCTION LSTNB !Compilers can bungle it.
+ CHARACTER*2 FUNCTION I2FMT(N) !These are all the same.
+ INTEGER*4 N !But, the compiler doesn't offer generalisations.
+ IF (N.LT.0) THEN !Negative numbers cop a sign.
+ IF (N.LT.-9) THEN !But there's not much room left.
+ I2FMT = "-!" !So this means 'overflow'.
+ ELSE !Otherwise, room for one negative digit.
+ I2FMT = "-"//CHAR(ICHAR("0") - N) !Thus. Presume adjacent character codes, etc.
+ END IF !So much for negative numbers.
+ ELSE IF (N.LT.10) THEN !Single digit positive?
+ I2FMT = " " //CHAR(ICHAR("0") + N) !Yes. This.
+ ELSE IF (N.LT.100) THEN !Two digit positive?
+ I2FMT = CHAR(N/10 + ICHAR("0")) !Yes.
+ 1 //CHAR(MOD(N,10) + ICHAR("0")) !These.
+ ELSE !Otherwise,
+ I2FMT = "+!" !Positive overflow.
+ END IF !So much for that.
+ END FUNCTION I2FMT !No WRITE and FORMAT unlimbering.
+ CHARACTER*8 FUNCTION I8FMT(N) !Oh for proper strings.
+ INTEGER*4 N
+ CHARACTER*8 HIC
+ WRITE (HIC,1) N
+ 1 FORMAT (I8)
+ I8FMT = HIC
+ END FUNCTION I8FMT
+
+ SUBROUTINE SAY(OUT,TEXT) !Gutted version that maintains no file logging output, etc.
+ INTEGER OUT
+ CHARACTER*(*) TEXT
+ WRITE (6,1) TEXT(1:LSTNB(TEXT))
+ 1 FORMAT (A)
+ END SUBROUTINE SAY
+
+ INTEGER*4 FUNCTION DAYNUM(YY,M,D) !Computes (JDayN - JDayShift), not JDayN.
+C Conversion from a Gregorian calendar date to a Julian day number, JDayN.
+C Valid for any Gregorian calendar date producing a Julian day number
+C greater than zero, though remember that the Gregorian calendar
+C was not used before y1582m10d15 and often, not after that either.
+C thus in England (et al) when Wednesday 2'nd September 1752 (Julian style)
+C was followed by Thursday the 14'th, occasioning the Eleven Day riots
+C because creditors demanded a full month's payment instead of 19/30'ths.
+C The zero of the Julian day number corresponds to the first of January
+C 4713BC on the *Julian* calendar's naming scheme, as extended backwards
+C with current usage into epochs when it did not exist: the proleptic Julian calendar.
+c This function employs the naming scheme of the *Gregorian* calendar,
+c and if extended backwards into epochs when it did not exist (thus the
+c proleptic Gregorian calendar) it would compute a zero for y-4713m11d24 *if*
+c it is supposed there was a year zero between 1BC and 1AD (as is convenient
+c for modern mathematics and astronomers and their simple calculations), *but*
+c 1BC immediately preceeds 1AD without any year zero in between (and is a leap year)
+c thus the adjustment below so that the date is y-4714m11d24 or 4714BCm11d24,
+c not that this name was in use at the time...
+c Although the Julian calendar (introduced by himself in what we would call 45BC,
+c which was what the Romans occasionally called 709AUC) was provoked by the
+c "years of confusion" resulting from arbitrary application of the rules
+c for the existing Roman calendar, other confusions remain unresolved,
+c so precise dating remains uncertain despite apparently precise specifications
+c (and much later, Dennis the Short chose wrongly for the birth of Christ)
+c and the Roman practice of inclusive reckoning meant that every four years
+c was interpreted as every third (by our exclusive reckoning) so that the
+c leap years were not as we now interpret them. This was resolved by Augustus
+c but exactly when (and what date name is assigned) and whose writings used
+c which system at the time of writing is a matter of more confusion,
+c and this has continued for centuries.
+C Accordingly, although an algorithm may give a regular sequence of date names,
+c that does not mean that those date names were used at the time even if the
+c calendar existed then, because the interpretation of the algorithm varied.
+c This in turn means that a date given as being on the Julian calendar
+c prior to about 10AD is not as definite as it may appear and its alignment
+c with the astronomical day number is uncertain even though the calculation
+c is quite definite.
+c
+C Computationally, year 1 is preceded by year 0, in a smooth progression.
+C But there was never a year zero despite what astronomers like to say,
+C so the formula's year 0 corresponds to 1BC, year -1 to 2BC, and so on back.
+C Thus y-4713 in this counting would be 4714BC on the Gregorian calendar,
+C were it to have existed then which it didn't.
+C To conform to the civil usage, the incoming YY, presumed a proper BC (negative)
+C and AD (positive) year is converted into the computational counting sequence, Y,
+C and used in the formula. If a YY = 0 is (improperly) offered, it will manifest
+C as 1AD. Thus YY = -4714 will lead to calculations with Y = -4713.
+C Thus, 1BC is a leap year on the proleptic Gregorian calendar.
+C For their convenience, astronomers decreed that a day starts at noon, so that
+C in Europe, observations through the night all have the same day number.
+C The current Western civil calendar however has the day starting just after midnight
+C and that day's number lasts until the following midnight.
+C
+C There is no constraint on the values of D, which is just added as it stands.
+C This means that if D = 0, the daynumber will be that of the last day of the
+C previous month. Likewise, M = 0 or M = 13 will wrap around so that Y,M + 1,0
+C will give the last day of month M (whatever its length) as one day before
+C the first day of the next month.
+C
+C Example: Y = 1970, M = 1, D = 1; JDAYN = 2440588, a Thursday but MOD(2440588,7) = 3.
+C and with the adjustment JDAYSHIFT, DAYNUM = 25568; mod 7 = 4 and DAYNAME(4) = "Thursday".
+C The Julian Day number 2440588.0 is for NOON that Thursday, 2440588.5 is twelve hours later.
+C And Julian Day number 2440587.625 is for three a.m. Thursday.
+C
+C DAYNUM and MUNYAD are the infamous routines of H. F. Fliegel and T.C. van Flandern,
+C presented in Communications of the ACM, Vol. 11, No. 10 (October, 1968).
+Carefully typed in again by R.N.McLean (whom God preserve) December XXMMIIX.
+C Though I remain puzzled as to why they used I,J,K for Y,M,D,
+C given that the variables were named in the INTEGER statement anyway.
+ INTEGER*4 JDAYN !Without rebasing, this won't fit in INTEGER*2.
+ INTEGER YY,Y,M,MM,D !NB! Full year number, so 1970, not 70.
+Caution: integer division in Fortran does not produce fractional results.
+C The fractional part is discarded so that 4/3 gives 1 and -4/3 gives -1.
+C Thus 4/3 might be Trunc(4/3) or 4 div 3 in other languages. Beware of negative numbers!
+ Y = YY !I can fiddle this copy without damaging the original's value.
+ IF (Y.LT.1) Y = Y + 1 !Thus YY = -2=2BC, -1=1BC, +1=1AD, ... becomes Y = -1, 0, 1, ...
+ MM = (M - 14)/12 !Calculate once. Note that this is integer division, truncating.
+ JDAYN = D - 32075 !This is the proper astronomer's Julian Day Number.
+ a + 1461*(Y + 4800 + MM)/4
+ b + 367*(M - 2 - MM*12)/12
+ c - 3*((Y + 4900 + MM)/100)/4
+ DAYNUM = JDAYN - JDAYSHIFT !Thus, *NOT* the actual *Julian* Day Number.
+ END FUNCTION DAYNUM !But one such that Mod(n,7) gives day names.
+
+Could compute the day of the year somewhat as follows...
+c DN:=D + (61*Month + (Month div 8)) div 2 - 30
+c + if Month > 2 then FebLength - 30 else 0;
+
+ TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM) !Oh for palindromic programming!
+Conversion from a Julian day number to a Gregorian calendar date. See JDAYN/DAYNUM.
+ INTEGER*4 DAYNUM,JDAYN !Without rebasing, this won't fit in INTEGER*2.
+ INTEGER Y,M,D,L,N !Y will be a full year number: 1950 not 50.
+ JDAYN = DAYNUM + JDAYSHIFT !Revert to a proper Julian day number.
+ L = JDAYN + 68569 !Further machinations of H. F. Fliegel and T.C. van Flandern.
+ N = 4*L/146097
+ L = L - (146097*N + 3)/4
+ Y = 4000*(L + 1)/1461001
+ L = L - 1461*Y/4 + 31
+ M = 80*L/2447
+ D = L - 2447*M/80
+ L = M/11
+ M = M + 2 - 12*L
+ Y = 100*(N - 49) + Y + L
+ IF (Y.LT.1) Y = Y - 1 !The other side of conformity to BC/AD, as in DAYNUM.
+ MUNYAD%YEAR = Y !Now place for the world to see.
+ MUNYAD%MONTH = M
+ MUNYAD%DAY = D
+ END FUNCTION MUNYAD !A year has 365.2421988 days...
+
+ INTEGER FUNCTION PMOD(N,M) !Remainder, mod M; always positive even if N is negative.
+c For date calculations, the MOD function is expected to yield positive remainders,
+c in line with the idea that MOD(a,b) = MOD(a ± b,b) as is involved in shifting the zero
+c of the daynumber count by a multiple of seven when considering the day of the week.
+c For this reason, the zero day was chosen to be 31/12/1899, a Sunday, so that all
+c day numbers would be positive. But, there was generation at Reefton in 1886.
+c For some computers, the positive interpretation is implemented, for others, not.
+c In the case MOD(N,M) = N - Truncate(N/M)*M, MOD(-6,7) = -6 even though MOD(1,7) = 1.
+ INTEGER N,M !The numbers. M presumed positive.
+ PMOD = MOD(MOD(N,M) + M,M) !Double do does de deed.
+ END FUNCTION PMOD !Simple enough.
+
+ SUBROUTINE CALENDAR(Y1,Y2,COLUMNS) !Print a calendar, with holiday annotations.
+Careful with the MOD function. MOD(-6,7) may be negative on some systems, positive on others. Thus, PMOD.
+ INTEGER Y1,Y2,YEAR !Ah yes. Year stuff.
+ INTEGER M,M1,M2,MONTH !And within each year are the months.
+ INTEGER*4 DN1,DN2,DN,D !But days are handled via day numbers.
+ INTEGER W,G !Layout: width and gap.
+ INTEGER L,LINE !Vertical layout.
+ INTEGER COL,COLUMNS,COLWIDTH !Horizontal layout.
+ INTEGER CODE !Days are not all alike.
+ CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE !Scratchpads.
+ IF (Y1.LE.0) CALL SAY(MSG,"Despite the insinuations of "
+ 1 //"astronomers seduced by the ease of their arithmetic, "
+ 2 //"there is no year zero. 1AD is preceded by 1BC, "
+ 3 //"corresponding to year -1, 2BC to year -2, etc.")
+ IF (Y1.LT.1582) CALL SAY(MSG,"This Gregorian calendar"
+ 1 //" scheme did not exist prior to 1582.")
+c COLUMNS = 4 !Number of months across the page.
+c W = 4 !Width of a day's field.
+c G = 3 !Added gap between month columns.
+ W = 3 !Abandon the annotation of the day's class, so just a space and two digits.
+ G = 1 !Set the gap to one.
+ COLWIDTH = 7*W + G !Seven days to a week, plus a gap.
+ Y:DO YEAR = Y1,Y2 !Step through the years.
+ CALL SAY(MSG,"") !Space out between each year's schedule.
+ IF (YEAR.EQ.0) THEN !This year number is improper.
+ CALL SAY(MSG,"There is no year zero.") !Declare correctness.
+ CYCLE Y !Skip this year.
+ END IF !Otherwise, no evasions.
+ MLINE = "" !Prepare a field..
+ L = (COLUMNS*COLWIDTH - G - 8)/2 !Find the centre.
+ IF (YEAR.GT.0) THEN !Ordinary Anno Domine years?
+ MLINE(L:) = I8FMT(YEAR) !Yes. Place the year number.
+ ELSE !Otherwise, we're in BC.
+ MLINE(L - 1:) = I8FMT(-YEAR)//"BC" !There is no year zero.
+ END IF !So much for year games.
+ CALL SAY(MSG,MLINE) !Splot the year.
+ DO MONTH = 1,12,COLUMNS !Step through the months of this YEAR.
+ M1 = MONTH !The first of this lot.
+ M2 = MIN(12,M1 + COLUMNS - 1) !The last.
+ MLINE = "" !Scrub the month names.
+ DLINE = "" !Wipe the day names in case COLUMNS does not divide 12.
+ STRIPE = "" !Scrub the day table.
+ SPECIAL = "" !And the associated special day remarks.
+c L0 = W - 1 !Locate the first day number's first column.
+ L0 = 1 !Cram: no space in front of the Sunday day-of-the-month.
+ DO M = M1,M2 !Work through the months.
+ L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1 !Centre the month name.
+ MLINE(L0 + L:) = MONTHNAME(M) !Splot.
+ DO D = 0,6 !Prepare this month's day name heading.
+ L = L0 + (3 - W) + D*W !Locate its first column.
+ DLINE(L:L + 2) = DAYNAME(D)(1:W - 1) !Squish.
+ END DO !On to the next day.
+ DN1 = DAYNUM(YEAR,M,1) !Day number of the first day of the month.
+ DN2 = DAYNUM(YEAR,M + 1,0)!Thus the last, without annoyance.
+ COL = MOD(PMOD(DN1,7) + 7,7) !What day of the week is the first day?
+ LINE = 1 !Whichever it is, it is on the first line.
+ D = 1 !Day of the month, not number of the day.
+ DO DN = DN1,DN2 !Step through the day numbers of this month.
+ L = L0 + COL*W !Finger the starting column.
+ STRIPE(LINE)(L:L + 1) = I2FMT(D) !Place the two-digit day number.
+ D = D + 1 !Advance to the next day of the current month
+ COL = COL + 1 !So, one more day along in the week.
+ IF (COL.GT.6) THEN !A fresh week is needed?
+ LINE = LINE + 1 !Yes.
+ COL = 0 !Start the new week.
+ END IF !So much for the end of a week.
+ END DO !On to the next day of this month.
+ L0 = L0 + 7*W + G !Locate the start column of the next month's column.
+ END DO !On to the next month in this layer.
+ CALL SAY(MSG,MLINE) !Name the months.
+C CALL SAY(MSG,"") !Set off.
+ CALL SAY(MSG,DLINE) !Give the day name headings.
+ DO LINE = 1,6 !Now roll the day number table.
+ IF (STRIPE(LINE).NE."") THEN !Perhaps there was no use of the sixth line.
+ CALL SAY(MSG,STRIPE(LINE)) !Ah well. Show the day numbers.
+ END IF !So much for that week line.
+ END DO !On to the next week line.
+ END DO !On to the next batch of months of the YEAR.
+ END DO Y !On to the next YEAR.
+ CALL SAY(MSG,"") !Take a breath.
+ END SUBROUTINE CALENDAR !Enough of this.
+ END MODULE DATEGNASH !An ad-hoc assemblage.
+
+ PROGRAM SHOW1968 !Put it to the test.
+ USE DATEGNASH
+ INTEGER NCOL
+ DO NCOL = 1,6
+ CALL CALENDAR(1969,1969,NCOL)
+ END DO
+ END
diff --git a/Task/Calendar/Perl-6/calendar.pl6 b/Task/Calendar/Perl-6/calendar.pl6
index e43458e0c8..3d2e8fb1f6 100644
--- a/Task/Calendar/Perl-6/calendar.pl6
+++ b/Task/Calendar/Perl-6/calendar.pl6
@@ -11,8 +11,8 @@ sub fmt-year ($year) {
my $str = (' ' x 30) ~ $year ~ "\n";
- my @month-strs;
- @month-strs[$_] = fmt-month($year, $_).lines for 1 .. 12;
+ my Array @month-strs;
+ @month-strs[$_] = fmt-month($year, $_).lines.Array for 1 .. 12;
loop ( my $month = 1; $month <= 12; $month += $months-per-col ) {
while @month-strs[$month] {
diff --git a/Task/Calendar/Racket/calendar.rkt b/Task/Calendar/Racket/calendar.rkt
index 3494429752..a6faa684ad 100644
--- a/Task/Calendar/Racket/calendar.rkt
+++ b/Task/Calendar/Racket/calendar.rkt
@@ -1,5 +1,5 @@
#lang racket
-(require racket/date)
+(require racket/date net/base64 file/gunzip)
(define (calendar yr)
(define (nsplit n l) (if (null? l) l (cons (take l n) (nsplit n (drop l n)))))
(define months
@@ -18,14 +18,12 @@
,@(for/list ([d days])
(~a (+ d 1) #:width 2 #:align 'right))
,@(make-list (- 42 pfx days) " ")))))))
- (let* ([s '(" 11,-~4-._3. 41-4! 10/ ()=(2) 3\\ 40~a! 9( 3( 80 39-4! 10\\._\\"
- ", ,-4'! 5#2X3x7! 12/ 2-3'~2;! 11/ 4/~2|-! 9=( 3~4 2|! 3/~42\\! "
- "2/_23\\! /_25\\!/_27\\! 3|_20|! 3|_20|! 3|_20|! 3| 20|!!")]
- [s (regexp-replace* #rx"!" (string-append* s) "\n")]
- [s (regexp-replace* #rx".(?:[1-7][0-9]*|[1-9])" s
- (λ(m) (make-string (string->number (substring m 1))
- (string-ref m 0))))])
- (printf s yr))
+ (let ([s #"nZA7CsAgDED3nCLgoAU/3Uvv4SCE3qKD5OyNWvoBhdIHSswjMYp4YR2z80Tk8StOgP
+ sY0EyrMZOE6WsL3u4G5lyV+d8MyVOy8hZBt7RSMca9Ac/KUIs1L/BOysb50XMtMzEj
+ ZqiuRxIVqI+4kSpy7GqpXNsz+bfpfWIGOAA="]
+ [o (open-output-string)])
+ (inflate (open-input-bytes (base64-decode s)) o)
+ (display (regexp-replace #rx"~a" (get-output-string o) (~a yr))))
(for-each displayln
(dropf-right (for*/list ([3ms (nsplit 3 months)] [s (apply map list 3ms)])
(regexp-replace #rx" +$" (string-join s " ") ""))
diff --git a/Task/Call-a-foreign-language-function/ALGOL-68/call-a-foreign-language-function.alg b/Task/Call-a-foreign-language-function/ALGOL-68/call-a-foreign-language-function.alg
new file mode 100644
index 0000000000..37a70f665a
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/ALGOL-68/call-a-foreign-language-function.alg
@@ -0,0 +1,67 @@
+BEGIN
+ MODE PASSWD = STRUCT (STRING name, passwd, INT uid, gid, STRING gecos, dir, shell);
+ PROC getpwnam = (STRING name) PASSWD :
+ BEGIN
+ FILE c source;
+ create (c source, stand out channel);
+ putf (c source, ($gl$,
+"#include ",
+"#include ",
+"#include ",
+"main ()",
+"{",
+" char name[256];",
+" scanf (""%s"", name);",
+" struct passwd *pass = getpwnam (name);",
+" if (pass == (struct passwd *) NULL) {",
+" putchar ('\n');",
+" } else {",
+" printf (""%s\n"", pass->pw_name);",
+" printf (""%s\n"", pass->pw_passwd);",
+" printf (""%d\n"", pass->pw_uid);",
+" printf (""%d\n"", pass->pw_gid);",
+" printf (""%s\n"", pass->pw_gecos);",
+" printf (""%s\n"", pass->pw_dir);",
+" printf (""%s\n"", pass->pw_shell);",
+" }",
+"}"
+ ));
+ STRING source name = idf (c source);
+ STRING bin name = source name + ".bin";
+ INT child pid = execve child ("/usr/bin/gcc",
+ ("gcc", "-x", "c", source name, "-o", bin name),
+ "");
+ wait pid (child pid);
+ PIPE p = execve child pipe (bin name, "Ding dong, a68g calling", "");
+ put (write OF p, (name, newline));
+ STRING line;
+ PASSWD result;
+ IF get (read OF p, (line, newline)); line = ""
+ THEN
+ result := ("", "", -1, -1, "", "", "")
+ CO
+ Return to sender, address unknown.
+ No such number, no such zone.
+ CO
+ ELSE
+ name OF result := line;
+ get (read OF p, (passwd OF result, newline));
+ get (read OF p, (uid OF result, newline));
+ get (read OF p, (gid OF result, newline));
+ get (read OF p, (gecos OF result, newline));
+ get (read OF p, (dir OF result, newline));
+ get (read OF p, (shell OF result, newline))
+ FI;
+ close (write OF p); CO Sundry cleaning up. CO
+ close (read OF p);
+ execve child ("/bin/rm", ("rm", "-f", source name, bin name), "");
+ result
+ END;
+ PASSWD mr root = getpwnam ("root");
+ IF name OF mr root = ""
+ THEN
+ print (("Oh dear, we seem to be rootless.", newline))
+ ELSE
+ printf (($2(g,":"), 2(g(0),":"), 2(g,":"), gl$, mr root))
+ FI
+END
diff --git a/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-1.clj b/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-1.clj
new file mode 100644
index 0000000000..a8ed54fd1e
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-1.clj
@@ -0,0 +1 @@
+(JNIDemo/callStrdup "Hello World!")
diff --git a/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-2.clj b/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-2.clj
new file mode 100644
index 0000000000..1d17539ae7
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/Clojure/call-a-foreign-language-function-2.clj
@@ -0,0 +1,7 @@
+(require '[net.n01se.clojure-jna :as jna])
+
+(jna/invoke Integer c/strcmp "apple" "banana" ) ; returns -1
+
+(jna/invoke Integer c/strcmp "banana" "apple" ) ; returns 1
+
+(jna/invoke Integer c/strcmp "banana" "banana" ) ; returns 0
diff --git a/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-1.f b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-1.f
new file mode 100644
index 0000000000..7da5cb19c8
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-1.f
@@ -0,0 +1,4 @@
+double add_n(double* a, double* b)
+{
+return *a + *b;
+}
diff --git a/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-2.f b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-2.f
new file mode 100644
index 0000000000..e4b8166b06
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function-2.f
@@ -0,0 +1,258 @@
+!-----------------------------------------------------------------------
+!module dll_module
+!-----------------------------------------------------------------------
+module dll_module
+ use iso_c_binding
+ implicit none
+ private ! all by default
+ public :: os_type, dll_type, load_dll, free_dll, init_os_type, init_dll
+ ! general constants:
+ ! the number of bits in an address (32-bit or 64-bit).
+ integer, parameter :: bits_in_addr = c_intptr_t*8
+ ! global error-level variables:
+ integer, parameter :: errid_none = 0
+ integer, parameter :: errid_info = 1
+ integer, parameter :: errid_warn = 2
+ integer, parameter :: errid_severe = 3
+ integer, parameter :: errid_fatal = 4
+
+ integer :: os_id
+
+ type os_type
+ character(10) :: endian
+ character(len=:), allocatable :: newline
+ character(len=:), allocatable :: os_desc
+ character(1) :: pathsep
+ character(1) :: swchar
+ character(11) :: unfform
+ end type os_type
+
+ type dll_type
+ integer(c_intptr_t) :: fileaddr
+ type(c_ptr) :: fileaddrx
+ type(c_funptr) :: procaddr
+ character(1024) :: filename
+ character(1024) :: procname
+ end type dll_type
+
+ ! interface to linux API
+ interface
+ function dlopen(filename,mode) bind(c,name="dlopen")
+ ! void *dlopen(const char *filename, int mode);
+ use iso_c_binding
+ implicit none
+ type(c_ptr) :: dlopen
+ character(c_char), intent(in) :: filename(*)
+ integer(c_int), value :: mode
+ end function
+
+ function dlsym(handle,name) bind(c,name="dlsym")
+ ! void *dlsym(void *handle, const char *name);
+ use iso_c_binding
+ implicit none
+ type(c_funptr) :: dlsym
+ type(c_ptr), value :: handle
+ character(c_char), intent(in) :: name(*)
+ end function
+
+ function dlclose(handle) bind(c,name="dlclose")
+ ! int dlclose(void *handle);
+ use iso_c_binding
+ implicit none
+ integer(c_int) :: dlclose
+ type(c_ptr), value :: handle
+ end function
+ end interface
+
+contains
+
+
+ !-----------------------------------------------------------------------
+ !Subroutine init_dll
+ !-----------------------------------------------------------------------
+ subroutine init_dll(dll)
+ implicit none
+ type(dll_type), intent(inout) :: dll
+ dll % fileaddr = 0
+ dll % fileaddrx = c_null_ptr
+ dll % procaddr = c_null_funptr
+ dll % filename = " "
+ dll % procname = " "
+ end subroutine init_dll
+
+ !-----------------------------------------------------------------------
+ !Subroutine init_os_type
+ !-----------------------------------------------------------------------
+ subroutine init_os_type(os_id,os)
+ implicit none
+ integer, intent(in) :: os_id
+ type(os_type), intent(inout) :: os
+
+ select case (os_id)
+ case (1) ! Linux
+
+ os % endian = 'big_endian'
+ os % newline = achar(10)
+ os % os_desc = 'Linux'
+ os % pathsep = '/'
+ os % swchar = '-'
+ os % unfform = 'unformatted'
+
+ case (2) ! MacOS
+
+ os % endian = 'big_endian'
+ os % newline = achar(10)
+ os % os_desc = 'MacOS'
+ os % pathsep = '/'
+ os % swchar = '-'
+ os % unfform = 'unformatted'
+
+ case default
+
+ end select
+
+ end subroutine init_os_type
+
+ !-----------------------------------------------------------------------
+ !Subroutine load_dll
+ !-----------------------------------------------------------------------
+ subroutine load_dll (os, dll, errstat, errmsg )
+ ! this subroutine is used to dynamically load a dll.
+
+
+ type (os_type), intent(in) :: os
+ type (dll_type), intent(inout) :: dll
+ integer, intent( out) :: errstat
+ character(*), intent( out) :: errmsg
+
+ integer(c_int), parameter :: rtld_lazy=1
+ integer(c_int), parameter :: rtld_now=2
+ integer(c_int), parameter :: rtld_global=256
+ integer(c_int), parameter :: rtld_local=0
+
+ errstat = errid_none
+ errmsg = ''
+
+ select case (os%os_desc)
+ case ("Linux","MacOS")
+ ! load the dll and get the file address:
+ dll%fileaddrx = dlopen( trim(dll%filename)//c_null_char, rtld_lazy )
+ if( .not. c_associated(dll%fileaddrx) ) then
+ errstat = errid_fatal
+ write(errmsg,'(i2)') bits_in_addr
+ errmsg = 'the dynamic library '//trim(dll%filename)//' could not be loaded. check that the file '// &
+ 'exists in the specified location and that it is compiled for '//trim(errmsg)//'-bit systems.'
+ return
+ end if
+
+ ! get the procedure address:
+ dll%procaddr = dlsym( dll%fileaddrx, trim(dll%procname)//c_null_char )
+ if(.not. c_associated(dll%procaddr)) then
+ errstat = errid_fatal
+ errmsg = 'the procedure '//trim(dll%procname)//' in file '//trim(dll%filename)//' could not be loaded.'
+ return
+ end if
+
+ case ("Windows")
+ errstat = errid_fatal
+ errmsg = ' load_dll not implemented for '//trim(os%os_desc)
+
+ case default
+ errstat = errid_fatal
+ errmsg = ' load_dll not implemented for '//trim(os%os_desc)
+ end select
+ return
+ end subroutine load_dll
+
+ !-----------------------------------------------------------------------
+ !Subroutine free_dll
+ !-----------------------------------------------------------------------
+ subroutine free_dll (os, dll, errstat, errmsg )
+
+ ! this subroutine is used to free a dynamically loaded dll
+ type (os_type), intent(in) :: os
+ type (dll_type), intent(inout) :: dll
+ integer, intent( out) :: errstat
+ character(*), intent( out) :: errmsg
+
+ integer(c_int) :: success
+
+ errstat = errid_none
+ errmsg = ''
+
+ select case (os%os_desc)
+ case ("Linux","MacOS")
+
+ ! close the library:
+ success = dlclose( dll%fileaddrx )
+ if ( success /= 0 ) then
+ errstat = errid_fatal
+ errmsg = 'the dynamic library could not be freed.'
+ return
+ else
+ errstat = errid_none
+ errmsg = ''
+ end if
+
+ case ("Windows")
+
+ errstat = errid_fatal
+ errmsg = ' free_dll not implemented for '//trim(os%os_desc)
+
+ case default
+ errstat = errid_fatal
+ errmsg = ' free_dll not implemented for '//trim(os%os_desc)
+ end select
+
+ return
+ end subroutine free_dll
+end module dll_module
+
+
+
+!-----------------------------------------------------------------------
+!Main program
+!-----------------------------------------------------------------------
+program test_load_dll
+ use, intrinsic :: iso_c_binding
+ use dll_module
+ implicit none
+
+ ! interface to our shared lib
+ abstract interface
+ function add_n(a,b)
+ use, intrinsic :: iso_c_binding
+ implicit none
+ real(c_double), intent(in) :: a,b
+ real(c_double) :: add_n
+ end function add_n
+ end interface
+
+ type(os_type) :: os
+ type(dll_type) :: dll
+ integer :: errstat
+ character(1024) :: errmsg
+ type(c_funptr) :: cfun
+ procedure(add_n), pointer :: fproc
+
+ call init_os_type(1,os)
+ call init_dll(dll)
+
+ dll%filename="/full_path_to/shared_lib.so"
+ ! name of the procedure in shared_lib
+ dll%procname="add_n"
+
+ write(*,*) "address: ", dll%procaddr
+
+ call load_dll(os, dll, errstat, errmsg )
+ write(*,*)"load_dll: errstat=", errstat
+ write(*,*) "address: ", dll%procaddr
+
+ call c_f_procpointer(dll%procaddr,fproc)
+
+ write(*,*) "add_n(2,5)=",fproc(2.d0,5.d0)
+
+ call free_dll (os, dll, errstat, errmsg )
+ write(*,*)"free_dll: errstat=", errstat
+
+end program test_load_dll
diff --git a/Task/Call-a-foreign-language-function/NewLISP/call-a-foreign-language-function.newlisp b/Task/Call-a-foreign-language-function/NewLISP/call-a-foreign-language-function.newlisp
new file mode 100644
index 0000000000..347d2d1c1b
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/NewLISP/call-a-foreign-language-function.newlisp
@@ -0,0 +1,7 @@
+; simple FFI interface on Mac OSX
+(import "libc.dylib" "strdup")
+(println (get-string (strdup "hello world")))
+
+; or extended FFI interface on Mac OSX
+(import "libc.dylib" "strdup" "char*" "char*")
+(println (strdup "hello world"))
diff --git a/Task/Call-a-foreign-language-function/REXX/call-a-foreign-language-function.rexx b/Task/Call-a-foreign-language-function/REXX/call-a-foreign-language-function.rexx
new file mode 100644
index 0000000000..d99898697c
--- /dev/null
+++ b/Task/Call-a-foreign-language-function/REXX/call-a-foreign-language-function.rexx
@@ -0,0 +1,8 @@
+/*REXX program calls (invoke) a "foreign" (non-REXX) language routine/program.*/
+
+cmd = "MODE" /*define the command that is to be used*/
+opts= 'CON: CP /status' /*define the options to be used for cmd*/
+
+address 'SYSTEM' cmd opts /*invoke a cmd via the SYSTEM interface*/
+
+ /*stick a fork in it, we're all done. */
diff --git a/Task/Call-a-function-in-a-shared-library/Ada/call-a-function-in-a-shared-library-1.ada b/Task/Call-a-function-in-a-shared-library/Ada/call-a-function-in-a-shared-library-1.ada
index 31681a2af2..ea14761474 100644
--- a/Task/Call-a-function-in-a-shared-library/Ada/call-a-function-in-a-shared-library-1.ada
+++ b/Task/Call-a-function-in-a-shared-library/Ada/call-a-function-in-a-shared-library-1.ada
@@ -7,12 +7,12 @@ with Ada.Unchecked_Conversion;
procedure Shared_Library_Call is
--
- -- Interface to kernel32.dll which is resposible for loading DLLs under Windows.
- -- There are ready to use Win32 binding. We don't want to use them here.
+ -- Interface to kernel32.dll which is responsible for loading DLLs under Windows.
+ -- There are ready to use Win32 bindings. We don't want to use them here.
--
type HANDLE is new Unsigned_32;
function LoadLibrary (lpFileName : char_array) return HANDLE;
- pragma Import (stdcall, LoadLibrary, "LoadLibrary", "_LoadLibraryA"); -- Ada95 don't has @n.
+ pragma Import (stdcall, LoadLibrary, "LoadLibrary", "_LoadLibraryA"); -- Ada95 does not have the @n suffix.
function GetProcAddress (hModule : HANDLE; lpProcName : char_array)
return Address;
diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-1.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-1.f
new file mode 100644
index 0000000000..7da5cb19c8
--- /dev/null
+++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-1.f
@@ -0,0 +1,4 @@
+double add_n(double* a, double* b)
+{
+return *a + *b;
+}
diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-2.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-2.f
new file mode 100644
index 0000000000..eac699508f
--- /dev/null
+++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-2.f
@@ -0,0 +1,8 @@
+function add_nf(a,b) bind(c, name='add_nf')
+use, intrinsic :: iso_c_binding
+implicit none
+real(c_double), intent(in) :: a,b
+real(c_double) :: add_nf
+
+add_nf = a + b
+end function add_nf
diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-3.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-3.f
new file mode 100644
index 0000000000..4c91a916b8
--- /dev/null
+++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-3.f
@@ -0,0 +1,274 @@
+!-----------------------------------------------------------------------
+!module dll_module
+!-----------------------------------------------------------------------
+module dll_module
+ use iso_c_binding
+ implicit none
+ private ! all by default
+ public :: os_type, dll_type, load_dll, free_dll, init_os_type, init_dll
+ ! general constants:
+ ! the number of bits in an address (32-bit or 64-bit).
+ integer, parameter :: bits_in_addr = c_intptr_t*8
+ ! global error-level variables:
+ integer, parameter :: errid_none = 0
+ integer, parameter :: errid_info = 1
+ integer, parameter :: errid_warn = 2
+ integer, parameter :: errid_severe = 3
+ integer, parameter :: errid_fatal = 4
+
+ integer :: os_id
+
+ type os_type
+ character(10) :: endian
+ character(len=:), allocatable :: newline
+ character(len=:), allocatable :: os_desc
+ character(1) :: pathsep
+ character(1) :: swchar
+ character(11) :: unfform
+ end type os_type
+
+ type dll_type
+ integer(c_intptr_t) :: fileaddr
+ type(c_ptr) :: fileaddrx
+ type(c_funptr) :: procaddr
+ character(1024) :: filename
+ character(1024) :: procname
+ end type dll_type
+
+ ! interface to linux API
+ interface
+ function dlopen(filename,mode) bind(c,name="dlopen")
+ ! void *dlopen(const char *filename, int mode);
+ use iso_c_binding
+ implicit none
+ type(c_ptr) :: dlopen
+ character(c_char), intent(in) :: filename(*)
+ integer(c_int), value :: mode
+ end function
+
+ function dlsym(handle,name) bind(c,name="dlsym")
+ ! void *dlsym(void *handle, const char *name);
+ use iso_c_binding
+ implicit none
+ type(c_funptr) :: dlsym
+ type(c_ptr), value :: handle
+ character(c_char), intent(in) :: name(*)
+ end function
+
+ function dlclose(handle) bind(c,name="dlclose")
+ ! int dlclose(void *handle);
+ use iso_c_binding
+ implicit none
+ integer(c_int) :: dlclose
+ type(c_ptr), value :: handle
+ end function
+ end interface
+
+contains
+
+
+ !-----------------------------------------------------------------------
+ !Subroutine init_dll
+ !-----------------------------------------------------------------------
+ subroutine init_dll(dll)
+ implicit none
+ type(dll_type), intent(inout) :: dll
+ dll % fileaddr = 0
+ dll % fileaddrx = c_null_ptr
+ dll % procaddr = c_null_funptr
+ dll % filename = " "
+ dll % procname = " "
+ end subroutine init_dll
+
+ !-----------------------------------------------------------------------
+ !Subroutine init_os_type
+ !-----------------------------------------------------------------------
+ subroutine init_os_type(os_id,os)
+ implicit none
+ integer, intent(in) :: os_id
+ type(os_type), intent(inout) :: os
+
+ select case (os_id)
+ case (1) ! Linux
+
+ os % endian = 'big_endian'
+ os % newline = achar(10)
+ os % os_desc = 'Linux'
+ os % pathsep = '/'
+ os % swchar = '-'
+ os % unfform = 'unformatted'
+
+ case (2) ! MacOS
+
+ os % endian = 'big_endian'
+ os % newline = achar(10)
+ os % os_desc = 'MacOS'
+ os % pathsep = '/'
+ os % swchar = '-'
+ os % unfform = 'unformatted'
+
+ case default
+
+ end select
+
+ end subroutine init_os_type
+
+ !-----------------------------------------------------------------------
+ !Subroutine load_dll
+ !-----------------------------------------------------------------------
+ subroutine load_dll (os, dll, errstat, errmsg )
+ ! this subroutine is used to dynamically load a dll.
+
+
+ type (os_type), intent(in) :: os
+ type (dll_type), intent(inout) :: dll
+ integer, intent( out) :: errstat
+ character(*), intent( out) :: errmsg
+
+ integer(c_int), parameter :: rtld_lazy=1
+ integer(c_int), parameter :: rtld_now=2
+ integer(c_int), parameter :: rtld_global=256
+ integer(c_int), parameter :: rtld_local=0
+
+ errstat = errid_none
+ errmsg = ''
+
+ select case (os%os_desc)
+ case ("Linux","MacOS")
+ ! load the dll and get the file address:
+ dll%fileaddrx = dlopen( trim(dll%filename)//c_null_char, rtld_lazy )
+ if( .not. c_associated(dll%fileaddrx) ) then
+ errstat = errid_fatal
+ write(errmsg,'(i2)') bits_in_addr
+ errmsg = 'the dynamic library '//trim(dll%filename)//' could not be loaded. check that the file '// &
+ 'exists in the specified location and that it is compiled for '//trim(errmsg)//'-bit systems.'
+ return
+ end if
+
+ ! get the procedure address:
+ dll%procaddr = dlsym( dll%fileaddrx, trim(dll%procname)//c_null_char )
+ if(.not. c_associated(dll%procaddr)) then
+ errstat = errid_fatal
+ errmsg = 'the procedure '//trim(dll%procname)//' in file '//trim(dll%filename)//' could not be loaded.'
+ return
+ end if
+
+ case ("Windows")
+ errstat = errid_fatal
+ errmsg = ' load_dll not implemented for '//trim(os%os_desc)
+
+ case default
+ errstat = errid_fatal
+ errmsg = ' load_dll not implemented for '//trim(os%os_desc)
+ end select
+ return
+ end subroutine load_dll
+
+ !-----------------------------------------------------------------------
+ !Subroutine free_dll
+ !-----------------------------------------------------------------------
+ subroutine free_dll (os, dll, errstat, errmsg )
+
+ ! this subroutine is used to free a dynamically loaded dll
+ type (os_type), intent(in) :: os
+ type (dll_type), intent(inout) :: dll
+ integer, intent( out) :: errstat
+ character(*), intent( out) :: errmsg
+
+ integer(c_int) :: success
+
+ errstat = errid_none
+ errmsg = ''
+
+ select case (os%os_desc)
+ case ("Linux","MacOS")
+
+ ! close the library:
+ success = dlclose( dll%fileaddrx )
+ if ( success /= 0 ) then
+ errstat = errid_fatal
+ errmsg = 'the dynamic library could not be freed.'
+ return
+ else
+ errstat = errid_none
+ errmsg = ''
+ end if
+
+ case ("Windows")
+
+ errstat = errid_fatal
+ errmsg = ' free_dll not implemented for '//trim(os%os_desc)
+
+ case default
+ errstat = errid_fatal
+ errmsg = ' free_dll not implemented for '//trim(os%os_desc)
+ end select
+
+ return
+ end subroutine free_dll
+end module dll_module
+
+
+
+!-----------------------------------------------------------------------
+!Main program
+!-----------------------------------------------------------------------
+program test_load_dll
+ use, intrinsic :: iso_c_binding
+ use dll_module
+ implicit none
+
+ ! interface to our shared lib
+ abstract interface
+ function add_n(a,b)
+ use, intrinsic :: iso_c_binding
+ implicit none
+ real(c_double), intent(in) :: a,b
+ real(c_double) :: add_n
+ end function add_n
+ end interface
+
+ type(os_type) :: os
+ type(dll_type) :: dll
+ integer :: errstat
+ character(1024) :: errmsg
+ type(c_funptr) :: cfun
+ procedure(add_n), pointer :: fproc
+
+ call init_os_type(1,os)
+ call init_dll(dll)
+
+ dll%filename="/full_path_to/shared_lib/shared_lib_new.so"
+ ! name of the procedure in shared_lib
+ ! c version of the function
+ dll%procname="add_n"
+
+ write(*,*) "address: ", dll%procaddr
+
+ call load_dll(os, dll, errstat, errmsg )
+ write(*,*)"load_dll: errstat=", errstat
+ write(*,*) "address: ", dll%procaddr
+
+ call c_f_procpointer(dll%procaddr,fproc)
+
+ write(*,*) "add_n(2,5)=",fproc(2.d0,5.d0)
+
+ call free_dll (os, dll, errstat, errmsg )
+ write(*,*)"free_dll: errstat=", errstat
+
+ ! fortran version
+ dll%procname="add_nf"
+
+ call load_dll(os, dll, errstat, errmsg )
+ write(*,*)"load_dll: errstat=", errstat
+ write(*,*) "address: ", dll%procaddr
+
+ call c_f_procpointer(dll%procaddr,fproc)
+
+ write(*,*) "add_nf(2,5)=",fproc(2.d0,5.d0)
+
+ call free_dll (os, dll, errstat, errmsg )
+ write(*,*)"free_dll: errstat=", errstat
+
+
+end program test_load_dll
diff --git a/Task/Call-a-function-in-a-shared-library/REXX/call-a-function-in-a-shared-library.rexx b/Task/Call-a-function-in-a-shared-library/REXX/call-a-function-in-a-shared-library.rexx
new file mode 100644
index 0000000000..a818326aaa
--- /dev/null
+++ b/Task/Call-a-function-in-a-shared-library/REXX/call-a-function-in-a-shared-library.rexx
@@ -0,0 +1,16 @@
+/*REXX pgm calls a function (systextscreensize) in a shared library (regutil).*/
+z=rxfuncadd('sysloadfuncs', "regutil", 'sysloadfuncs') /*add a function lib.*/
+if z\==0 then do /*test the return cod*/
+ say 'return code' z "from rxfuncadd" /*tell about bad RC. */
+ exit z /*exit this program. */
+ end
+
+call sysloadfuncs /*load the functions.*/
+
+ /* [↓] call a particular function. */
+y=systextscreensize() /*Y now contains 2 numbers: rows cols */
+parse var y rows cols . /*obtain the two numeric words in Y. */
+say 'rows=' rows /*display the number of (terminal) rows*/
+say 'cols=' cols /* " " " " " cols*/
+call SysDropFuncs /*clean up: make functions inaccessible*/
+ /*stick a fork in it, we're all done. */
diff --git a/Task/Call-a-function/Bracmat/call-a-function-1.bracmat b/Task/Call-a-function/Bracmat/call-a-function-1.bracmat
new file mode 100644
index 0000000000..a3debb6bee
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-1.bracmat
@@ -0,0 +1 @@
+aFunctionWithoutArguments$
diff --git a/Task/Call-a-function/Bracmat/call-a-function-2.bracmat b/Task/Call-a-function/Bracmat/call-a-function-2.bracmat
new file mode 100644
index 0000000000..77783f2a7c
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-2.bracmat
@@ -0,0 +1 @@
+aFunctionWithoutArguments'
diff --git a/Task/Call-a-function/Bracmat/call-a-function-3.bracmat b/Task/Call-a-function/Bracmat/call-a-function-3.bracmat
new file mode 100644
index 0000000000..e74f72b518
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-3.bracmat
@@ -0,0 +1 @@
+func$!myargument;
diff --git a/Task/Call-a-function/Bracmat/call-a-function-4.bracmat b/Task/Call-a-function/Bracmat/call-a-function-4.bracmat
new file mode 100644
index 0000000000..a27ce7286a
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-4.bracmat
@@ -0,0 +1 @@
+(yourfunc=local vars.function body)
diff --git a/Task/Call-a-function/Bracmat/call-a-function-5.bracmat b/Task/Call-a-function/Bracmat/call-a-function-5.bracmat
new file mode 100644
index 0000000000..e371425bfa
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-5.bracmat
@@ -0,0 +1 @@
+('$myfunc:(=?yourfunc))
diff --git a/Task/Call-a-function/Bracmat/call-a-function-6.bracmat b/Task/Call-a-function/Bracmat/call-a-function-6.bracmat
new file mode 100644
index 0000000000..1d553c555d
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-6.bracmat
@@ -0,0 +1 @@
+myfunc$!myarg:?myresult
diff --git a/Task/Call-a-function/Bracmat/call-a-function-7.bracmat b/Task/Call-a-function/Bracmat/call-a-function-7.bracmat
new file mode 100644
index 0000000000..ac756f1b8d
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-7.bracmat
@@ -0,0 +1 @@
+myfunc$!myarg&yourfunc$!yourarg
diff --git a/Task/Call-a-function/Bracmat/call-a-function-8.bracmat b/Task/Call-a-function/Bracmat/call-a-function-8.bracmat
new file mode 100644
index 0000000000..ee0bdefe65
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-8.bracmat
@@ -0,0 +1 @@
+`(myfunc$!myarg)&yourfunc$!yourarg
diff --git a/Task/Call-a-function/Bracmat/call-a-function-9.bracmat b/Task/Call-a-function/Bracmat/call-a-function-9.bracmat
new file mode 100644
index 0000000000..f0b1463208
--- /dev/null
+++ b/Task/Call-a-function/Bracmat/call-a-function-9.bracmat
@@ -0,0 +1,10 @@
+( ( plus
+ = a b
+ . !arg:%?a ?b
+ & !b:
+ & '(.!arg+$a)
+ | !a+!b
+ )
+& out$("1+2, not partial:" plus$(1 2))
+& out$("1+2, partial:" (plus$1)$2)
+);
diff --git a/Task/Call-a-function/C++/call-a-function-1.cpp b/Task/Call-a-function/C++/call-a-function-1.cpp
new file mode 100644
index 0000000000..bdd6c8d1a1
--- /dev/null
+++ b/Task/Call-a-function/C++/call-a-function-1.cpp
@@ -0,0 +1,2 @@
+/* function with no arguments */
+foo();
diff --git a/Task/Call-a-function/C++/call-a-function-2.cpp b/Task/Call-a-function/C++/call-a-function-2.cpp
new file mode 100644
index 0000000000..355c82c0da
--- /dev/null
+++ b/Task/Call-a-function/C++/call-a-function-2.cpp
@@ -0,0 +1,5 @@
+/* passing arguments by value*/
+/* function with one argument */
+bar(arg1);
+/* function with multiple arguments */
+baz(arg1, arg2);
diff --git a/Task/Call-a-function/C++/call-a-function-3.cpp b/Task/Call-a-function/C++/call-a-function-3.cpp
new file mode 100644
index 0000000000..e849ff42a2
--- /dev/null
+++ b/Task/Call-a-function/C++/call-a-function-3.cpp
@@ -0,0 +1,2 @@
+/* get return value of a function */
+variable = function(args);
diff --git a/Task/Call-a-function/C++/call-a-function-4.cpp b/Task/Call-a-function/C++/call-a-function-4.cpp
new file mode 100644
index 0000000000..ad907045b9
--- /dev/null
+++ b/Task/Call-a-function/C++/call-a-function-4.cpp
@@ -0,0 +1,14 @@
+#include
+using namespace std;
+/* passing arguments by reference */
+void f(int &y) /* variable is now passed by reference */
+{
+y++;
+}
+int main()
+{
+int x = 0;
+cout<<"x = "<x^2)(3); \\ first-class
x = sin(0); \\ get function value
diff --git a/Task/Call-a-function/Ruby/call-a-function-1.rb b/Task/Call-a-function/Ruby/call-a-function-1.rb
new file mode 100644
index 0000000000..4b81eed548
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-1.rb
@@ -0,0 +1,4 @@
+def foo() p "foo" end
+
+foo #=> "foo"
+foo() #=> "foo"
diff --git a/Task/Call-a-function/Ruby/call-a-function-10.rb b/Task/Call-a-function/Ruby/call-a-function-10.rb
new file mode 100644
index 0000000000..c5432f1363
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-10.rb
@@ -0,0 +1,13 @@
+# return value substance
+i = 3
+p 1 + i #=> 4 1.+(i)
+p i < 5 #=> true i.<(5)
+p 2 ** i #=> 8 2.**(i)
+p -i #=> -3 i.-@()
+a = [1,2,3]
+p a[0] #=> 1 a.[](0)
+a[2] = "0" # a.[]=(2,"0")
+p a << 5 #=> [1, 2, "0", 5] a.<<(5)
+p a & [4,2] #=> [2] a.&([4,2])
+p "abcde"[1..3] #=> "bcd" "abcde".[](1..3)
+p "%2d %4s" % [1,"xyz"] #=> " 1 xyz" "%2d %4s".%([1,"xyz"])
diff --git a/Task/Call-a-function/Ruby/call-a-function-2.rb b/Task/Call-a-function/Ruby/call-a-function-2.rb
new file mode 100644
index 0000000000..6f729120c4
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-2.rb
@@ -0,0 +1,5 @@
+def foo arg; p arg end # one argument
+
+foo(1) #=> 1
+foo "1" #=> "1"
+foo [0,1,2] #=> [0, 1, 2] (one Array)
diff --git a/Task/Call-a-function/Ruby/call-a-function-3.rb b/Task/Call-a-function/Ruby/call-a-function-3.rb
new file mode 100644
index 0000000000..1c20d1ce73
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-3.rb
@@ -0,0 +1,6 @@
+def foo(x=0, y=x, flag=true) p [x,y,flag] end
+
+foo #=> [0, 0, true]
+foo(1) #=> [1, 1, true]
+foo(1,2) #=> [1, 2, true]
+foo 1,2,false #=> [1, 2, false]
diff --git a/Task/Call-a-function/Ruby/call-a-function-4.rb b/Task/Call-a-function/Ruby/call-a-function-4.rb
new file mode 100644
index 0000000000..ecd144f0c0
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-4.rb
@@ -0,0 +1,4 @@
+def foo(*args) p args end
+
+foo #=> []
+foo(1,2,3,4,5) #=> [1, 2, 3, 4, 5]
diff --git a/Task/Call-a-function/Ruby/call-a-function-5.rb b/Task/Call-a-function/Ruby/call-a-function-5.rb
new file mode 100644
index 0000000000..f86f32bd24
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-5.rb
@@ -0,0 +1,3 @@
+def foo(id:0, name:"", age:0) p [id, name, age] end
+
+foo(age:22, name:"Tom") #=> [0, "Tom", 22]
diff --git a/Task/Call-a-function/Ruby/call-a-function-6.rb b/Task/Call-a-function/Ruby/call-a-function-6.rb
new file mode 100644
index 0000000000..2e26364a11
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-6.rb
@@ -0,0 +1,12 @@
+def foo(a,b) a + b end
+
+bar = foo 10,20
+p bar #=> 30
+p foo("abc","def") #=> "abcdef"
+
+# return multiple values
+def sum_and_product(a,b) return a+b,a*b end
+
+x,y = sum_and_product(3,5)
+p x #=> 8
+p y #=> 15
diff --git a/Task/Call-a-function/Ruby/call-a-function-7.rb b/Task/Call-a-function/Ruby/call-a-function-7.rb
new file mode 100644
index 0000000000..33a94114cb
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-7.rb
@@ -0,0 +1,12 @@
+puts "OK!" # Kernel#puts
+raise "Error input" # Kernel#raise
+Integer("123") # Kernel#Integer
+rand(6) # Kernel#rand
+throw(:exit) # Kernel#throw
+
+# method which can be seen like a reserved word.
+attr_accessor # Module#attr_accessor
+include # Module#include
+private # Module#private
+require # Kernel#require
+loop { } # Kernel#loop
diff --git a/Task/Call-a-function/Ruby/call-a-function-8.rb b/Task/Call-a-function/Ruby/call-a-function-8.rb
new file mode 100644
index 0000000000..08641cab1a
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-8.rb
@@ -0,0 +1,14 @@
+class Array
+ def sum(init=0, &blk)
+ if blk
+ inject(init){|s, n| s + blk.call(n)}
+ else
+ inject(init){|s, n| s + n}
+ end
+ end
+end
+
+ary = [1,2,3,4,5]
+p ary.sum #=> 15
+p ary.sum(''){|n| (-n).to_s} #=> "-1-2-3-4-5"
+p (ary.sum do |n| n * n end) #=> 55
diff --git a/Task/Call-a-function/Ruby/call-a-function-9.rb b/Task/Call-a-function/Ruby/call-a-function-9.rb
new file mode 100644
index 0000000000..edcc955011
--- /dev/null
+++ b/Task/Call-a-function/Ruby/call-a-function-9.rb
@@ -0,0 +1,6 @@
+def foo(a,b,c) p [a,b,c] end
+
+args = [1,2,3]
+foo *args #=> [1, 2, 3]
+args = [1,2]
+foo(0,*args) #=> [0, 1, 2]
diff --git a/Task/Call-an-object-method/Ada/call-an-object-method-1.ada b/Task/Call-an-object-method/Ada/call-an-object-method-1.ada
new file mode 100644
index 0000000000..e93faaa423
--- /dev/null
+++ b/Task/Call-an-object-method/Ada/call-an-object-method-1.ada
@@ -0,0 +1,8 @@
+ package My_Class is
+ type Object is tagged private;
+ procedure Primitive(Self: Object); -- primitive subprogram
+ procedure Dynamic(Self: Object'Class);
+ procedure Static;
+ private
+ type Object is tagged null record;
+ end My_Class;
diff --git a/Task/Call-an-object-method/Ada/call-an-object-method-2.ada b/Task/Call-an-object-method/Ada/call-an-object-method-2.ada
new file mode 100644
index 0000000000..2c4d8a5cbe
--- /dev/null
+++ b/Task/Call-an-object-method/Ada/call-an-object-method-2.ada
@@ -0,0 +1,18 @@
+ package body My_Class is
+ procedure Primitive(Self: Object) is
+ begin
+ Put_Line("Hello World!");
+ end Primitive;
+
+ procedure Dynamic(Self: Object'Class) is
+ begin
+ Put("Hi there! ... ");
+ Self.Primitive; -- dispatching call: calls different subprograms,
+ -- depending on the type of Self
+ end Dynamic;
+
+ procedure Static is
+ begin
+ Put_Line("Greetings");
+ end Static;
+ end My_Class;
diff --git a/Task/Call-an-object-method/Ada/call-an-object-method-3.ada b/Task/Call-an-object-method/Ada/call-an-object-method-3.ada
new file mode 100644
index 0000000000..f798d282a6
--- /dev/null
+++ b/Task/Call-an-object-method/Ada/call-an-object-method-3.ada
@@ -0,0 +1,11 @@
+ package Other_Class is
+ type Object is new My_Class.Object with null record;
+ overriding procedure Primitive(Self: Object);
+ end Other_Class;
+
+ package body Other_Class is
+ procedure Primitive(Self: Object) is
+ begin
+ Put_Line("Hello Universe!");
+ end Primitive;
+ end Other_Class;
diff --git a/Task/Call-an-object-method/Ada/call-an-object-method-4.ada b/Task/Call-an-object-method/Ada/call-an-object-method-4.ada
new file mode 100644
index 0000000000..f839fbf175
--- /dev/null
+++ b/Task/Call-an-object-method/Ada/call-an-object-method-4.ada
@@ -0,0 +1,20 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Call_Method is
+
+ package My_Class is ... -- see above
+ package body My_Class is ... -- see above
+
+ package Other_Class is ... -- see above
+ package body Other_Class is ... -- see above
+
+ Ob1: My_Class.Object; -- our "root" type
+ Ob2: Other_Class.Object; -- a type derived from the "root" type
+
+begin
+ My_Class.Static;
+ Ob1.Primitive;
+ Ob2.Primitive;
+ Ob1.Dynamic;
+ Ob2.Dynamic;
+end Call_Method;
diff --git a/Task/Call-an-object-method/Forth/call-an-object-method.fth b/Task/Call-an-object-method/Forth/call-an-object-method-1.fth
similarity index 100%
rename from Task/Call-an-object-method/Forth/call-an-object-method.fth
rename to Task/Call-an-object-method/Forth/call-an-object-method-1.fth
diff --git a/Task/Call-an-object-method/Forth/call-an-object-method-2.fth b/Task/Call-an-object-method/Forth/call-an-object-method-2.fth
new file mode 100644
index 0000000000..c1f6c32427
--- /dev/null
+++ b/Task/Call-an-object-method/Forth/call-an-object-method-2.fth
@@ -0,0 +1,29 @@
+include FMS-SI.f
+
+:class animal
+ variable cnt 0 cnt ! \ static instance variable
+ :m init: 1 cnt +! ;m
+ :m cnt: cnt @ . ;m
+;class
+
+:class cat 2 ok
+Sparky cnt: \ => 2 ok
+Frisky speak \ => meow ok
+Sparky speak \ => woof ok
diff --git a/Task/Call-an-object-method/Fortran/call-an-object-method.f b/Task/Call-an-object-method/Fortran/call-an-object-method.f
new file mode 100644
index 0000000000..05ec21cae9
--- /dev/null
+++ b/Task/Call-an-object-method/Fortran/call-an-object-method.f
@@ -0,0 +1,14 @@
+! type declaration
+type my_type
+ contains
+procedure, pass :: method1
+procedure, pass, pointer :: method2
+end type my_type
+
+! declare object of type my_type
+type(my_type) :: mytype_object
+
+!static call
+ call mytype_object%method1() ! call method1 defined as subroutine
+!instance?
+ mytype_object%method2() ! call method2 defined as function
diff --git a/Task/Call-an-object-method/JavaScript/call-an-object-method.js b/Task/Call-an-object-method/JavaScript/call-an-object-method.js
new file mode 100644
index 0000000000..080a8a3cb4
--- /dev/null
+++ b/Task/Call-an-object-method/JavaScript/call-an-object-method.js
@@ -0,0 +1 @@
+x.y()
diff --git a/Task/Call-an-object-method/Logtalk/call-an-object-method-1.logtalk b/Task/Call-an-object-method/Logtalk/call-an-object-method-1.logtalk
new file mode 100644
index 0000000000..6d836ac851
--- /dev/null
+++ b/Task/Call-an-object-method/Logtalk/call-an-object-method-1.logtalk
@@ -0,0 +1,10 @@
+% avoid infinite metaclass regression by
+% making the metaclass an instance of itself
+:- object(metaclass,
+ instantiates(metaclass)).
+
+ :- public(me/1).
+ me(Me) :-
+ self(Me).
+
+:- end_object.
diff --git a/Task/Call-an-object-method/Logtalk/call-an-object-method-2.logtalk b/Task/Call-an-object-method/Logtalk/call-an-object-method-2.logtalk
new file mode 100644
index 0000000000..d8c2eb3857
--- /dev/null
+++ b/Task/Call-an-object-method/Logtalk/call-an-object-method-2.logtalk
@@ -0,0 +1,9 @@
+:- object(class,
+ instantiates(metaclass)).
+
+ :- public(my_class/1).
+ my_class(Class) :-
+ self(Self),
+ instantiates_class(Self, Class).
+
+:- end_object.
diff --git a/Task/Call-an-object-method/Logtalk/call-an-object-method-3.logtalk b/Task/Call-an-object-method/Logtalk/call-an-object-method-3.logtalk
new file mode 100644
index 0000000000..4e9cb5f17b
--- /dev/null
+++ b/Task/Call-an-object-method/Logtalk/call-an-object-method-3.logtalk
@@ -0,0 +1,4 @@
+:- object(instance,
+ instantiates(class)).
+
+:- end_object.
diff --git a/Task/Call-an-object-method/Logtalk/call-an-object-method-4.logtalk b/Task/Call-an-object-method/Logtalk/call-an-object-method-4.logtalk
new file mode 100644
index 0000000000..db71f07d6b
--- /dev/null
+++ b/Task/Call-an-object-method/Logtalk/call-an-object-method-4.logtalk
@@ -0,0 +1,7 @@
+| ?- class::me(Me).
+Me = class
+yes
+
+| ?- instance::my_class(Class).
+Class = class
+yes
diff --git a/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6 b/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6
index d7a99fbda4..33bdc00927 100644
--- a/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6
+++ b/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6
@@ -1,2 +1,36 @@
-ClassName.methodname(); # call class method
-$instance.methodname(); # call instance method
+class C {
+ method some-method(){ say 'I haz a method' }
+};
+my C $a-c.=new; # we need an instance of C
+$a-c.some-method; # so we can call a method
+
+sub not-a-method(Any:D $obj){ say $obj.WHAT }; # *.WHAT stringifies to the typename in parentheses
+$a-c.¬-a-method; # output: '(C)'
+my @many-cs = C.new xx 3; # a List of 3 Cs
+@many-cs>>.¬-a-method; # let's call not-a-method on all 3 Cs at once
+ # the >>. hyperoperator is a candidate for autothreading so your order of execution may vary
+my $runtime-method-name = 'some-method';
+$a-c."$runtime-method-name"(); # here some very late binding
+
+my multi method free-floating-method($self:){ # my is required or the compiler thinks we misplaced a method
+ say 'i haz a C' if $self ~~ C # we do the type check by hand
+};
+
+free-floating-method($a-c); # $self is bound to the first parameter
+$a-c.&free-floating-method; # dito but automatically
+
+$a-c.?does-not-exist; # this method does not exist so it's not called thanks to .?
+
+use MONKEY-TYPING;
+augment class Int {
+ method does-not-exists(){} # This is one way to add a method. As usual there are more then one.
+}
+
+$a-c.?does-not-exists; # now it exists and we can call it
+
+my multi method free-floating-method(C:D $self:){} # we could let the compiler do the type check
+my multi method free-floating-method(Int:D $self:){} # or let it pick the right candidate
+my @a-good-mix = (Int.new((1..100).roll),C.new).roll xx 5; # let's have a mixture of Cs and Ints
+@a-good-mix>>.&free-floating-method; # and let Perl 6 pick the right candidate for us
+
+C.some-method(); # actually we don't really need an instance of C. We can call class methods aswell.
diff --git a/Task/Call-an-object-method/PowerShell/call-an-object-method.psh b/Task/Call-an-object-method/PowerShell/call-an-object-method.psh
new file mode 100644
index 0000000000..dc5f5ea454
--- /dev/null
+++ b/Task/Call-an-object-method/PowerShell/call-an-object-method.psh
@@ -0,0 +1,3 @@
+$Date = Get-Date
+$Date.AddDays( 1 )
+[System.Math]::Sqrt( 2 )
diff --git a/Task/Canny-edge-detector/J/canny-edge-detector-1.j b/Task/Canny-edge-detector/J/canny-edge-detector-1.j
new file mode 100644
index 0000000000..620d02c544
--- /dev/null
+++ b/Task/Canny-edge-detector/J/canny-edge-detector-1.j
@@ -0,0 +1,88 @@
+NB. 2D convolution, filtering, ...
+
+convolve =: 4 : 'x apply (($x) partition y)'
+partition=: 2 1 3 0 |: {:@[ ]\ 2 1 0 |: {.@[ ]\ ]
+apply=: [: +/ [: +/ *
+max3x3 =: 3 : '(0<1{1{y) * (>./>./y)'
+addborder =: (0&,@|:@|.)^:4
+normalize =: ]%+/@,
+attach =: 3 : 'max3x3 (3 3 partition (addborder y))'
+unique =: 3 : 'y*i.$y'
+connect =: 3 : 'attach^:_ unique y'
+
+NB. on low memory devices, cropping or resampling of high-resolution images may be required
+crop =: 4 : 0
+ 'h w h0 w0' =: x
+ |: w{. w0}. |: h{. h0}. y
+)
+resample =: 4 : '|: (1{-x)(+/%#)\ |: (0{-x)(+/%#)\ y'
+NB. on e. g. smartphones, image may need to be expanded for viewing
+inflate1 =: 4 : 0
+ 'h w' =: $y
+ r =: ,y
+ c =: #r
+ rr =: (c$x) # r
+ (h,x*w)$rr
+)
+inflate =: 4 : '|: x inflate1 (|: x inflate1 y)'
+
+NB. Step 1 - gaussian smoothing
+step1 =: 3 : 0
+ NB. Gaussian kernel (from Wikipedia article)
+ <] gaussianKernel =: 5 5$2 4 5 4 2 4 9 12 9 4 5 12 15 12 5 4 9 12 9 4 2 4 5 4 2
+ gaussianKernel =: gaussianKernel % 159
+ gaussianKernel convolve y
+)
+
+NB. Step 2 - gradient
+step2 =: 3 : 0
+ <] gradientKernel =: 3 3$0 _1 0 0j_1 0 0j1 0 1 0
+ gradientKernel convolve y
+)
+
+NB. Step 3 - edge detection
+step3 =: 3 : 0
+ NB. find the octant (eighth of circle) in which the gradient lies
+ octant =: 3 : '4|(>.(_0.5+((4%(o. 1))*(12&o. y))))'
+ <(i:6)(4 : 'octant (x j. y)')"0/(i:6)
+
+ NB. is this gradient greater than [the projection of] a neighbor?
+ greaterThan =: 4 : ' (9 o.((x|.y)%y))<1'
+
+ NB. is this gradient the greatest of immmediate colinear neighbore?
+ greatestOf =: 4 : '(x greaterThan y) *. ((-x) greaterThan y)'
+
+ NB. relative address of neighbor relevant to grad direction
+ krnl0 =. _1 0
+ krnl1 =. _1 _1
+ krnl2 =. 0 _1
+ krnl3 =. 1 _1
+
+ image =. y
+ og =. octant image
+
+ NB. mask for maximum gradient colinear with gradient
+ ok0 =. (0=og) *. krnl0 greatestOf image
+ ok1 =. (1=og) *. krnl1 greatestOf image
+ ok2 =. (2=og) *. krnl2 greatestOf image
+ ok3 =. (3=og) *. krnl3 greatestOf image
+ image *. (ok0 +. ok1 +. ok2 +. ok3)
+)
+
+NB. Step 4 - Weak edge suppression
+step4 =: 3 : 0
+ magnitude =. 10&o. y
+ NB. weak, strong threshholds
+ NB. TODO: parameter picker algorithm or helper
+ threshholds =. 1e14 1e15
+ nearbyKernel =. 3 3 $ 4 1 4 # 1 0 1
+ weak =. magnitude > 0{threshholds
+ strong =. magnitude > 1{threshholds
+ strongs =. addborder (nearbyKernel convolve strong) > 0
+ strong +. (weak *. strongs)
+)
+
+NB. given the edge points, find the edges
+ step5 =: connect
+
+canny =: step5 @ step4 @ step3 @ step2 @ step1
diff --git a/Task/Canny-edge-detector/J/canny-edge-detector-2.j b/Task/Canny-edge-detector/J/canny-edge-detector-2.j
new file mode 100644
index 0000000000..28af06fca9
--- /dev/null
+++ b/Task/Canny-edge-detector/J/canny-edge-detector-2.j
@@ -0,0 +1,58 @@
+require 'gl2'
+coclass 'edge'
+coinsert'jgl2'
+
+PJ=: jpath '~Projects/edges/' NB. optionally install and run as project under IDE
+load PJ,'canny.ijs'
+
+run=: 3 : 0
+ wd 'pc form;pn canny'
+ wd 'cc txt static;cn "Canny in J";'
+ wd 'cc png isidraw'
+ wd 'cc inc button;cn "Next";'
+ wd 'pshow'
+ glclear''
+ image =: readimg_jqtide_ PJ,'valve.png'
+ image =: 240 360 120 150 crop image
+ edges =: canny 256 | image
+ ids =: }. ~.,edges
+ nids =: # ids
+ case =: 0
+)
+
+form_inc_button =: 3 : 0
+ select. case
+ case. 0 do.
+ wd 'set txt text "original image";'
+ img =: 255 setalpha image
+ case. 1 do.
+ wd 'set txt text "points on edges";'
+ img =: edges>0
+ img =: 1-img
+ img =: img * (+/ 256^i.3) * 255
+ img =: 255 setalpha img
+ ix =: 0
+ case. 2 do.
+ wd 'set txt text "... iterating over edges with >75 points ...";'
+ img =: edges=ix{ids
+ whilst. (num<75) *. (ix:ix
+ if. ix=#ids do. case=:_1 end.
+ end.
+ img =: 1-img
+ img =: img * (+/ 256^i.3) * 255
+ img =: 255 setalpha img
+ ix =: (#ids)|(>:ix)
+ end.
+ if. case<2 do. case =: >: case end.
+ NB. img =: 5 inflate img NB. might need this for high-res cellphone display
+ glfill 255 128 255
+ glpixels 0 0,(|.$img), ,img
+ glpaint''
+)
+
+form_close=: exit bind 0
+
+run''
diff --git a/Task/Canny-edge-detector/MATLAB/canny-edge-detector.m b/Task/Canny-edge-detector/MATLAB/canny-edge-detector.m
new file mode 100644
index 0000000000..eadd1148a7
--- /dev/null
+++ b/Task/Canny-edge-detector/MATLAB/canny-edge-detector.m
@@ -0,0 +1 @@
+BWImage = edge(GrayscaleImage,'canny');
diff --git a/Task/Canny-edge-detector/Mathematica/canny-edge-detector.math b/Task/Canny-edge-detector/Mathematica/canny-edge-detector.math
new file mode 100644
index 0000000000..7b3fa01c8e
--- /dev/null
+++ b/Task/Canny-edge-detector/Mathematica/canny-edge-detector.math
@@ -0,0 +1 @@
+Export["out.bmp", EdgeDetect[Import[InputString[]]]];
diff --git a/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-1.julia b/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-1.julia
new file mode 100644
index 0000000000..85c36fc988
--- /dev/null
+++ b/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-1.julia
@@ -0,0 +1,19 @@
+function carmichael{T<:Integer}(pmax::T)
+ 0 < pmax || throw(DomainError())
+ car = T[]
+ for p in primes(pmax)
+ for h₃ in 2:(p-1)
+ m = (p - 1)*(h₃ + p)
+ pmh = mod(-p^2, h₃)
+ for Δ in 1:(h₃+p-1)
+ m%Δ==0 && Δ%h₃==pmh || continue
+ q = div(m, Δ) + 1
+ isprime(q) || continue
+ r = div((p*q - 1), h₃) + 1
+ isprime(r) && mod(q*r, (p-1))==1 || continue
+ append!(car, [p, q, r])
+ end
+ end
+ end
+ reshape(car, 3, div(length(car), 3))
+end
diff --git a/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-2.julia b/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-2.julia
new file mode 100644
index 0000000000..727ab57be2
--- /dev/null
+++ b/Task/Carmichael-3-strong-pseudoprimes/Julia/carmichael-3-strong-pseudoprimes-2.julia
@@ -0,0 +1,23 @@
+hi = 61
+car = carmichael(hi)
+
+curp = 0
+tcnt = 0
+print("Carmichael 3 (p\u00d7q\u00d7r) Pseudoprimes, up to p = ", hi, ":")
+for j in sortperm(1:size(car)[2], by=x->(car[1,x], car[2,x], car[3,x]))
+ p, q, r = car[:,j]
+ c = prod(car[:,j])
+ if p != curp
+ curp = p
+ print(@sprintf("\n\np = %d\n ", p))
+ tcnt = 0
+ end
+ if tcnt == 4
+ print("\n ")
+ tcnt = 1
+ else
+ tcnt += 1
+ end
+ print(@sprintf("p\u00d7%d\u00d7%d = %d ", q, r, c))
+end
+println("\n\n", size(car)[2], " results in total.")
diff --git a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx
index 7e7194592e..d3d148464b 100644
--- a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx
+++ b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx
@@ -20,7 +20,6 @@ carms=0 /*number of Carmichael #s so far.*/
if \isPrime(r) then iterate
carms=carms+1; @.q=r /*bump Carmichael #; add to array*/
if bot==0 then bot=q; bot=min(bot,q); top=max(top,q)
- /*find the maximum. */
end /*d*/ /* [↑] find minimum and maximum.*/
end /*h3*/
$=0 /*display a list of some Carm #s.*/
diff --git a/Task/Carmichael-3-strong-pseudoprimes/Ruby/carmichael-3-strong-pseudoprimes.rb b/Task/Carmichael-3-strong-pseudoprimes/Ruby/carmichael-3-strong-pseudoprimes.rb
index 5ff00fb73a..897b387ba8 100644
--- a/Task/Carmichael-3-strong-pseudoprimes/Ruby/carmichael-3-strong-pseudoprimes.rb
+++ b/Task/Carmichael-3-strong-pseudoprimes/Ruby/carmichael-3-strong-pseudoprimes.rb
@@ -1,21 +1,18 @@
# Generate Charmichael Numbers
-#
-# Nigel_Galloway
-# November 30th., 2012.
-#
+
require 'prime'
-Integer.each_prime(61) {|p|
- (2...p).each {|h3|
+Prime.each(61) do |p|
+ (2...p).each do |h3|
g = h3 + p
- (1...g).each {|d|
- next if (g*(p-1)) % d != 0 or (-1*p*p) % h3 != d % h3
+ (1...g).each do |d|
+ next if (g*(p-1)) % d != 0 or (-p*p) % h3 != d % h3
q = 1 + ((p - 1) * g / d)
- next if not q.prime?
+ next unless q.prime?
r = 1 + (p * q / h3)
- next if not r.prime? or not (q * r) % (p - 1) == 1
- puts "#{p} X #{q} X #{r}"
- }
- }
- puts ""
-}
+ next unless r.prime? and (q * r) % (p - 1) == 1
+ puts "#{p} x #{q} x #{r}"
+ end
+ end
+ puts
+end
diff --git a/Task/Case-sensitivity-of-identifiers/ALGOL-W/case-sensitivity-of-identifiers.alg b/Task/Case-sensitivity-of-identifiers/ALGOL-W/case-sensitivity-of-identifiers.alg
new file mode 100644
index 0000000000..c6cf4ebd2a
--- /dev/null
+++ b/Task/Case-sensitivity-of-identifiers/ALGOL-W/case-sensitivity-of-identifiers.alg
@@ -0,0 +1,16 @@
+begin
+ string(8) dog;
+ dog := "Benjamin";
+ begin
+ string(8) Dog;
+ Dog := "Samba";
+ begin
+ string(8) DOG;
+ DOG := "Bernie";
+ if DOG not = Dog
+ or DOG not = dog
+ then write( "The three dogs are named: ", dog, ", ", Dog, " and ", DOG )
+ else write( "There is just one dog named: ", DOG )
+ end
+ end
+end.
diff --git a/Task/Case-sensitivity-of-identifiers/Julia/case-sensitivity-of-identifiers.julia b/Task/Case-sensitivity-of-identifiers/Julia/case-sensitivity-of-identifiers.julia
new file mode 100644
index 0000000000..38ea5769ca
--- /dev/null
+++ b/Task/Case-sensitivity-of-identifiers/Julia/case-sensitivity-of-identifiers.julia
@@ -0,0 +1,9 @@
+dog = "Benjamin"
+Dog = "Samba"
+DOG = "Bernie"
+
+if is(dog, Dog)
+ println("There is only one dog, ", DOG)
+else
+ println("The three dogs are: ", dog, ", ", Dog, " and ", DOG)
+end
diff --git a/Task/Catalan-numbers-Pascals-triangle/Elixir/catalan-numbers-pascals-triangle.elixir b/Task/Catalan-numbers-Pascals-triangle/Elixir/catalan-numbers-pascals-triangle.elixir
new file mode 100644
index 0000000000..a66bed856f
--- /dev/null
+++ b/Task/Catalan-numbers-Pascals-triangle/Elixir/catalan-numbers-pascals-triangle.elixir
@@ -0,0 +1,15 @@
+defmodule Catalan do
+ def numbers(num) do
+ {result,_} = Enum.reduce(1..num, {[],{0,1}}, fn i,{list,t0} ->
+ t1 = numbers(i, t0)
+ t2 = numbers(i+1, Tuple.insert_at(t1, i+1, elem(t1, i)))
+ {[elem(t2, i+1) - elem(t2, i) | list], t2}
+ end)
+ Enum.reverse(result)
+ end
+
+ defp numbers(0, t), do: t
+ defp numbers(n, t), do: numbers(n-1, put_elem(t, n, elem(t, n-1) + elem(t, n)))
+end
+
+IO.inspect Catalan.numbers(15)
diff --git a/Task/Catalan-numbers-Pascals-triangle/Haskell/catalan-numbers-pascals-triangle.hs b/Task/Catalan-numbers-Pascals-triangle/Haskell/catalan-numbers-pascals-triangle.hs
new file mode 100644
index 0000000000..a52153200c
--- /dev/null
+++ b/Task/Catalan-numbers-Pascals-triangle/Haskell/catalan-numbers-pascals-triangle.hs
@@ -0,0 +1,19 @@
+import System.Environment (getArgs)
+
+-- Pascal's triangle.
+pascal :: [[Integer]]
+pascal = [1] : map (\row -> 1 : zipWith (+) row (tail row) ++ [1]) pascal
+
+-- The Catalan numbers from Pascal's triangle. This uses a method from
+-- http://www.cut-the-knot.org/arithmetic/algebra/CatalanInPascal.shtml
+-- (see "Grimaldi").
+catalan :: [Integer]
+catalan = map (diff . uncurry drop) $ zip [0..] (alt pascal)
+ where alt (x:_:zs) = x : alt zs -- every other element of an infinite list
+ diff (x:y:_) = x - y
+ diff (x:_) = x
+
+main :: IO ()
+main = do
+ ns <- fmap (map read) getArgs :: IO [Int]
+ mapM_ (print . flip take catalan) ns
diff --git a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js
new file mode 100644
index 0000000000..7b569e9259
--- /dev/null
+++ b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js
@@ -0,0 +1,7 @@
+var n=15
+for (var t=[0,1], i=1; i<=n; i++) {
+ for (var j=i; j>1; j--) t[j] += t[j-1]
+ t[i+1] = t[i];
+ for (var j=i+1; j>1; j--) t[j] += t[j-1]
+ document.write(i==1 ? '' : ', ', t[i+1] - t[i])
+}
diff --git a/Task/Catalan-numbers-Pascals-triangle/Perl-6/catalan-numbers-pascals-triangle.pl6 b/Task/Catalan-numbers-Pascals-triangle/Perl-6/catalan-numbers-pascals-triangle.pl6
index 09b1b7240b..964c18a758 100644
--- a/Task/Catalan-numbers-Pascals-triangle/Perl-6/catalan-numbers-pascals-triangle.pl6
+++ b/Task/Catalan-numbers-Pascals-triangle/Perl-6/catalan-numbers-pascals-triangle.pl6
@@ -1,4 +1,4 @@
-constant @pascal = [1], -> @p { [0, @p Z+ @p, 0] } ... *;
+constant @pascal = [1], -> @p { [0, |@p Z+ |@p, 0] } ... *;
constant @catalan = gather for 2, 4 ... * -> $ix {
my @row := @pascal[$ix];
diff --git a/Task/Catalan-numbers-Pascals-triangle/Ruby/catalan-numbers-pascals-triangle.rb b/Task/Catalan-numbers-Pascals-triangle/Ruby/catalan-numbers-pascals-triangle.rb
index fa0d6665b6..7f63f98512 100644
--- a/Task/Catalan-numbers-Pascals-triangle/Ruby/catalan-numbers-pascals-triangle.rb
+++ b/Task/Catalan-numbers-Pascals-triangle/Ruby/catalan-numbers-pascals-triangle.rb
@@ -1,6 +1,6 @@
def catalan(num)
t = [0, 1] #grows as needed
- 1.upto(num).map do |i|
+ (1..num).map do |i|
i.downto(1){|j| t[j] += t[j-1]}
t[i+1] = t[i]
(i+1).downto(1) {|j| t[j] += t[j-1]}
@@ -8,4 +8,4 @@ def catalan(num)
end
end
-puts catalan(15).join(", ")
+p catalan(15)
diff --git a/Task/Catalan-numbers/360-Assembly/catalan-numbers.360 b/Task/Catalan-numbers/360-Assembly/catalan-numbers.360
new file mode 100644
index 0000000000..1db03f7569
--- /dev/null
+++ b/Task/Catalan-numbers/360-Assembly/catalan-numbers.360
@@ -0,0 +1,22 @@
+CATALAN CSECT
+ USING CATALAN,R15
+ LA R7,1 c=1
+ LA R6,1 i=1
+LOOPI CH R6,=H'15' do i=1 to 15
+ BH ELOOPI
+ XDECO R6,PG edit i
+ LR R5,R6 i
+ SLA R5,1 *2
+ BCTR R5,0 -1
+ SLA R5,1 *2
+ MR R4,R7 *c
+ LA R6,1(R6) i=i+1
+ DR R4,R6 /i
+ LR R7,R5 c=2*(2*i-1)*c/(i+1)
+ XDECO R7,PG+12 edit c
+ XPRNT PG,24 print
+ B LOOPI next i
+ELOOPI BR R14
+PG DS CL24
+ YREGS
+ END CATALAN
diff --git a/Task/Catalan-numbers/Befunge/catalan-numbers.bf b/Task/Catalan-numbers/Befunge/catalan-numbers.bf
new file mode 100644
index 0000000000..1b71d55cfb
--- /dev/null
+++ b/Task/Catalan-numbers/Befunge/catalan-numbers.bf
@@ -0,0 +1,4 @@
+0>:.:000p1>\:00g-#v_v
+v 2-1*2p00 :+1g00\< $
+> **00g1+/^v,*84,"="<
+_^#<`*53:+1>#,.#+5< @
diff --git a/Task/Catalan-numbers/Eiffel/catalan-numbers.e b/Task/Catalan-numbers/Eiffel/catalan-numbers.e
new file mode 100644
index 0000000000..b1ded6700c
--- /dev/null
+++ b/Task/Catalan-numbers/Eiffel/catalan-numbers.e
@@ -0,0 +1,35 @@
+class
+ APPLICATION
+
+create
+ make
+
+feature {NONE}
+
+ make
+ do
+ across
+ 0 |..| 14 as c
+ loop
+ io.put_double (catalan_numbers (c.item))
+ io.new_line
+ end
+ end
+
+ nth_catalan_number (n: INTEGER): DOUBLE
+ --'n'th number in the sequence of Catalan numbers.
+ require
+ n_not_negative: n >= 0
+ local
+ s, t: DOUBLE
+ do
+ if n = 0 then
+ Result := 1.0
+ else
+ t := 4 * n.to_double - 2
+ s := n.to_double + 1
+ Result := t / s * catalan_numbers (n - 1)
+ end
+ end
+
+end
diff --git a/Task/Catalan-numbers/Elixir/catalan-numbers.elixir b/Task/Catalan-numbers/Elixir/catalan-numbers.elixir
new file mode 100644
index 0000000000..b48b69b594
--- /dev/null
+++ b/Task/Catalan-numbers/Elixir/catalan-numbers.elixir
@@ -0,0 +1,23 @@
+defmodule Catalan do
+ def cat(n), do: div( factorial(2*n), factorial(n+1) * factorial(n) )
+
+ defp factorial(n), do: fac1(n,1)
+
+ defp fac1(0, acc), do: acc
+ defp fac1(n, acc), do: fac1(n-1, n*acc)
+
+ def cat_r1(0), do: 1
+ def cat_r1(n), do: Enum.sum(for i <- 0..n-1, do: cat_r1(i) * cat_r1(n-1-i))
+
+ def cat_r2(0), do: 1
+ def cat_r2(n), do: div(cat_r2(n-1) * 2 * (2*n - 1), n + 1)
+
+ def test do
+ range = 0..14
+ :io.format "Directly:~n~p~n", [(for n <- range, do: cat(n))]
+ :io.format "1st recusive method:~n~p~n", [(for n <- range, do: cat_r1(n))]
+ :io.format "2nd recusive method:~n~p~n", [(for n <- range, do: cat_r2(n))]
+ end
+end
+
+Catalan.test
diff --git a/Task/Catalan-numbers/Perl-6/catalan-numbers-1.pl6 b/Task/Catalan-numbers/Perl-6/catalan-numbers-1.pl6
new file mode 100644
index 0000000000..e728d22cbb
--- /dev/null
+++ b/Task/Catalan-numbers/Perl-6/catalan-numbers-1.pl6
@@ -0,0 +1 @@
+constant Catalan = 1, { [+] @_ Z* @_.reverse } ... *;
diff --git a/Task/Catalan-numbers/Perl-6/catalan-numbers-2.pl6 b/Task/Catalan-numbers/Perl-6/catalan-numbers-2.pl6
new file mode 100644
index 0000000000..fa95984dc4
--- /dev/null
+++ b/Task/Catalan-numbers/Perl-6/catalan-numbers-2.pl6
@@ -0,0 +1 @@
+constant Catalan = 1, |[\*] (2, 6 ... *) Z/ 2 .. *;
diff --git a/Task/Catalan-numbers/Perl-6/catalan-numbers-3.pl6 b/Task/Catalan-numbers/Perl-6/catalan-numbers-3.pl6
new file mode 100644
index 0000000000..65a32e0c03
--- /dev/null
+++ b/Task/Catalan-numbers/Perl-6/catalan-numbers-3.pl6
@@ -0,0 +1 @@
+.say for Catalan[^15];
diff --git a/Task/Catalan-numbers/Perl-6/catalan-numbers.pl6 b/Task/Catalan-numbers/Perl-6/catalan-numbers.pl6
deleted file mode 100644
index ee095b566f..0000000000
--- a/Task/Catalan-numbers/Perl-6/catalan-numbers.pl6
+++ /dev/null
@@ -1,3 +0,0 @@
-constant Catalan = 1, [\*] (2, 6 ... *) Z/ 2 .. *;
-
-.say for Catalan[^15];
diff --git a/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx b/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx
index 9d649a5d70..0e9e78bdb1 100644
--- a/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx
+++ b/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx
@@ -1,31 +1,31 @@
-/*REXX program calculates Catalan numbers using four different methods.*/
-parse arg bot top . /*get optional args from the C.L.*/
-if bot=='' then do; top=15; bot=0; end /*No args? Use a range of 0──►15.*/
-if top=='' then top=bot /*No top? Use the bottom for it.*/
-numeric digits max(20, 5*top) /*allows gihugic Catalan numbers.*/
-call hdr '1a'; do j=bot to top; say $cat() catalan1a(j); end
-call hdr '1b'; do j=bot to top; say $cat() catalan1b(j); end
-call hdr 2 ; do j=bot to top; say $cat() catalan2(j) ; end
-call hdr 3 ; do j=bot to top; say $cat() catalan3(j) ; end
-exit /*stick a fork in it, we're done.*/
-/*──────────────────────────────────one─liner subroutines───────────────*/
-$cat: return ' Catalan' right(j,length(top))": "
-catalan1a: procedure expose !.; parse arg n; return comb(n+n,n)%(n+1)
-catalan1b: procedure expose !.; parse arg n; return !(n+n)%((n+1)*!(n)**2)
-comb: procedure; parse arg x,y; return pFact(x-y+1,x) % pFact(2,y)
-pFact: procedure; !=1; do k=arg(1) to arg(2); !=!*k; end; return !
-/*──────────────────────────────────! (factorial) function──────────────*/
-!: procedure expose !.; parse arg x; if !.x\==. then return !.x
-!=1; do k=1 for x; !=!*k; end /*k*/; !.x=!; return !
-/*──────────────────────────────────catalan method 2────────────────────*/
-catalan2: procedure expose c.; parse arg n; if c.n\==. then return c.n
-s=0; do k=0 to n-1
- s=s + catalan2(k) * catalan2(n-k-1) /*recursive invokes*/
- end /*k*/
-c.n=s; return s /*use REXX memoization technique.*/
-/*──────────────────────────────────catalan method 3────────────────────*/
-catalan3: procedure expose c.; parse arg n; if c.n\==. then return c.n
-c.n=(4*n-2) * catalan3(n-1) % (n+1); return c.n /*use memoization.*/
-/*──────────────────────────────────HDR subroutine──────────────────────*/
-hdr: !.=.; c.=.; c.0=1; say /*set some variables; blank line.*/
+/*REXX program calculates Catalan numbers using four different methods. */
+parse arg bot top . /*get optional arguments from the C.L. */
+if bot=='' then do; top=15; bot=0; end /*No args? Use a range of 0 ───► 15. */
+if top=='' then top=bot /*No top? Use the bottom for default. */
+numeric digits max(20, 5*top) /*this allows gihugic Catalan numbers. */
+@cat=' Catalan' /*a nice literal to have for the SAY. */
+w=length(top) /*width of the largest number for SAY. */
+call hdr 1A; do j=bot to top; say @cat right(j,w)": " Catalan1A(j); end
+call hdr 1B; do j=bot to top; say @cat right(j,w)": " Catalan1B(j); end
+call hdr 2 ; do j=bot to top; say @cat right(j,w)": " Catalan2(j); end
+call hdr 3 ; do j=bot to top; say @cat right(j,w)": " Catalan3(j); end
+exit /*stick a fork in it, we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+Catalan1A: procedure expose !.; parse arg n; return comb(n+n, n) % (n+1)
+Catalan1B: procedure expose !.; parse arg n; return !(n+n) % ((n+1) * !(n)**2)
+comb: procedure; parse arg x,y; return pFact(x-y+1,x) % pFact(2,y)
+pFact: procedure; !=1; do k=arg(1) to arg(2); !=!*k; end; return !
+/*────────────────────────────────────────────────────────────────────────────*/
+hdr: !.=.; c.=.; c.0=1; say
say center(' Catalan numbers, method' left(arg(1),3), 79, '─'); return
+/*────────────────────────────────────────────────────────────────────────────*/
+!: procedure expose !.; parse arg x; !=1; if !.x\==. then return !.x
+ do k=1 for x; !=!*k; end /*k*/
+ !.x=!; return !
+/*──────────────────────────────────Catalan method 2──────────────────────────*/
+Catalan2: procedure expose c.; parse arg n; $=0; if c.n\==. then return c.n
+ do k=0 to n-1; $=$+catalan2(k)*catalan2(n-k-1); end
+ c.n=$; return $ /*use a REXX memoization technique. */
+/*──────────────────────────────────Catalan method 3──────────────────────────*/
+Catalan3: procedure expose c.; parse arg n
+ if c.n==. then c.n=(4*n-2) * catalan3(n-1) % (n+1); return c.n
diff --git a/Task/Catalan-numbers/Ruby/catalan-numbers.rb b/Task/Catalan-numbers/Ruby/catalan-numbers.rb
index a44b359b87..dbe9ef332b 100644
--- a/Task/Catalan-numbers/Ruby/catalan-numbers.rb
+++ b/Task/Catalan-numbers/Ruby/catalan-numbers.rb
@@ -1,9 +1,9 @@
-# direct
-
def factorial(n)
- (1..n).reduce(:*)
+ (1..n).reduce(1, :*)
end
+# direct
+
def catalan_direct(n)
factorial(2*n) / (factorial(n+1) * factorial(n))
end
@@ -12,12 +12,12 @@ end
def catalan_rec1(n)
return 1 if n == 0
- (0..n-1).inject(0) {|sum, i| sum + catalan_rec1(i) * catalan_rec1(n-1-i)}
+ (0...n).inject(0) {|sum, i| sum + catalan_rec1(i) * catalan_rec1(n-1-i)}
end
def catalan_rec2(n)
return 1 if n == 0
- 2*(2*n - 1) * catalan_rec2(n-1) /(n+1)
+ 2*(2*n - 1) * catalan_rec2(n-1) / (n+1)
end
# performance and results
@@ -26,17 +26,14 @@ require 'benchmark'
require 'memoize'
include Memoize
-Benchmark.bm(10) do |b|
- b.report('forget') {
- 16.times {|n| [n, catalan_direct(n), catalan_rec1(n), catalan_rec2(n)]}
- }
- b.report('memoized') {
- memoize :factorial
- memoize :catalan_direct
- memoize :catalan_rec1
- memoize :catalan_rec2
- 16.times {|n| [n, catalan_direct(n), catalan_rec1(n), catalan_rec2(n)]}
- }
+Benchmark.bm(17) do |b|
+ b.report('catalan_direct') {16.times {|n| catalan_direct(n)} }
+ b.report('catalan_rec1') {16.times {|n| catalan_rec1(n)} }
+ b.report('catalan_rec2') {16.times {|n| catalan_rec2(n)} }
+
+ memoize :catalan_rec1
+ b.report('catalan_rec1(memo)'){16.times {|n| catalan_rec1(n)} }
end
-16.times {|n| p [n, catalan_direct(n), catalan_rec1(n), catalan_rec2(n)]}
+puts "\n direct rec1 rec2"
+16.times {|n| puts "%2d :%9d%9d%9d" % [n, catalan_direct(n), catalan_rec1(n), catalan_rec2(n)]}
diff --git a/Task/Catalan-numbers/Rust/catalan-numbers.rust b/Task/Catalan-numbers/Rust/catalan-numbers.rust
index d601e28cc7..b0e120fc97 100644
--- a/Task/Catalan-numbers/Rust/catalan-numbers.rust
+++ b/Task/Catalan-numbers/Rust/catalan-numbers.rust
@@ -1,13 +1,12 @@
-fn factorial(n: u64) -> u64 {
- range(1u64, n + 1).fold(1u64, |a, b| a * b)
-}
-
fn c_n(n: u64) -> u64 {
- factorial(n * 2) / (factorial(n + 1) * factorial(n))
+ match n {
+ 0 => 1,
+ _ => c_n(n - 1) * 2 * (2 * n - 1) / (n + 1)
+ }
}
fn main() {
- for i in range(1u64, 11u64) {
- println!("c_n({}) = {}", i, c_n(i))
+ for i in 1..16 {
+ println!("c_n({}) = {}", i, c_n(i));
}
}
diff --git a/Task/Catalan-numbers/VBScript/catalan-numbers.vb b/Task/Catalan-numbers/VBScript/catalan-numbers.vb
new file mode 100644
index 0000000000..46179b6cfa
--- /dev/null
+++ b/Task/Catalan-numbers/VBScript/catalan-numbers.vb
@@ -0,0 +1,23 @@
+Function catalan(n)
+ catalan = factorial(2*n)/(factorial(n+1)*factorial(n))
+End Function
+
+Function factorial(n)
+ If n = 0 Then
+ Factorial = 1
+ Else
+ For i = n To 1 Step -1
+ If i = n Then
+ factorial = n
+ Else
+ factorial = factorial * i
+ End If
+ Next
+ End If
+End Function
+
+'Find the first 15 Catalan numbers.
+For j = 1 To 15
+ WScript.StdOut.Write j & " = " & catalan(j)
+ WScript.StdOut.WriteLine
+Next
diff --git a/Task/Catamorphism/BBC-BASIC/catamorphism.bbc b/Task/Catamorphism/BBC-BASIC/catamorphism.bbc
new file mode 100644
index 0000000000..46f28dc80f
--- /dev/null
+++ b/Task/Catamorphism/BBC-BASIC/catamorphism.bbc
@@ -0,0 +1,15 @@
+ DIM a(4)
+ a() = 1, 2, 3, 4, 5
+ PRINT FNreduce(a(), "+")
+ PRINT FNreduce(a(), "-")
+ PRINT FNreduce(a(), "*")
+ END
+
+ DEF FNreduce(arr(), op$)
+ REM!Keep tmp, arr()
+ LOCAL I%, tmp
+ tmp = arr(0)
+ FOR I% = 1 TO DIM(arr(), 1)
+ tmp = EVAL("tmp " + op$ + " arr(I%)")
+ NEXT
+ = tmp
diff --git a/Task/Catamorphism/DCL/catamorphism.dcl b/Task/Catamorphism/DCL/catamorphism.dcl
new file mode 100644
index 0000000000..3adf4467d2
--- /dev/null
+++ b/Task/Catamorphism/DCL/catamorphism.dcl
@@ -0,0 +1,26 @@
+$ list = "1,2,3,4,5"
+$ call reduce list "+"
+$ show symbol result
+$
+$ numbers = "5,4,3,2,1"
+$ call reduce numbers "-"
+$ show symbol result
+$
+$ call reduce list "*"
+$ show symbol result
+$ exit
+$
+$ reduce: subroutine
+$ local_list = 'p1
+$ value = f$integer( f$element( 0, ",", local_list ))
+$ i = 1
+$ loop:
+$ element = f$element( i, ",", local_list )
+$ if element .eqs. "," then $ goto done
+$ value = value 'p2 f$integer( element )
+$ i = i + 1
+$ goto loop
+$ done:
+$ result == value
+$ exit
+$ endsubroutine
diff --git a/Task/Catamorphism/Elixir/catamorphism.elixir b/Task/Catamorphism/Elixir/catamorphism.elixir
new file mode 100644
index 0000000000..1dac4dca04
--- /dev/null
+++ b/Task/Catamorphism/Elixir/catamorphism.elixir
@@ -0,0 +1,6 @@
+iex(1)> Enum.reduce(1..10, fn i,acc -> i+acc end)
+55
+iex(2)> Enum.reduce(1..10, fn i,acc -> i*acc end)
+3628800
+iex(3)> Enum.reduce(10..-10, "", fn i,acc -> acc <> to_string(i) end)
+"109876543210-1-2-3-4-5-6-7-8-9-10"
diff --git a/Task/Catamorphism/Erlang/catamorphism.erl b/Task/Catamorphism/Erlang/catamorphism.erl
new file mode 100644
index 0000000000..cfcc5d5943
--- /dev/null
+++ b/Task/Catamorphism/Erlang/catamorphism.erl
@@ -0,0 +1,16 @@
+-module(catamorphism).
+
+-export([test/0]).
+
+test() ->
+ Nums = lists:seq(1,10),
+ Summation =
+ lists:foldl(fun(X, Acc) -> X + Acc end, 0, Nums),
+ Product =
+ lists:foldl(fun(X, Acc) -> X * Acc end, 1, Nums),
+ Concatenation =
+ lists:foldr(
+ fun(X, Acc) -> integer_to_list(X) ++ Acc end,
+ "",
+ Nums),
+ {Summation, Product, Concatenation}.
diff --git a/Task/Catamorphism/Julia/catamorphism.julia b/Task/Catamorphism/Julia/catamorphism.julia
new file mode 100644
index 0000000000..4f38c9a752
--- /dev/null
+++ b/Task/Catamorphism/Julia/catamorphism.julia
@@ -0,0 +1 @@
+for op in [+, -, *] println(reduce(op, 1:5)) end
diff --git a/Task/Catmull-Clark-subdivision-surface/OCaml/catmull-clark-subdivision-surface-2.ocaml b/Task/Catmull-Clark-subdivision-surface/OCaml/catmull-clark-subdivision-surface-2.ocaml
index 8aab568789..82075f9e25 100644
--- a/Task/Catmull-Clark-subdivision-surface/OCaml/catmull-clark-subdivision-surface-2.ocaml
+++ b/Task/Catmull-Clark-subdivision-surface/OCaml/catmull-clark-subdivision-surface-2.ocaml
@@ -1,23 +1,21 @@
type point = { x: float; y : float; z : float }
+let zero = { x = 0.0; y = 0.0; z = 0.0 }
let add a b = { x = a.x+.b.x; y = a.y+.b.y; z = a.z+.b.z }
let mul a k = { x = a.x*.k; y = a.y*.k; z= a.z*.k }
let div p k = mul p (1.0/.k)
-let fsgn x y = if x < y then -1 else if x > y then 1 else 0
-let cmp a b = if a.x=b.x then if a.y=b.y then fsgn b.z a.z else fsgn b.y a.y else fsgn b.x a.x
type face = Face of point list
type edge = Edge of point*point
-let ecmp (Edge (p1,p2)) (Edge (p3,p4)) = let sgn = cmp p1 p3 in if sgn = 0 then cmp p2 p4 else sgn
-let make_edge a b = if cmp a b < 0 then Edge (b,a) else Edge (a,b)
+let make_edge a b = Edge (min a b, max a b)
let make_face a b c d = Face [a;b;c;d]
-let centroid plist = div (List.fold_left add {x=0.0;y=0.0;z=0.0} plist) (float (List.length plist))
+let centroid plist = div (List.fold_left add zero plist) (float (List.length plist))
let mid_edge (Edge (p1,p2)) = div (add p1 p2) 2.0
let face_point (Face pl) = centroid pl
let point_in_face p (Face pl) = List.mem p pl
-let point_in_edge p (Edge (p1,p2)) = (p = p1 || p = p2)
-let edge_in_face (Edge (p1,p2)) (Face pl) = (List.mem p1 pl && List.mem p2 pl)
+let point_in_edge p (Edge (p1,p2)) = p = p1 || p = p2
+let edge_in_face (Edge (p1,p2)) f = point_in_face p1 f && point_in_face p2 f
let border_edge faces e =
List.length (List.filter (edge_in_face e) faces) < 2
@@ -32,47 +30,39 @@ let mod_vertex faces edges p =
let v_edges = List.filter (point_in_edge p) edges in
let v_faces = List.filter (point_in_face p) faces in
let n = List.length v_faces in
- let is_border = n != (List.length v_edges) in
+ let is_border = n <> (List.length v_edges) in
if is_border then
let border_mids = List.map mid_edge (List.filter (border_edge faces) v_edges) in
(* description ambiguity: average (border+p) or average(average(border),p) ?? *)
centroid (p :: border_mids)
else
- let avg_face = centroid (List.map face_point v_faces) in
- let avg_mid = centroid (List.map mid_edge v_edges) in
- div (add (add (mul p (float(n-3))) avg_face) (mul avg_mid 2.0)) (float n)
+ let avg_face = centroid (List.map face_point v_faces) in
+ let avg_mid = centroid (List.map mid_edge v_edges) in
+ div (add (add (mul p (float(n-3))) avg_face) (mul avg_mid 2.0)) (float n)
-let iter_edges f (Face pl) =
- let rec next = function
- | [] -> ()
- | a :: [] -> f a (List.hd pl)
- | a :: b :: c -> f a b; next (b::c) in
- next pl;;
+let edges_of_face (Face pl) =
+ let rec next acc = function
+ | [] -> invalid_arg "empty face"
+ | a :: [] -> List.rev (make_edge a (List.hd pl) :: acc)
+ | a :: (b :: _ as xs) -> next (make_edge a b :: acc) xs in
+ next [] pl
let catmull_clark faces =
- let module EdgeSet = Set.Make(struct type t = edge let compare = ecmp end) in
- let eset = ref EdgeSet.empty in
- let add_edge a b = eset := EdgeSet.add (make_edge a b) !eset in
- let edges = (List.iter (iter_edges add_edge) faces; EdgeSet.elements !eset) in
- let new_faces = ref [] in
+ let module EdgeSet = Set.Make(struct type t = edge let compare = compare end) in
+ let edges = EdgeSet.elements (EdgeSet.of_list (List.concat (List.map edges_of_face faces))) in
let mod_face ((Face pl) as face) =
let fp = face_point face in
- let ep = ref [] in (
- iter_edges (fun a b -> ep := (edge_point faces (make_edge a b)):: !ep) face;
- let e_tl = List.hd (List.rev !ep) in
- let v' = List.map (mod_vertex faces edges) pl in
- let rec add_facet e vl el = (match (vl,el) with
- | (h1::t1),(h2::t2) ->
- new_faces := (make_face e h1 h2 fp) :: !new_faces;
- add_facet h2 t1 t2
- | ([],[]) -> ()
- | _ -> failwith "vertex/edge mismatch") in
- add_facet e_tl v' !ep) in
- (List.iter mod_face faces; !new_faces)
+ let ep = List.map (edge_point faces) (edges_of_face face) in
+ let e_tl = List.hd (List.rev ep) in
+ let vl = List.map (mod_vertex faces edges) pl in
+ let add_facet (e', acc) v e = e, (make_face e' v e fp :: acc) in
+ let _, new_faces = List.fold_left2 add_facet (e_tl, []) vl ep in
+ List.rev new_faces in
+ List.concat (List.map mod_face faces)
let show_faces fl =
let pr_point p = Printf.printf " (%.4f, %.4f, %.4f)" p.x p.y p.z in
- let pr_face (Face(pl)) = print_string "Face:"; List.iter pr_point pl; print_string "\n" in
+ let pr_face (Face pl) = print_string "Face:"; List.iter pr_point pl; print_string "\n" in
(print_string "surface {\n"; List.iter pr_face fl; print_string "}\n")
let c p q r = let s i = if i = 0 then -1.0 else 1.0 in { x = s p; y = s q; z = s r } ;;
diff --git a/Task/Character-codes/ALGOL-W/character-codes.alg b/Task/Character-codes/ALGOL-W/character-codes.alg
new file mode 100644
index 0000000000..6103644fe1
--- /dev/null
+++ b/Task/Character-codes/ALGOL-W/character-codes.alg
@@ -0,0 +1,6 @@
+begin
+ % display the character code of "a" (97 in ASCII) %
+ write( decode( "a" ) );
+ % display the character corresponding to 97 ("a" in ASCII) %
+ write( code( 97 ) );
+end.
diff --git a/Task/Character-codes/AppleScript/character-codes.applescript b/Task/Character-codes/AppleScript/character-codes.applescript
new file mode 100644
index 0000000000..9e845ce4dc
--- /dev/null
+++ b/Task/Character-codes/AppleScript/character-codes.applescript
@@ -0,0 +1,2 @@
+log(id of "a")
+log(id of "aA")
diff --git a/Task/Character-codes/Elena/character-codes.elena b/Task/Character-codes/Elena/character-codes.elena
index 32e8bc8032..f804a38d85 100644
--- a/Task/Character-codes/Elena/character-codes.elena
+++ b/Task/Character-codes/Elena/character-codes.elena
@@ -1,7 +1,9 @@
#define system.
-#symbol Program =>
+#symbol program =>
[
- console write:("a" getAt:0 Number).
- console write:(CharValue new &short:97).
+ #var ch := #97.
+
+ console writeLine:ch.
+ console writeLine:(ch int).
].
diff --git a/Task/Character-codes/Elixir/character-codes.elixir b/Task/Character-codes/Elixir/character-codes.elixir
new file mode 100644
index 0000000000..13dbb8e0de
--- /dev/null
+++ b/Task/Character-codes/Elixir/character-codes.elixir
@@ -0,0 +1,4 @@
+iex(1)> code = ?a
+97
+iex(2)> to_string([code])
+"a"
diff --git a/Task/Character-codes/J/character-codes.j b/Task/Character-codes/J/character-codes-1.j
similarity index 100%
rename from Task/Character-codes/J/character-codes.j
rename to Task/Character-codes/J/character-codes-1.j
diff --git a/Task/Character-codes/J/character-codes-2.j b/Task/Character-codes/J/character-codes-2.j
new file mode 100644
index 0000000000..756930ef45
--- /dev/null
+++ b/Task/Character-codes/J/character-codes-2.j
@@ -0,0 +1,2 @@
+ 3 u: 'abc☺'
+97 98 99 226 152 186
diff --git a/Task/Character-codes/J/character-codes-3.j b/Task/Character-codes/J/character-codes-3.j
new file mode 100644
index 0000000000..b1aa6f4b2a
--- /dev/null
+++ b/Task/Character-codes/J/character-codes-3.j
@@ -0,0 +1,4 @@
+ 97 98 99{a.
+abc
+ a.i.'abc'
+97 98 99
diff --git a/Task/Character-codes/JavaScript/character-codes.js b/Task/Character-codes/JavaScript/character-codes-1.js
similarity index 100%
rename from Task/Character-codes/JavaScript/character-codes.js
rename to Task/Character-codes/JavaScript/character-codes-1.js
diff --git a/Task/Character-codes/JavaScript/character-codes-2.js b/Task/Character-codes/JavaScript/character-codes-2.js
new file mode 100644
index 0000000000..dd890e0cb0
--- /dev/null
+++ b/Task/Character-codes/JavaScript/character-codes-2.js
@@ -0,0 +1 @@
+['字'.codePointAt(0), '🐘'.codePointAt(0)]
diff --git a/Task/Character-codes/JavaScript/character-codes-3.js b/Task/Character-codes/JavaScript/character-codes-3.js
new file mode 100644
index 0000000000..cf63dec7d8
--- /dev/null
+++ b/Task/Character-codes/JavaScript/character-codes-3.js
@@ -0,0 +1 @@
+[23383, 128024]
diff --git a/Task/Character-codes/JavaScript/character-codes-4.js b/Task/Character-codes/JavaScript/character-codes-4.js
new file mode 100644
index 0000000000..cc5e41fa1d
--- /dev/null
+++ b/Task/Character-codes/JavaScript/character-codes-4.js
@@ -0,0 +1,3 @@
+[23383, 128024].map(function (x) {
+ return String.fromCodePoint(x);
+})
diff --git a/Task/Character-codes/JavaScript/character-codes-5.js b/Task/Character-codes/JavaScript/character-codes-5.js
new file mode 100644
index 0000000000..c5af4a2e8c
--- /dev/null
+++ b/Task/Character-codes/JavaScript/character-codes-5.js
@@ -0,0 +1 @@
+["字", "🐘"]
diff --git a/Task/Character-codes/REXX/character-codes.rexx b/Task/Character-codes/REXX/character-codes-1.rexx
similarity index 100%
rename from Task/Character-codes/REXX/character-codes.rexx
rename to Task/Character-codes/REXX/character-codes-1.rexx
diff --git a/Task/Character-codes/REXX/character-codes-2.rexx b/Task/Character-codes/REXX/character-codes-2.rexx
new file mode 100644
index 0000000000..28ee1d261a
--- /dev/null
+++ b/Task/Character-codes/REXX/character-codes-2.rexx
@@ -0,0 +1,14 @@
+/* REXX */
+yyy='c' /*assign a lowercase c to YYY */
+yyy='83'x /*assign hexadecimal 83 to YYY */
+ /*the X can be upper/lowercase.*/
+yyy=x2c(83) /* (same as above) */
+yyy='10000011'b /* (same as above) */
+yyy='1000 0011'b /* (same as above) */
+ /*the B can be upper/lowercase.*/
+yyy=d2c(129) /*assign decimal code 129 to YYY */
+
+say yyy /*displays the value of YYY */
+say c2x(yyy) /*displays the value of YYY in hexadecimal. */
+say c2d(yyy) /*displays the value of YYY in decimal. */
+say x2b(c2x(yyy))/*displays the value of YYY in binary (bit string). */
diff --git a/Task/Character-codes/RapidQ/character-codes.rapidq b/Task/Character-codes/RapidQ/character-codes.rapidq
new file mode 100644
index 0000000000..c3f943f23d
--- /dev/null
+++ b/Task/Character-codes/RapidQ/character-codes.rapidq
@@ -0,0 +1,2 @@
+Print Chr$(97)
+Print Asc("a")
diff --git a/Task/Character-codes/Rust/character-codes.rust b/Task/Character-codes/Rust/character-codes.rust
new file mode 100644
index 0000000000..f2bd461871
--- /dev/null
+++ b/Task/Character-codes/Rust/character-codes.rust
@@ -0,0 +1,11 @@
+use std::char::from_u32;
+
+fn main() {
+ //ascii char
+ println!("{}", 'a' as u8);
+ println!("{}", 97 as char);
+
+ //unicode char
+ println!("{}", 'π' as u32);
+ println!("{}", from_u32(960).unwrap();
+}
diff --git a/Task/Character-codes/VBScript/character-codes.vb b/Task/Character-codes/VBScript/character-codes.vb
new file mode 100644
index 0000000000..4be511c69b
--- /dev/null
+++ b/Task/Character-codes/VBScript/character-codes.vb
@@ -0,0 +1,5 @@
+'prints a
+WScript.StdOut.WriteLine Chr(97)
+
+'prints 97
+WScript.StdOut.WriteLine Asc("a")
diff --git a/Task/Check-Machin-like-formulas/00DESCRIPTION b/Task/Check-Machin-like-formulas/00DESCRIPTION
index 97dece1003..92f70a8543 100644
--- a/Task/Check-Machin-like-formulas/00DESCRIPTION
+++ b/Task/Check-Machin-like-formulas/00DESCRIPTION
@@ -24,7 +24,11 @@ and confirm that the following formula is incorrect by showing '''tan'''(''right
These identities are useful in calculating the values:
:
-:
+
+:
+
:
You can store the equations in any convenient data structure, but for extra credit parse them from human-readable [[Check_Machin-like_formulas/text_equations|text input]].
+
+Note that to formally prove the formula correct you would also have to show that '' < right hand side < '' due to '''' periodicity.
diff --git a/Task/Check-Machin-like-formulas/Perl/check-machin-like-formulas.pl b/Task/Check-Machin-like-formulas/Perl/check-machin-like-formulas.pl
new file mode 100644
index 0000000000..edda40eef3
--- /dev/null
+++ b/Task/Check-Machin-like-formulas/Perl/check-machin-like-formulas.pl
@@ -0,0 +1,40 @@
+use Math::BigRat try=>"GMP";
+
+sub taneval {
+ my($coef,$f) = @_;
+ $f = Math::BigRat->new($f) unless ref($f);
+ return 0 if $coef == 0;
+ return $f if $coef == 1;
+ return -taneval(-$coef, $f) if $coef < 0;
+ my($a,$b) = ( taneval($coef>>1, $f), taneval($coef-($coef>>1),$f) );
+ ($a+$b)/(1-$a*$b);
+}
+
+sub tans {
+ my @xs=@_;
+ return taneval(@{$xs[0]}) if scalar(@xs)==1;
+ my($a,$b) = ( tans(@xs[0..($#xs>>1)]), tans(@xs[($#xs>>1)+1..$#xs]) );
+ ($a+$b)/(1-$a*$b);
+}
+
+sub test {
+ printf "%5s (%s)\n", (tans(@_)==1)?"OK":"Error", join(" ",map{"[@$_]"} @_);
+}
+
+test([1,'1/2'], [1,'1/3']);
+test([2,'1/3'], [1,'1/7']);
+test([4,'1/5'], [-1,'1/239']);
+test([5,'1/7'],[2,'3/79']);
+test([5,'29/278'],[7,'3/79']);
+test([1,'1/2'],[1,'1/5'],[1,'1/8']);
+test([4,'1/5'],[-1,'1/70'],[1,'1/99']);
+test([5,'1/7'],[4,'1/53'],[2,'1/4443']);
+test([6,'1/8'],[2,'1/57'],[1,'1/239']);
+test([8,'1/10'],[-1,'1/239'],[-4,'1/515']);
+test([12,'1/18'],[8,'1/57'],[-5,'1/239']);
+test([16,'1/21'],[3,'1/239'],[4,'3/1042']);
+test([22,'1/28'],[2,'1/443'],[-5,'1/1393'],[-10,'1/11018']);
+test([22,'1/38'],[17,'7/601'],[10,'7/8149']);
+test([44,'1/57'],[7,'1/239'],[-12,'1/682'],[24,'1/12943']);
+test([88,'1/172'],[51,'1/239'],[32,'1/682'],[44,'1/5357'],[68,'1/12943']);
+test([88,'1/172'],[51,'1/239'],[32,'1/682'],[44,'1/5357'],[68,'1/12944']);
diff --git a/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx b/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx
index f025634e0b..5549a7b279 100644
--- a/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx
+++ b/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx
@@ -1,6 +1,6 @@
-/*REXX program evaluates some expressions and verifies their veracity.*/
-parse arg digs .; if digs=='' then digs=100 /*use default for digs?*/
-numeric digits digs+10; numeric fuzz 3; pi=pi(); @.=
+/*REXX program evaluates some Machin-like formulas and verifies their veracity*/
+parse arg digs .; if digs=='' then digs=100 /*use default for decimal digs?*/
+numeric digits digs+10; numeric fuzz 3; pi=pi(); @.=
@.1 = 'pi/4 = atan(1/2) + atan(1/3)'
@.2 = 'pi/4 = 2*atan(1/3) + atan(1/7)'
@.3 = 'pi/4 = 4*atan(1/5) - atan(1/239)'
@@ -19,32 +19,34 @@ numeric digits digs+10; numeric fuzz 3; pi=pi(); @.=
@.16 = 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12943)'
@.17 = 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12944)'
- do j=1 while @.j\=='' /*evaluate each of the formulas. */
- interpret 'answer=' "(" @.j ")" /*the heavy lifting.*/
+ do j=1 while @.j\=='' /*evaluate each "Machin-like" formulas.*/
+ interpret 'answer=' "(" @.j ")" /*this is the heavy lifting.*/
say right(word('bad OK',answer+1),3)": " space(@.j,0)
- end /*j*/ /* [↑] show OK | bad, formula. */
-exit /*stick a fork in it, we're done.*/
-/*──────────────────────────────────subroutines─────────────────────────*/
-Acos: procedure; parse arg x; if x<-1 | x>1 then call AcosErr
- return .5*pi()-Asin(x)
-
-Asin: procedure; parse arg x; if x<-1 | x>1 then call AsinErr; s=x*x
-if abs(x)>=sqrt(2)*.5 then return sign(x)*Acos(sqrt(1-s)); z=x; o=x; p=z
- do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end
-return z
-
-Atan: procedure; parse arg x; if abs(x)=1 then return pi()/4*sign(x)
- return Asin(x/sqrt(1+x**2))
-sqrt: procedure; parse arg x; if x=0 then return 0; m.=9; p=digits(); i=
-numeric digits 9; if x<0 then do; x=-x; i='i'; end; numeric form; m.0=p
-parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'E'_%2; m.1=p
- do j=2 while p>9; m.j=p; p=p%2+1; end /*j*/
- do k=j+5 to 0 by -1; numeric digits m.k; g=.5*(g+x/g); end /*k*/
- numeric digits m.0; return (g/1)i
-pi: return,
-3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651
-
+ end /*j*/ /* [↑] show OK or bad, and the formula*/
+exit /*stick a fork in it, we're all done. */
+/*────broutines───────────────────────────────────────────────────────────────*/
+pi: return 3.14159265358979323846264338327950288419716939937510582097494459 ||,
+ 230781640628620899862803482534211706798214808651
AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X='||x
AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X='||x
tanErr: call tellErr 'tan(' || x") causes division by zero, X=" || x
tellErr: say; say '*** error! ***'; say; say arg(1); say; exit 13
+
+Acos: procedure; parse arg x; if x<-1 | x>1 then call AcosErr
+ return .5*pi()-Asin(x)
+
+Asin: procedure expose $.; parse arg x 1 z 1 o 1 p; a=abs(x); aa=a*a
+ if a>1 then call AsinErr x /*X argument is out of valid range. */
+ if a>=sqrt(2)*.5 then return sign(x)*acos(sqrt(1-aa), '-ASIN')
+ do j=2 by 2 until p=z; p=z; o=o*aa*(j-1)/j; z=z+o/(j+1); end
+ return z /* [↑] compute until no more noise. */
+
+Atan: procedure; parse arg x; if abs(x)=1 then return pi()/4*sign(x)
+ return Asin(x/sqrt(1+x**2))
+
+sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
+ numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
+ 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)i /*make complex if X < 0.*/
diff --git a/Task/Check-that-file-exists/00DESCRIPTION b/Task/Check-that-file-exists/00DESCRIPTION
index 76ae248e94..432587f942 100644
--- a/Task/Check-that-file-exists/00DESCRIPTION
+++ b/Task/Check-that-file-exists/00DESCRIPTION
@@ -1,2 +1,4 @@
In this task, the job is to verify that a file called "input.txt" and the directory called "docs" exist.
This should be done twice: once for the current working directory and once for a file and a directory in the filesystem root.
+
+Optional criteria (May 2015): verify it works with 0-length files; and with an unusual filename: `Abdu'l-Bahá.txt
diff --git a/Task/Check-that-file-exists/AWK/check-that-file-exists-1.awk b/Task/Check-that-file-exists/AWK/check-that-file-exists-1.awk
new file mode 100644
index 0000000000..0ec9009f5f
--- /dev/null
+++ b/Task/Check-that-file-exists/AWK/check-that-file-exists-1.awk
@@ -0,0 +1,14 @@
+@load "filefuncs"
+BEGIN {
+ exists("input.txt")
+ exists("/input.txt")
+ exists("docs")
+ exists("/docs")
+}
+
+function exists(name ,fd) {
+ if ( stat(name, fd) == -1)
+ print name " doesn't exist"
+ else
+ print name " exists"
+}
diff --git a/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk b/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk
new file mode 100644
index 0000000000..063ec96802
--- /dev/null
+++ b/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk
@@ -0,0 +1,26 @@
+BEGIN {
+ exists("input.txt")
+ exists("\\input.txt")
+ exists("docs")
+ exists("\\docs")
+ exit(0)
+}
+
+#
+# Check if file or directory exists, even 0-length file.
+# Return 0 if not exist, 1 if exist
+#
+function exists(file ,line, msg)
+{
+ if ( (getline line < file) == -1 )
+ {
+ # "Permission denied" is for MS-Windows
+ msg = (ERRNO ~ /Permission denied/ || ERRNO ~ /a directory/) ? "1" : "0"
+ close(file)
+ return msg
+ }
+ else {
+ close(file)
+ return 1
+ }
+}
diff --git a/Task/Check-that-file-exists/AWK/check-that-file-exists-3.awk b/Task/Check-that-file-exists/AWK/check-that-file-exists-3.awk
new file mode 100644
index 0000000000..72840e0f00
--- /dev/null
+++ b/Task/Check-that-file-exists/AWK/check-that-file-exists-3.awk
@@ -0,0 +1 @@
+gawk 'BEGINFILE{if (ERRNO) {print "Not exist."; exit} } {print "Exist."; exit}' input.txt
diff --git a/Task/Check-that-file-exists/AWK/check-that-file-exists.awk b/Task/Check-that-file-exists/AWK/check-that-file-exists.awk
deleted file mode 100644
index 658db43956..0000000000
--- a/Task/Check-that-file-exists/AWK/check-that-file-exists.awk
+++ /dev/null
@@ -1,18 +0,0 @@
-# syntax: GAWK -f CHECK_THAT_FILE_EXISTS.AWK
-BEGIN {
- check_exists("input.txt")
- check_exists("\\input.txt")
- check_exists("docs")
- check_exists("\\docs")
- exit(0)
-}
-function check_exists(name, fnr,msg,rec) {
- while (getline rec 0) {
- fnr++
- break
- }
- # "Permission denied" is for MS-Windows
- msg = (ERRNO == 0 || ERRNO ~ /Permission denied/ || fnr > 0) ? "exists" : "does not exist"
- printf("%s - %s\n",name,msg)
- close(name)
-}
diff --git a/Task/Check-that-file-exists/DCL/check-that-file-exists.dcl b/Task/Check-that-file-exists/DCL/check-that-file-exists.dcl
new file mode 100644
index 0000000000..102767c22c
--- /dev/null
+++ b/Task/Check-that-file-exists/DCL/check-that-file-exists.dcl
@@ -0,0 +1,24 @@
+$ if f$search( "input.txt" ) .eqs. ""
+$ then
+$ write sys$output "input.txt not found"
+$ else
+$ write sys$output "input.txt found"
+$ endif
+$ if f$search( "docs.dir" ) .eqs. ""
+$ then
+$ write sys$output "directory docs not found"
+$ else
+$ write sys$output "directory docs found"
+$ endif
+$ if f$search( "[000000]input.txt" ) .eqs. ""
+$ then
+$ write sys$output "[000000]input.txt not found"
+$ else
+$ write sys$output "[000000]input.txt found"
+$ endif
+$ if f$search( "[000000]docs.dir" ) .eqs. ""
+$ then
+$ write sys$output "directory [000000]docs not found"
+$ else
+$ write sys$output "directory [000000]docs found"
+$ endif
diff --git a/Task/Check-that-file-exists/Elixir/check-that-file-exists.elixir b/Task/Check-that-file-exists/Elixir/check-that-file-exists.elixir
new file mode 100644
index 0000000000..42374806eb
--- /dev/null
+++ b/Task/Check-that-file-exists/Elixir/check-that-file-exists.elixir
@@ -0,0 +1,4 @@
+File.regular?("input.txt")
+File.dir?("docs")
+File.regular?("/input.txt")
+File.dir?("/docs")
diff --git a/Task/Check-that-file-exists/REXX/check-that-file-exists.rexx b/Task/Check-that-file-exists/REXX/check-that-file-exists-1.rexx
similarity index 100%
rename from Task/Check-that-file-exists/REXX/check-that-file-exists.rexx
rename to Task/Check-that-file-exists/REXX/check-that-file-exists-1.rexx
diff --git a/Task/Check-that-file-exists/REXX/check-that-file-exists-2.rexx b/Task/Check-that-file-exists/REXX/check-that-file-exists-2.rexx
new file mode 100644
index 0000000000..0f20078832
--- /dev/null
+++ b/Task/Check-that-file-exists/REXX/check-that-file-exists-2.rexx
@@ -0,0 +1,8 @@
+/* Check if a file already exists */
+filename='file.txt'
+IF ~Openfile(filename) THEN CALL Openfile(':'filename)
+EXIT 0
+Openfile:
+IF ~Exists(filename) THEN RETURN 0
+CALL Open(filehandle,filename,'APPEND')
+RETURN 1
diff --git a/Task/Checkpoint-synchronization/C++/checkpoint-synchronization.cpp b/Task/Checkpoint-synchronization/C++/checkpoint-synchronization.cpp
new file mode 100644
index 0000000000..fa617cee12
--- /dev/null
+++ b/Task/Checkpoint-synchronization/C++/checkpoint-synchronization.cpp
@@ -0,0 +1,51 @@
+#include
+#include
+#include
+#include
+#include
+#include
+
+std::mutex cout_lock;
+
+class Latch
+{
+ std::atomic semafor;
+ public:
+ Latch(int limit) : semafor(limit) {}
+
+ void wait()
+ {
+ semafor.fetch_sub(1);
+ while(semafor.load() > 0)
+ std::this_thread::yield();
+ }
+};
+
+struct Worker
+{
+ static void do_work(int how_long, Latch& barrier, std::string name)
+ {
+ std::this_thread::sleep_for(std::chrono::milliseconds(how_long));
+ { std::lock_guard lock(cout_lock);
+ std::cout << "Worker " << name << " finished work\n"; }
+ barrier.wait();
+ { std::lock_guard lock(cout_lock);
+ std::cout << "Worker " << name << " finished assembly\n"; }
+ }
+};
+
+int main()
+{
+ Latch latch(5);
+ std::mt19937 rng(std::random_device{}());
+ std::uniform_int_distribution<> dist(300, 3000);
+ std::thread threads[] {
+ std::thread(&Worker::do_work, dist(rng), std::ref(latch), "John"),
+ std::thread{&Worker::do_work, dist(rng), std::ref(latch), "Henry"},
+ std::thread{&Worker::do_work, dist(rng), std::ref(latch), "Smith"},
+ std::thread{&Worker::do_work, dist(rng), std::ref(latch), "Jane"},
+ std::thread{&Worker::do_work, dist(rng), std::ref(latch), "Mary"},
+ };
+ for(auto& t: threads) t.join();
+ std::cout << "Assembly is finished";
+}
diff --git a/Task/Chinese-remainder-theorem/360-Assembly/chinese-remainder-theorem.360 b/Task/Chinese-remainder-theorem/360-Assembly/chinese-remainder-theorem.360
new file mode 100644
index 0000000000..0a023cf228
--- /dev/null
+++ b/Task/Chinese-remainder-theorem/360-Assembly/chinese-remainder-theorem.360
@@ -0,0 +1,44 @@
+* Chinese remainder theorem 06/09/2015
+CHINESE CSECT
+ USING CHINESE,R12 base addr
+ LR R12,R15
+BEGIN LA R9,1 m=1
+ LA R6,1 j=1
+LOOPJ C R6,NN do j=1 to nn
+ BH ELOOPJ
+ LR R1,R6 j
+ SLA R1,2 j*4
+ M R8,N-4(R1) m=m*n(j)
+ LA R6,1(R6) j=j+1
+ B LOOPJ
+ELOOPJ LA R6,1 x=1
+LOOPX CR R6,R9 do x=1 to m
+ BH ELOOPX
+ LA R7,1 i=1
+LOOPI C R7,NN do i=1 to nn
+ BH ELOOPI
+ LR R1,R7 i
+ SLA R1,2 i*4
+ LR R5,R6 x
+ LA R4,0
+ D R4,N-4(R1) x//n(i)
+ C R4,A-4(R1) if x//n(i)^=a(i)
+ BNE ITERX then iterate x
+ LA R7,1(R7) i=i+1
+ B LOOPI
+ELOOPI MVC PG(2),=C'x='
+ XDECO R6,PG+2 edit x
+ XPRNT PG,14 print buffer
+ B RETURN
+ITERX LA R6,1(R6) x=x+1
+ B LOOPX
+ELOOPX XPRNT NOSOL,17 print
+RETURN XR R15,R15 rc=0
+ BR R14
+NN DC F'3'
+N DC F'3',F'5',F'7'
+A DC F'2',F'3',F'2'
+PG DS CL80
+NOSOL DC CL17'no solution found'
+ YREGS
+ END CHINESE
diff --git a/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir b/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir
new file mode 100644
index 0000000000..f6c0c60193
--- /dev/null
+++ b/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir
@@ -0,0 +1,13 @@
+defmodule Chinese do
+ def remainder(mods, remainders) do
+ max = Enum.reduce(mods, fn x,acc -> x*acc end)
+ Enum.zip(mods, remainders)
+ |> Enum.map(fn {m,r} -> Enum.take_every(r..max, m) |> Enum.into(HashSet.new) end)
+ |> Enum.reduce(fn set,acc -> Set.intersection(set, acc) end)
+ |> Set.to_list
+ end
+end
+
+IO.inspect Chinese.remainder([3,5,7], [2,3,2])
+IO.inspect Chinese.remainder([10,4,9], [11,22,19])
+IO.inspect Chinese.remainder([11,12,13], [10,4,12])
diff --git a/Task/Chinese-remainder-theorem/Python/chinese-remainder-theorem.py b/Task/Chinese-remainder-theorem/Python/chinese-remainder-theorem.py
index 4e74febffc..2af8992414 100644
--- a/Task/Chinese-remainder-theorem/Python/chinese-remainder-theorem.py
+++ b/Task/Chinese-remainder-theorem/Python/chinese-remainder-theorem.py
@@ -1,3 +1,14 @@
+# Python 2.7
+def chinese_remainder(n, a):
+ sum = 0
+ prod = reduce(lambda a, b: a*b, n)
+
+ for n_i, a_i in zip(n, a):
+ p = prod / n_i
+ sum += a_i * mul_inv(p, n_i) * p
+ return sum % prod
+
+
def mul_inv(a, b):
b0 = b
x0, x1 = 0, 1
@@ -9,15 +20,7 @@ def mul_inv(a, b):
if x1 < 0: x1 += b0
return x1
-def chinese_remainder(n, a, lena):
- p = i = prod = 1; sm = 0
- for i in range(lena): prod *= n[i]
- for i in range(lena):
- p = prod / n[i]
- sm += a[i] * mul_inv(p, n[i]) * p
- return sm % prod
-
if __name__ == '__main__':
n = [3, 5, 7]
a = [2, 3, 2]
- print(chinese_remainder(n, a, len(n)))
+ print chinese_remainder(n, a)
diff --git a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx
index fa5231dd71..888e6be2c4 100644
--- a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx
+++ b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx
@@ -1,24 +1,26 @@
-/*REXX program uses the Chinese Remainder Theorem (Sun Tzu). */
-parse arg Ns As . /*get optional arguments from CL.*/
-if Ns=='' then Ns = '3,5,7' /*Ns not specified? Use default.*/
-if As=='' then As = '2,3,2' /*As " " " " */
-Ns=space(translate(Ns,,',')); #=words(Ns) /*elide superfluous blanks*/
-As=space(translate(As,,',')); _=words(As) /* " " " */
-if #\==_ then do; say "size of number sets don't match."; exit 131; end
-if #==0 then do; say "size of the N set isn't valid."; exit 132; end
-if _==0 then do; say "size of the A set isn't valid."; exit 133; end
-N=1 /*the product─to─be for prod(n.j)*/
- do j=1 for # /*process each number for As, Ns.*/
- n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate prod*/
- a.j=word(As,j) /* " " A.j from the As. */
+/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem.*/
+parse arg Ns As . /*get optional arguments from the C.L. */
+if Ns=='' then Ns = '3,5,7' /*Ns not specified? Then use default.*/
+if As=='' then As = '2,3,2' /*As " " " " " */
+ say 'Ns: ' Ns
+ say 'As: ' As; say
+Ns=space(translate(Ns,,',')); #=words(Ns) /*elide any superfluous blanks.*/
+As=space(translate(As,,',')); _=words(As) /* " " " " */
+if #\==_ then do; say "size of number sets don't match."; exit 131; end
+if #==0 then do; say "size of the N set isn't valid."; exit 132; end
+if _==0 then do; say "size of the A set isn't valid."; exit 133; end
+N=1 /*the product─to─be for prod(n.j). */
+ do j=1 for # /*process each number for As and Ns. */
+ n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */
+ a.j=word(As,j) /* " " A.j from the As list. */
end /*j*/
- do x=1 for N /*use a simple algebraic method. */
- do i=1 for # /*process each A.i number. */
- if x//n.i\==a.i then iterate x /*is the modulus correct for F ? */
- end /*i*/ /* [↑] limit solution to product*/
- say 'found a solution with x=' x /*announce a possible solution. */
- exit /*stick a fork in it, we're done.*/
- end /*x*/
- /*stick a fork in it, we're done.*/
-say 'no solution found.' /*oops, announce that ¬ found. */
+ do x=1 for N /*use a simple algebraic method. */
+ do i=1 for # /*process each N.i and A.i number.*/
+ if x//n.i\==a.i then iterate x /*is modulus correct for the number X ?*/
+ end /*i*/ /* [↑] limit solution to the product. */
+ say 'found a solution with X=' x /*display one possible solution. */
+ exit /*stick a fork in it, we're all done. */
+ end /*x*/
+
+say 'no solution found.' /*oops, announce that solution ¬ found.*/
diff --git a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx
index 6be90a012f..b90b5973f2 100644
--- a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx
+++ b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx
@@ -1,26 +1,28 @@
-/*REXX program uses the Chinese Remainder Theorem (Sun Tzu). */
-parse arg Ns As . /*get optional arguments from CL.*/
-if Ns=='' then Ns = '3,5,7' /*Ns not specified? Use default.*/
-if As=='' then As = '2,3,2' /*As " " " " */
-Ns=space(translate(Ns,,',')); #=words(Ns) /*elide superfluous blanks*/
-As=space(translate(As,,',')); _=words(As) /* " " " */
-if #\==_ then do; say "size of number sets don't match."; exit 131; end
-if #==0 then do; say "size of the N set isn't valid."; exit 132; end
-if _==0 then do; say "size of the A set isn't valid."; exit 133; end
-N=1 /*the product─to─be for prod(n.j)*/
- do j=1 for # /*process each number for As, Ns.*/
- n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate prod*/
- a.j=word(As,j) /* " " A.j from the As. */
+/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem.*/
+parse arg Ns As . /*get optional arguments from the C.L. */
+if Ns=='' then Ns = '3,5,7' /*Ns not specified? Then use default.*/
+if As=='' then As = '2,3,2' /*As " " " " " */
+ say 'Ns: ' Ns
+ say 'As: ' As; say
+Ns=space(translate(Ns,,',')); #=words(Ns) /*elide any superfluous blanks.*/
+As=space(translate(As,,',')); _=words(As) /* " " " " */
+if #\==_ then do; say "size of number sets don't match."; exit 131; end
+if #==0 then do; say "size of the N set isn't valid."; exit 132; end
+if _==0 then do; say "size of the A set isn't valid."; exit 133; end
+N=1 /*the product─to─be for prod(n.j). */
+ do j=1 for # /*process each number for As and Ns. */
+ n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */
+ a.j=word(As,j) /* " " A.j from the As list. */
end /*j*/
-@.= /* [↓] converts congruences─►sets*/
- do i=1 for #; _=a.i; @.i._=a.i; p=a.i
- do N; p=p+n.i; @.i.p=p; end /*build a list of modulo values. */
- end /*i*/
- /* [↓] find common number in sets*/
- do x=1 for N; if @.1.x=='' then iterate /*find a number.*/
- do v=2 to #; if @.v.x=='' then iterate x; end /*In all sets ? */
- say 'found a solution with X=' x /*we found the lowest solution. */
- exit /*stick a fork in it, we're done.*/
+@.= /* [↓] converts congruences ───► sets.*/
+ do i=1 for #; _=a.i; @.i._=a.i; p=a.i
+ do N; p=p+n.i; @.i.p=p; end /*build a (array) list of modulo values*/
+ end /*i*/
+ /* [↓] find common number in the sets.*/
+ do x=1 for N; if @.1.x=='' then iterate /*locate a number. */
+ do v=2 to #; if @.v.x=='' then iterate x; end /*Is in all sets ? */
+ say 'found a solution with X=' x /*display one possible solution. */
+ exit /*stick a fork in it, we're all done. */
end /*x*/
- /*stick a fork in it, we're done.*/
-say 'no solution found.' /*oops, there's not a solution. */
+
+say 'no solution found.' /*oops, announce that solution ¬ found.*/
diff --git a/Task/Cholesky-decomposition/00DESCRIPTION b/Task/Cholesky-decomposition/00DESCRIPTION
index 6648b11250..0d67891916 100644
--- a/Task/Cholesky-decomposition/00DESCRIPTION
+++ b/Task/Cholesky-decomposition/00DESCRIPTION
@@ -71,3 +71,8 @@ Example 2:
54 86 174 134 12.72792 3.04604 1.64974 0.00000
42 62 134 106 9.89949 1.62455 1.84971 1.39262
+
+
+;Note:
+# The Cholesky decomposition of a [[Pascal matrix generation|Pascal]] upper-triangle matrix is the [[wp:Identity matrix|Identity matrix]] of the same size.
+# The Cholesky decomposition of a Pascal symmetric matrix is the Pascal lower-triangle matrix of the same size.
diff --git a/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-1.clj b/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-1.clj
new file mode 100644
index 0000000000..bf2a2df42a
--- /dev/null
+++ b/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-1.clj
@@ -0,0 +1,11 @@
+(defn cholesky
+ [matrix]
+ (let [n (count matrix)
+ A (to-array-2d matrix)
+ L (make-array Double/TYPE n n)]
+ (doseq [i (range n) j (range (inc i))]
+ (let [s (reduce + (for [k (range j)] (* (aget L i k) (aget L j k))))]
+ (aset L i j (if (= i j)
+ (Math/sqrt (- (aget A i i) s))
+ (* (/ 1.0 (aget L j j)) (- (aget A i j) s))))))
+ (vec (map vec L))))
diff --git a/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-2.clj b/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-2.clj
new file mode 100644
index 0000000000..0bcafec95c
--- /dev/null
+++ b/Task/Cholesky-decomposition/Clojure/cholesky-decomposition-2.clj
@@ -0,0 +1,10 @@
+(cholesky [[25 15 -5] [15 18 0] [-5 0 11]])
+;=> [[ 5.0 0.0 0.0]
+; [ 3.0 3.0 0.0]
+; [-1.0 1.0 3.0]]
+
+(cholesky [[18 22 54 42] [22 70 86 62] [54 86 174 134] [42 62 134 106]])
+;=> [[ 4.242640687119285 0.0 0.0 0.0 ]
+; [ 5.185449728701349 6.565905201197403 0.0 0.0 ]
+; [12.727922061357857 3.0460384954008553 1.6497422479090704 0.0 ]
+; [ 9.899494936611667 1.624553864213788 1.8497110052313648 1.3926212476456026]]
diff --git a/Task/Cholesky-decomposition/Go/cholesky-decomposition-2.go b/Task/Cholesky-decomposition/Go/cholesky-decomposition-2.go
index d7fa2ffab5..77a106ff3a 100644
--- a/Task/Cholesky-decomposition/Go/cholesky-decomposition-2.go
+++ b/Task/Cholesky-decomposition/Go/cholesky-decomposition-2.go
@@ -6,23 +6,12 @@ import (
)
type matrix struct {
- ele []complex128
stride int
-}
-
-func matrixFromRows(rows [][]complex128) *matrix {
- if len(rows) == 0 {
- return &matrix{nil, 0}
- }
- m := &matrix{make([]complex128, len(rows)*len(rows[0])), len(rows[0])}
- for rx, row := range rows {
- copy(m.ele[rx*m.stride:(rx+1)*m.stride], row)
- }
- return m
+ ele []complex128
}
func like(a *matrix) *matrix {
- return &matrix{make([]complex128, len(a.ele)), a.stride}
+ return &matrix{a.stride, make([]complex128, len(a.ele))}
}
func (m *matrix) print(heading string) {
@@ -62,17 +51,22 @@ func (a *matrix) choleskyDecomp() *matrix {
}
func main() {
- demo("A:", matrixFromRows([][]complex128{
- {25, 15, -5},
- {15, 18, 0},
- {-5, 0, 11},
- }))
- demo("A:", matrixFromRows([][]complex128{
- {18, 22, 54, 42},
- {22, 70, 86, 62},
- {54, 86, 174, 134},
- {42, 62, 134, 106},
- }))
+ demo("A:", &matrix{3, []complex128{
+ 25, 15, -5,
+ 15, 18, 0,
+ -5, 0, 11,
+ }})
+ demo("A:", &matrix{4, []complex128{
+ 18, 22, 54, 42,
+ 22, 70, 86, 62,
+ 54, 86, 174, 134,
+ 42, 62, 134, 106,
+ }})
+ // one more example, from the Numpy manual, with a non-real
+ demo("A:", &matrix{2, []complex128{
+ 1, -2i,
+ 2i, 5,
+ }})
}
func demo(heading string, a *matrix) {
diff --git a/Task/Cholesky-decomposition/Go/cholesky-decomposition-3.go b/Task/Cholesky-decomposition/Go/cholesky-decomposition-3.go
index 82c5332909..7f20fd8514 100644
--- a/Task/Cholesky-decomposition/Go/cholesky-decomposition-3.go
+++ b/Task/Cholesky-decomposition/Go/cholesky-decomposition-3.go
@@ -3,31 +3,25 @@ package main
import (
"fmt"
- mat "github.com/skelterjohn/go.matrix"
+ "github.com/gonum/matrix/mat64"
)
+func cholesky(order int, elements []float64) fmt.Formatter {
+ t := mat64.NewTriDense(order, false, nil)
+ t.Cholesky(mat64.NewSymDense(order, elements), false)
+ return mat64.Formatted(t)
+}
+
func main() {
- demo(mat.MakeDenseMatrix([]float64{
+ fmt.Println(cholesky(3, []float64{
25, 15, -5,
15, 18, 0,
-5, 0, 11,
- }, 3, 3))
- demo(mat.MakeDenseMatrix([]float64{
+ }))
+ fmt.Printf("\n%.5f\n", cholesky(4, []float64{
18, 22, 54, 42,
22, 70, 86, 62,
54, 86, 174, 134,
42, 62, 134, 106,
- }, 4, 4))
-}
-
-func demo(m *mat.DenseMatrix) {
- fmt.Println("A:")
- fmt.Println(m)
- l, err := m.Cholesky()
- if err != nil {
- fmt.Println(err)
- return
- }
- fmt.Println("L:")
- fmt.Println(l)
+ }))
}
diff --git a/Task/Cholesky-decomposition/Go/cholesky-decomposition-4.go b/Task/Cholesky-decomposition/Go/cholesky-decomposition-4.go
new file mode 100644
index 0000000000..82c5332909
--- /dev/null
+++ b/Task/Cholesky-decomposition/Go/cholesky-decomposition-4.go
@@ -0,0 +1,33 @@
+package main
+
+import (
+ "fmt"
+
+ mat "github.com/skelterjohn/go.matrix"
+)
+
+func main() {
+ demo(mat.MakeDenseMatrix([]float64{
+ 25, 15, -5,
+ 15, 18, 0,
+ -5, 0, 11,
+ }, 3, 3))
+ demo(mat.MakeDenseMatrix([]float64{
+ 18, 22, 54, 42,
+ 22, 70, 86, 62,
+ 54, 86, 174, 134,
+ 42, 62, 134, 106,
+ }, 4, 4))
+}
+
+func demo(m *mat.DenseMatrix) {
+ fmt.Println("A:")
+ fmt.Println(m)
+ l, err := m.Cholesky()
+ if err != nil {
+ fmt.Println(err)
+ return
+ }
+ fmt.Println("L:")
+ fmt.Println(l)
+}
diff --git a/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs b/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs
index fdf02c7050..9dd8dee396 100644
--- a/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs
+++ b/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs
@@ -1,6 +1,23 @@
import Data.Array.IArray
+import Data.List
import Cholesky
+takeDrop 0 xs = ([],xs)
+takeDrop _ [] = ([],[])
+takeDrop n (x:xs) = (x:a,b) where (a,b) = takeDrop (n-1) xs
+
+fm _ [] = ""
+fm _ [x] = fst x
+fm width ((a,b):xs) = a ++ (take (width - b) $ cycle " ") ++ (fm width xs)
+
+fmt width row (xs,[]) = fm width xs
+fmt width row (xs,ys) = fm width xs ++ "\n" ++ fmt width row (takeDrop row ys)
+
+showMatrice row xs = ys where
+ vs = map (\s -> let sh = show s in (sh,length sh)) xs
+ width = (maximum $ snd $ unzip vs) + 2
+ ys = fmt width row (takeDrop row vs)
+
ex1, ex2 :: Arr
ex1 = listArray ((0,0),(2,2)) [25, 15, -5,
15, 18, 0,
@@ -13,5 +30,5 @@ ex2 = listArray ((0,0),(3,3)) [18, 22, 54, 42,
main :: IO ()
main = do
- print $ elems $ cholesky ex1
- print $ elems $ cholesky ex2
+ putStrLn $ showMatrice 3 $ elems $ cholesky ex1
+ putStrLn $ showMatrice 4 $ elems $ cholesky ex2
diff --git a/Task/Cholesky-decomposition/Julia/cholesky-decomposition.julia b/Task/Cholesky-decomposition/Julia/cholesky-decomposition.julia
new file mode 100644
index 0000000000..3e60100e38
--- /dev/null
+++ b/Task/Cholesky-decomposition/Julia/cholesky-decomposition.julia
@@ -0,0 +1,5 @@
+a = [25 15 5; 15 18 0; -5 0 11]
+b = [18 22 54 22; 22 70 86 62; 54 86 174 134; 42 62 134 106]
+
+println(a, "\n => \n", chol(a, :L))
+println(b, "\n => \n", chol(b, :L))
diff --git a/Task/Cholesky-decomposition/Perl-6/cholesky-decomposition.pl6 b/Task/Cholesky-decomposition/Perl-6/cholesky-decomposition.pl6
index 62b1811cf6..65724fc68c 100644
--- a/Task/Cholesky-decomposition/Perl-6/cholesky-decomposition.pl6
+++ b/Task/Cholesky-decomposition/Perl-6/cholesky-decomposition.pl6
@@ -3,7 +3,7 @@ sub cholesky(@A) {
for ^@A -> $i {
for 0..$i -> $j {
@L[$i][$j] = ($i == $j ?? &sqrt !! 1/@L[$j][$j] * * )(
- @A[$i][$j] - [+] (@L[$i] Z* @L[$j])[0..$j]
+ @A[$i][$j] - [+] (@L[$i;*] Z* @L[$j;*])[^$j]
);
}
}
diff --git a/Task/Cholesky-decomposition/Python/cholesky-decomposition-1.py b/Task/Cholesky-decomposition/Python/cholesky-decomposition-1.py
new file mode 100644
index 0000000000..976aca712d
--- /dev/null
+++ b/Task/Cholesky-decomposition/Python/cholesky-decomposition-1.py
@@ -0,0 +1,27 @@
+from __future__ import print_function
+
+from pprint import pprint
+from math import sqrt
+
+
+def cholesky(A):
+ L = [[0.0] * len(A) for _ in xrange(len(A))]
+ for i in xrange(len(A)):
+ for j in xrange(i+1):
+ s = sum(L[i][k] * L[j][k] for k in xrange(j))
+ L[i][j] = sqrt(A[i][i] - s) if (i == j) else \
+ (1.0 / L[j][j] * (A[i][j] - s))
+ return L
+
+if __name__ == "__main__":
+ m1 = [[25, 15, -5],
+ [15, 18, 0],
+ [-5, 0, 11]]
+ pprint(cholesky(m1))
+ print()
+
+ m2 = [[18, 22, 54, 42],
+ [22, 70, 86, 62],
+ [54, 86, 174, 134],
+ [42, 62, 134, 106]]
+ pprint(cholesky(m2), width=120)
diff --git a/Task/Cholesky-decomposition/Python/cholesky-decomposition-2.py b/Task/Cholesky-decomposition/Python/cholesky-decomposition-2.py
new file mode 100644
index 0000000000..bbdd30ae15
--- /dev/null
+++ b/Task/Cholesky-decomposition/Python/cholesky-decomposition-2.py
@@ -0,0 +1,8 @@
+def cholesky(A):
+ L = [[0.0] * len(A) for _ in range(len(A))]
+ for i, (Ai, Li) in enumerate(zip(A, L)):
+ for j, Lj in enumerate(L[:i+1]):
+ s = sum(Li[k] * Lj[k] for k in range(j))
+ Li[j] = sqrt(Ai[i] - s) if (i == j) else \
+ (1.0 / Lj[j] * (Ai[j] - s))
+ return L
diff --git a/Task/Cholesky-decomposition/Python/cholesky-decomposition.py b/Task/Cholesky-decomposition/Python/cholesky-decomposition.py
deleted file mode 100644
index 7e30cf3617..0000000000
--- a/Task/Cholesky-decomposition/Python/cholesky-decomposition.py
+++ /dev/null
@@ -1,22 +0,0 @@
-import math, pprint
-
-def cholesky(A):
- L = [[0.0] * len(A) for _ in xrange(len(A))]
- for i in xrange(len(A)):
- for j in xrange(i+1):
- s = sum(L[i][k] * L[j][k] for k in xrange(j))
- L[i][j] = math.sqrt(A[i][i] - s) if (i == j) else \
- (1.0 / L[j][j] * (A[i][j] - s))
- return L
-
-m1 = [[25, 15, -5],
- [15, 18, 0],
- [-5, 0, 11]]
-pprint.pprint(cholesky(m1))
-print
-
-m2 = [[18, 22, 54, 42],
- [22, 70, 86, 62],
- [54, 86, 174, 134],
- [42, 62, 134, 106]]
-pprint.pprint(cholesky(m2))
diff --git a/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx b/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx
index 74e4238b7c..811309f286 100644
--- a/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx
+++ b/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx
@@ -1,66 +1,51 @@
-/*REXX program to perform the Cholesky decomposition on square matrix.*/
-
-niner= '25 15 -5' ,
- '15 18 0' ,
- '-5 0 11'
- call Cholesky niner
-hexer= 18 22 54 42,
- 22 70 86 62,
- 54 86 174 134,
- 42 62 134 106
- call Cholesky hexer
-exit /*stick a fork in it, we're done.*/
-/*─────────────────────────────────────Cholesky subroutine──────────────*/
-Cholesky: procedure; arg !; call tell 'input array',!
-
- do row=1 for order
- do col=1 for row; s=0
- do i=1 for col-1
- s=s+$.row.i*$.col.i
- end /*i*/
- if row=col then $.row.row=sqrt($.row.row-s)
- else $.row.col=1/$.col.col*(@.row.col-s)
- end /*col*/
- end /*row*/
-
-call tell 'Cholesky factor',,$.,'─'
-return
-/*─────────────────────────────────────TELL subroutine───&find the order*/
-tell: parse arg hdr,x,y,sep; #=0; if sep=='' then sep='═'
-decPlaces = 5 /*number of decimal places past the decimal point. */
-width = 10 /*width of field to be used to display the elements*/
-
-if y=='' then $.=0
- else do row=1 for order
- do col=1 for order
- x=x $.row.col
- end /*row*/
- end /*col*/
-w=words(x)
-
- do order=1 until order**2>=w /*fast way to find the MAT order.*/
- end /*order*/
-
-if order**2\==w then call err "matrix elements don't match its order"
-say; say center(hdr, ((width+1)*w)%order, sep); say
-
- do row=1 for order; aLine=
- do col=1 for order; #=#+1
- @.row.col=word(x,#)
- if col<=row then $.row.col=@.row.col
- aLine=aLine right( format(@.row.col,, decPlaces) /1, width)
- end /*col*/
- say aLine
- end /*row*/
-return
-/*─────────────────────────────────────SQRT subroutine──────────────────*/
-sqrt: procedure; parse arg x; if x=0 then return 0; d=digits()
- numeric digits 11; g=.sqrtGuess(); do j=0 while p>9; m.j=p; p=p%2+1; end
- do k=j+5 to 0 by -1;if m.k>11 then numeric digits m.k;g=.5*(g+x/g);end
- numeric digits d; return g/1
-
-.sqrtGuess: if x<0 then call err 'SQRT of negative #'; numeric form
- m.=11; p=d+d%4+2; parse value format(x,2,1,,0) 'E0' with g 'E' _ .
- return g*.5'E'_%2
-/*─────────────────────────────────────ERR subroutine───────────────────*/
-err: say; say; say '***error***!'; say; say arg(1); say; say; exit 13
+/*REXX program performs the Cholesky decomposition on a square matrix. */
+niner = '25 15 -5' , /*define a 3x3 matrix. */
+ '15 18 0' ,
+ '-5 0 11'
+ call Cholesky niner
+hexer = 18 22 54 42, /*define a 4x4 matrix. */
+ 22 70 86 62,
+ 54 86 174 134,
+ 42 62 134 106
+ call Cholesky hexer
+exit /*stick a fork in it, we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+Cholesky: procedure; parse arg mat; say; say; call tell 'input array',mat
+ do r=1 for ord
+ do c=1 for r; $=0; do i=1 for c-1; $=$+!.r.i*!.c.i; end /*i*/
+ if r=c then !.r.r=sqrt(!.r.r-$)
+ else !.r.c=1/!.c.c*(@.r.c-$)
+ end /*c*/
+ end /*r*/
+ call tell 'Cholesky factor',,!.,'─'
+ return
+/*────────────────────────────────────────────────────────────────────────────*/
+err: say; say; say '***error***!'; say; say arg(1); say; say; exit 13
+/*────────────────────────────────────────────────────────────────────────────*/
+tell: parse arg hdr,x,y,sep; #=0; if sep=='' then sep='═'
+ dPlaces= 5 /*# decimal places past the decimal point*/
+ width =10 /*width of field used to display elements*/
+ if y=='' then !.=0
+ else do row=1 for ord; do col=1 for ord; x=x !.row.col; end; end
+ w=words(x)
+ do ord=1 until ord**2>=w; end /*a fast way to find matrix's order*/
+ say
+ if ord**2\==w then call err "matrix elements don't form a square matrix."
+ say center(hdr, ((width+1)*w)%ord, sep)
+ say
+ do row=1 for ord; z=
+ do col=1 for ord; #=#+1
+ @.row.col=word(x,#)
+ if col<=row then !.row.col=@.row.col
+ z=z right( format(@.row.col,, dPlaces) / 1, width)
+ end /*col*/
+ say z
+ end /*row*/
+ return
+/*────────────────────────────────────────────────────────────────────────────*/
+sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
+ numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
+ 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)i /*make complex if X < 0.*/
diff --git a/Task/Circles-of-given-radius-through-two-points/C++/circles-of-given-radius-through-two-points.cpp b/Task/Circles-of-given-radius-through-two-points/C++/circles-of-given-radius-through-two-points.cpp
new file mode 100644
index 0000000000..5be0873838
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/C++/circles-of-given-radius-through-two-points.cpp
@@ -0,0 +1,64 @@
+#include
+#include
+#include
+
+struct point { double x, y; };
+
+bool operator==(const point& lhs, const point& rhs)
+{ return std::tie(lhs.x, lhs.y) == std::tie(rhs.x, rhs.y); }
+
+enum result_category { NONE, ONE_COINCEDENT, ONE_DIAMETER, TWO, INFINITE };
+
+using result_t = std::tuple;
+
+double distance(point l, point r)
+{ return std::hypot(l.x - r.x, l.y - r.y); }
+
+result_t find_circles(point p1, point p2, double r)
+{
+ point ans1 { 1/0., 1/0.}, ans2 { 1/0., 1/0.};
+ if (p1 == p2) {
+ if(r == 0.) return std::make_tuple(ONE_COINCEDENT, p1, p2 );
+ else return std::make_tuple(INFINITE, ans1, ans2);
+ }
+ point center { p1.x/2 + p2.x/2, p1.y/2 + p2.y/2};
+ double half_distance = distance(center, p1);
+ if(half_distance > r) return std::make_tuple(NONE, ans1, ans2);
+ if(half_distance - r == 0) return std::make_tuple(ONE_DIAMETER, center, ans2);
+ double root = std::hypot(r, half_distance) / distance(p1, p2);
+ ans1.x = center.x + root * (p1.y - p2.y);
+ ans1.y = center.y + root * (p2.x - p1.x);
+ ans2.x = center.x - root * (p1.y - p2.y);
+ ans2.y = center.y - root * (p2.x - p1.x);
+ return std::make_tuple(TWO, ans1, ans2);
+}
+
+void print(result_t result, std::ostream& out = std::cout)
+{
+ point r1, r2; result_category res;
+ std::tie(res, r1, r2) = result;
+ switch(res) {
+ case NONE:
+ out << "There are no solutions, points are too far away\n"; break;
+ case ONE_COINCEDENT: case ONE_DIAMETER:
+ out << "Only one solution: " << r1.x << ' ' << r1.y << '\n'; break;
+ case INFINITE:
+ out << "Infinitely many circles can be drawn\n"; break;
+ case TWO:
+ out << "Two solutions: " << r1.x << ' ' << r1.y << " and " << r2.x << ' ' << r2.y << '\n'; break;
+ }
+}
+
+int main()
+{
+ constexpr int size = 5;
+ const point points[size*2] = {
+ {0.1234, 0.9876}, {0.8765, 0.2345}, {0.0000, 2.0000}, {0.0000, 0.0000},
+ {0.1234, 0.9876}, {0.1234, 0.9876}, {0.1234, 0.9876}, {0.8765, 0.2345},
+ {0.1234, 0.9876}, {0.1234, 0.9876}
+ };
+ const double radius[size] = {2., 1., 2., .5, 0.};
+
+ for(int i = 0; i < size; ++i)
+ print(find_circles(points[i*2], points[i*2 + 1], radius[i]));
+}
diff --git a/Task/Circles-of-given-radius-through-two-points/D/circles-of-given-radius-through-two-points.d b/Task/Circles-of-given-radius-through-two-points/D/circles-of-given-radius-through-two-points.d
index 2e04751a86..0d43a582cd 100644
--- a/Task/Circles-of-given-radius-through-two-points/D/circles-of-given-radius-through-two-points.d
+++ b/Task/Circles-of-given-radius-through-two-points/D/circles-of-given-radius-through-two-points.d
@@ -20,8 +20,8 @@ pure in {
if (r.abs < (1.0 / (2.0 ^^ nBits)))
throw new ValueException("radius of zero");
- if (feqrel(cast()p1.x, cast()p2.x) >= nBits &&
- feqrel(cast()p1.y, cast()p2.y) >= nBits)
+ if (feqrel(p1.x, p2.x) >= nBits &&
+ feqrel(p1.y, p2.y) >= nBits)
throw new ValueException("coincident points give" ~
" infinite number of Circles");
diff --git a/Task/Circles-of-given-radius-through-two-points/Elixir/circles-of-given-radius-through-two-points.elixir b/Task/Circles-of-given-radius-through-two-points/Elixir/circles-of-given-radius-through-two-points.elixir
new file mode 100644
index 0000000000..4a9df0b981
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Elixir/circles-of-given-radius-through-two-points.elixir
@@ -0,0 +1,38 @@
+defmodule RC do
+ def circle(p, p, r) when r>0.0 do
+ raise ArgumentError, message: "Infinite number of circles, points coincide."
+ end
+ def circle(p, p, r) when r==0.0 do
+ {px, py} = p
+ [{px, py, r}]
+ end
+ def circle({p1x,p1y}, {p2x,p2y}, r) do
+ {dx, dy} = {p2x-p1x, p2y-p1y}
+ q = :math.sqrt(dx*dx + dy*dy)
+ if q > 2*r do
+ raise ArgumentError, message: "Distance of points > diameter."
+ else
+ {x3, y3} = {(p1x+p2x) / 2, (p1y+p2y) / 2}
+ d = :math.sqrt(r*r - q*q/4)
+ Enum.uniq([{x3 - d*dy/q, y3 + d+dx/q, r}, {x3 + d*dy/q, y3 - d*dx/q, r}])
+ end
+ end
+end
+
+data = [{{0.1234, 0.9876}, {0.8765, 0.2345}, 2.0},
+ {{0.0000, 2.0000}, {0.0000, 0.0000}, 1.0},
+ {{0.1234, 0.9876}, {0.1234, 0.9876}, 2.0},
+ {{0.1234, 0.9876}, {0.8765, 0.2345}, 0.5},
+ {{0.1234, 0.9876}, {0.1234, 0.9876}, 0.0}]
+
+Enum.each(data, fn {p1, p2, r} ->
+ IO.write "Given points:\n #{inspect p1},\n #{inspect p2}\n and radius #{r}\n"
+ try do
+ circles = RC.circle(p1, p2, r)
+ IO.puts "You can construct the following circles:"
+ Enum.each(circles, fn circle -> IO.puts " #{inspect circle}" end)
+ rescue
+ e in ArgumentError -> IO.inspect e
+ end
+ IO.puts ""
+end)
diff --git a/Task/Circles-of-given-radius-through-two-points/J/circles-of-given-radius-through-two-points.j b/Task/Circles-of-given-radius-through-two-points/J/circles-of-given-radius-through-two-points.j
index cfa5d7f48b..7fa4f95c30 100644
--- a/Task/Circles-of-given-radius-through-two-points/J/circles-of-given-radius-through-two-points.j
+++ b/Task/Circles-of-given-radius-through-two-points/J/circles-of-given-radius-through-two-points.j
@@ -1,5 +1,3 @@
-[INPUT =: _5]\0.1234, 0.9876 0.8765, 0.2345 2.0 0.0000, 2.0000 0.0000, 0.0000 1.0 0.1234, 0.9876 0.1234, 0.9876 2.0 0.1234, 0.9876 0.8765, 0.2345 0.5 0.1234, 0.9876 0.1234, 0.9876 0.0
-
average =: +/ % #
circles =: verb define"1
@@ -21,6 +19,14 @@ circles =: verb define"1
end.
)
+INPUT=: ".;._2]0 :0
+ 0.1234 0.9876 0.8765 0.2345 2
+ 0 2 0 0 1
+ 0.1234 0.9876 0.1234 0.9876 2
+ 0.1234 0.9876 0.8765 0.2345 0.5
+ 0.1234 0.9876 0.1234 0.9876 0
+)
+
('x0 y0 x1 y1 r' ; 'center'),(;circles)"1 INPUT
┌───────────────────────────────┬────────────────────────────────────────────────────┐
│x0 y0 x1 y1 r │center │
diff --git a/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-1.julia b/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-1.julia
new file mode 100644
index 0000000000..050bcdea11
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-1.julia
@@ -0,0 +1,41 @@
+immutable Point{T<:FloatingPoint}
+ x::T
+ y::T
+end
+
+immutable Circle{T<:FloatingPoint}
+ c::Point{T}
+ r::T
+end
+Circle{T<:FloatingPoint}(a::Point{T}) = Circle(a, zero(T))
+
+using AffineTransforms
+
+function circlepoints{T<:FloatingPoint}(a::Point{T}, b::Point{T}, r::T)
+ cp = Circle{T}[]
+ r >= 0 || return (cp, "No Solution, Negative Radius")
+ if a == b
+ if abs(r) < 2eps(zero(T))
+ return (push!(cp, Circle(a)), "Point Solution, Zero Radius")
+ else
+ return (cp, "Infinite Solutions, Indefinite Center")
+ end
+ end
+ ca = Complex(a.x, a.y)
+ cb = Complex(b.x, b.y)
+ d = (ca + cb)/2
+ tfd = tformtranslate([real(d), imag(d)])
+ tfr = tformrotate(angle(cb-ca))
+ tfm = tfd*tfr
+ u = abs(cb-ca)/2
+ r-u > -5eps(r) || return(cp, "No Solution, Radius Too Small")
+ if r-u < 5eps(r)
+ push!(cp, Circle(apply(Point, tfm*[0.0, 0.0]), r))
+ return return (cp, "Single Solution, Degenerate Centers")
+ end
+ v = sqrt(r^2 - u^2)
+ for w in [v, -v]
+ push!(cp, Circle(apply(Point, tfm*[0.0, w]), r))
+ end
+ return (cp, "Two Solutions")
+end
diff --git a/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-2.julia b/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-2.julia
new file mode 100644
index 0000000000..882427a870
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Julia/circles-of-given-radius-through-two-points-2.julia
@@ -0,0 +1,27 @@
+tp = [Point(0.1234, 0.9876),
+ Point(0.0000, 2.0000),
+ Point(0.1234, 0.9876),
+ Point(0.1234, 0.9876),
+ Point(0.1234, 0.9876)]
+
+tq = [Point(0.8765, 0.2345),
+ Point(0.0000, 0.0000),
+ Point(0.1234, 0.9876),
+ Point(0.8765, 0.2345),
+ Point(0.1234, 0.9876)]
+
+tr = [2.0, 1.0, 2.0, 0.5, 0.0]
+
+println("Testing circlepoints:")
+for i in 1:length(tp)
+ p = tp[i]
+ q = tq[i]
+ r = tr[i]
+ (cp, rstatus) = circlepoints(p, q, r)
+ println(@sprintf("(%.4f, %.4f), (%.4f, %.4f), %.4f => %s",
+ p.x, p.y, q.x, q.y, r, rstatus))
+ for c in cp
+ println(@sprintf(" (%.4f, %.4f), %.4f",
+ c.c.x, c.c.y, c.r))
+ end
+end
diff --git a/Task/Circles-of-given-radius-through-two-points/Liberty-BASIC/circles-of-given-radius-through-two-points-1.liberty b/Task/Circles-of-given-radius-through-two-points/Liberty-BASIC/circles-of-given-radius-through-two-points-1.liberty
new file mode 100644
index 0000000000..ef80b947ca
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Liberty-BASIC/circles-of-given-radius-through-two-points-1.liberty
@@ -0,0 +1,45 @@
+'[RC] Circles of given radius through two points
+for i = 1 to 5
+ read x1, y1, x2, y2,r
+ print i;") ";x1, y1, x2, y2,r
+ call twoCircles x1, y1, x2, y2,r
+next
+end
+
+'p1 p2 r
+data 0.1234, 0.9876, 0.8765, 0.2345, 2.0
+data 0.0000, 2.0000, 0.0000, 0.0000, 1.0
+data 0.1234, 0.9876, 0.1234, 0.9876, 2.0
+data 0.1234, 0.9876, 0.8765, 0.2345, 0.5
+data 0.1234, 0.9876, 0.1234, 0.9876, 0.0
+
+sub twoCircles x1, y1, x2, y2,r
+
+ if x1=x2 and y1=y2 then '2.If the points are coincident
+ if r=0 then ' unless r==0.0
+ print "It will be a single point (";x1;",";y1;") of radius 0"
+ exit sub
+ else
+ print "There are any number of circles via single point (";x1;",";y1;") of radius ";r
+ exit sub
+ end if
+ end if
+ r2 = sqr((x1-x2)^2+(y1-y2)^2)/2 'half distance between points
+ if r 2 r :=
+ Message[circs::dist, p1x, p1y, p2x, p2y, r];
+circs[p1 : {p1x_, p1y_}, p2 : {p2x_, p2y_}, r_] :=
+ Values /@
+ Solve[Abs[x - p1x]^2 + Abs[y - p1y]^2 ==
+ Abs[x - p2x]^2 + Abs[y - p2y]^2 == r^2, {x, y}];
diff --git a/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx b/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx
index 0f508944c8..52012c9554 100644
--- a/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx
+++ b/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx
@@ -1,31 +1,33 @@
-/*REXX pgm finds 2 circles with a specific radius given two (X,Y) points*/
-@. =
-@.1 = 0.1234 0.9876 0.8765 0.2345 2
-@.2 = 0 2 0 0 1
-@.3 = 0.1234 0.9876 0.1234 0.9876 2
-@.4 = 0.1234 0.9876 0.8765 0.2345 0.5
-@.5 = 0.1234 0.9876 0.1234 0.9876 0
+/*REXX program finds two circles with a specific radius given two (X,Y) points*/
+@.=; @.1=0.1234 0.9876 0.8765 0.2345 2
+ @.2=0 2 0 0 1
+ @.3=0.1234 0.9876 0.1234 0.9876 2
+ @.4=0.1234 0.9876 0.8765 0.2345 0.5
+ @.5=0.1234 0.9876 0.1234 0.9876 0
say ' x1 y1 x2 y2 radius circle1x circle1y circle2x circle2y'
-say ' ──────── ──────── ──────── ──────── ────── ──────── ──────── ──────── ────────'
- do j=1 while @.j\=='' /*process all given points&radius*/
- do k=1 for 4; w.k=f(word(@.j,k)) /*format # with 4 dec digs*/
+say ' ════════ ════════ ════════ ════════ ══════ ════════ ════════ ════════ ════════'
+ do j=1 while @.j\=='' /*process the points and radii. */
+ do k=1 for 4; w.k=f(word(@.j,k)) /*format # with 4 decimal digits.*/
end /*k*/
- say w.1 w.2 w.3 w.4 center(word(@.j,5)/1,9) "───► " twoCircles(@.j)
+ say w.1 w.2 w.3 w.4 center(word(@.j,5)/1,9) "───► " 2circ(@.j)
end /*j*/
-exit /*stick a fork in it, we're done.*/
-/*──────────────────────────────────F subroutine────────────────────────*/
-f: return right(format(arg(1),,4),9) /*format a # with 4 decimal digs.*/
-/*──────────────────────────────────SQRT subroutine─────────────────────*/
-sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric digits 11
-numeric form; m.=11; p=d+d%4+2; parse value format(x,2,1,,0) 'E0' with g 'E' _ .
-g=g*.5'E'_%2; do j=0 while p>9; m.j=p; p=p%2+1; end
- do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end
-numeric digits d; return g/1
-/*──────────────────────────────────TWOCIRCLES subroutine───────────────*/
-twoCircles: procedure; parse arg px py qx qy r .
-x=(qx-px)/2; y=(qy-py)/2; bx=px+x; by=py+y; pb=sqrt(x**2+y**2)
-if r=0 then return 'radius of zero gives no circles'
-if pb=0 then return 'coincident points give infinite circles'
-if pb>r then return 'points are too far apart for the given radius'
-cb=sqrt(r**2-pb**2); x1=y*cb/pb; y1=x*cb/pb
-return f(bx-x1) f(by+y1) f(bx+x1) f(by-y1)
+exit /*stick a fork in it, we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+2circ: procedure; parse arg px py qx qy r .; x=(qx-px)/2; y=(qy-py)/2
+ bx=px+x; by=py+y; pb=sqrt(x**2+y**2)
+ if r=0 then return 'radius of zero yields no circles.'
+ if pb=0 then return 'coincident points give infinite circles.'
+ if pb>r then return 'points are too far apart for the specified radius.'
+ cb=sqrt(r**2-pb**2); x1=y*cb/pb; y1=x*cb/pb
+ return f(bx-x1) f(by+y1) f(bx+x1) f(by-y1)
+/*────────────────────────────────────────────────────────────────────────────*/
+f: f=right(format(arg(1),,4),9); _=f /*format # with four decimal digits.*/
+ if pos(.,f)\==0 then f=strip(f,'T',0) /*strip trailing 0s if decimal point*/
+ return left(strip(f,'T',.),length(_)) /*maybe strip trailing decimal point*/
+/*────────────────────────────────────────────────────────────────────────────*/
+sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
+ numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
+ 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)i /*make complex if X < 0.*/
diff --git a/Task/Circles-of-given-radius-through-two-points/Run-BASIC/circles-of-given-radius-through-two-points.run b/Task/Circles-of-given-radius-through-two-points/Run-BASIC/circles-of-given-radius-through-two-points.run
new file mode 100644
index 0000000000..b4749e334e
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Run-BASIC/circles-of-given-radius-through-two-points.run
@@ -0,0 +1,46 @@
+html ""
+html "| No. | x1 | y1 | x2 | y2 | r | cir x1 | cir y1 | cir x2 | cir y2 | "
+for i = 1 to 5
+ read x1, y1, x2, y2,r
+html "| ";i;" | ";x1;" | ";y1;" | ";x2;" | ";y2;" | ";r;" | "
+ gosub [twoCircles]
+next
+html " "
+end
+
+'p1 p2 r
+data 0.1234, 0.9876, 0.8765, 0.2345, 2.0
+data 0.0000, 2.0000, 0.0000, 0.0000, 1.0
+data 0.1234, 0.9876, 0.1234, 0.9876, 2.0
+data 0.1234, 0.9876, 0.8765, 0.2345, 0.5
+data 0.1234, 0.9876, 0.1234, 0.9876, 0.0
+
+[twoCircles]
+
+ if x1=x2 and y1=y2 then '2.If the points are coincident
+ if r=0 then ' unless r==0.0
+ html "It will be a single point (";x1;",";y1;") of radius 0 | "
+ RETURN
+ else
+ html "There are any number of circles via single point (";x1;",";y1;") of radius ";r;" | "
+ RETURN
+ end if
+ end if
+ r2 = sqr((x1-x2)^2+(y1-y2)^2)/2 'half distance between points
+ if rPoints are too far apart (";2*r2;") - there are no circles of radius ";r
+ RETURN
+ end if
+
+ 'else, calculate two centers
+ cx=(x1+x2)/2 'middle point
+ cy=(y1+y2)/2
+ 'should move from middle point along perpendicular by dd2
+ dd2=sqr(r^2-r2^2) 'perpendicular distance
+ dx1=x2-cx 'vector to middle point
+ dy1=y2-cy
+ dx = 0-dy1/r2*dd2 'perpendicular:
+ dy = dx1/r2*dd2 'rotate and scale
+ html "";cx+dy;" | ";cy+dx;" | " 'two points, with (+)
+ html "";cx-dy;" | ";cy-dx;" | " 'and (-)
+RETURN
diff --git a/Task/Circles-of-given-radius-through-two-points/Rust/circles-of-given-radius-through-two-points.rust b/Task/Circles-of-given-radius-through-two-points/Rust/circles-of-given-radius-through-two-points.rust
index fc5787a302..ee6c2e400a 100644
--- a/Task/Circles-of-given-radius-through-two-points/Rust/circles-of-given-radius-through-two-points.rust
+++ b/Task/Circles-of-given-radius-through-two-points/Rust/circles-of-given-radius-through-two-points.rust
@@ -1,58 +1,58 @@
use std::fmt;
+#[derive(Clone,Copy)]
struct Point {
x: f64,
y: f64
}
-impl Point {
- fn new(x : f64, y : f64) -> Point{
- Point{x : x, y : y}
- }
- fn distance (&self, p : Point) -> f64{
- ( (self.x - p.x).powi(2) + (self.y - p.y).powi(2) ).sqrt()
- }
+fn distance (p1: Point, p2: Point) -> f64 {
+ ((p1.x - p2.x).powi(2) + (p1.y - p2.y).powi(2)).sqrt()
}
-impl fmt::Show for Point { // a Point become printable in console
+impl fmt::Display for Point {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
- write!(f, "({:.4f}, {:.4f})", self.x, self.y)
+ write!(f, "({:.4}, {:.4})", self.x, self.y)
}
}
-fn is_circle(p1 : Point, p2 : Point, radius : f64){
- let separation = p1.distance(p2);
+fn describe_circle(p1: Point, p2: Point, r: f64) {
+ let sep = distance(p1, p2);
- if separation == 0.0 {
- if radius == 0.0 {
- println!("No circles can be drawn through {}", p1);
- } else {
- println!("Infinitely many circles can be drawn through {}", p1);
- }
- } else if separation == 2.0 * radius {
- println!("Given points are opposite ends of a diameter of the circle with center ({:.4f},{:.4f}) and radius {:.4f}",(p1.x+p2.x) / 2.0, (p1.y+p2.y) / 2.0, radius);
- } else if separation > 2.0 * radius {
- println!("Given points are farther away from each other than a diameter of a circle with radius {:.4f}", radius);
- } else {
- let mirror_distance = (radius.powi(2) - (separation / 2.0).powi(2)).sqrt();
-
- println!("Two circles are possible.");
- println!("Circle C1 with center ({:.4f}, {:.4f}), radius {:.4f} and Circle C2 with center ({:.4f}, {:.4f}), radius {:.4f}", ((p1.x + p2.x) / 2.0) + mirror_distance * (p1.y-p2.y)/separation, (p1.y+p2.y) / 2.0 + mirror_distance*(p2.x-p1.x)/separation, radius, (p1.x+p2.x) / 2.0 - mirror_distance*(p1.y-p2.y)/separation, (p1.y+p2.y) / 2.0 - mirror_distance*(p2.x-p1.x)/separation, radius);
- }
+ if sep == 0. {
+ if r == 0. {
+ println!("No circles can be drawn through {}", p1);
+ } else {
+ println!("Infinitely many circles can be drawn through {}", p1);
+ }
+ } else if sep == 2.0 * r {
+ println!("Given points are opposite ends of a diameter of the circle with center ({:.4},{:.4}) and r {:.4}",
+ (p1.x+p2.x) / 2.0, (p1.y+p2.y) / 2.0, r);
+ } else if sep > 2.0 * r {
+ println!("Given points are farther away from each other than a diameter of a circle with r {:.4}", r);
+ } else {
+ let mirror_dist = (r.powi(2) - (sep / 2.0).powi(2)).sqrt();
+
+ println!("Two circles are possible.");
+ println!("Circle C1 with center ({:.4}, {:.4}), r {:.4} and Circle C2 with center ({:.4}, {:.4}), r {:.4}",
+ ((p1.x + p2.x) / 2.0) + mirror_dist * (p1.y-p2.y)/sep, (p1.y+p2.y) / 2.0 + mirror_dist*(p2.x-p1.x)/sep,
+ r,
+ (p1.x+p2.x) / 2.0 - mirror_dist*(p1.y-p2.y)/sep, (p1.y+p2.y) / 2.0 - mirror_dist*(p2.x-p1.x)/sep, r);
+ }
}
fn main() {
- let points : Vec<(Point, Point)> = vec!(
- (Point::new(0.1234, 0.9876), Point::new(0.8765, 0.2345)),
- (Point::new(0.0000, 2.0000), Point::new(0.0000, 0.0000)),
- (Point::new(0.1234, 0.9876), Point::new(0.1234, 0.9876)),
- (Point::new(0.1234, 0.9876), Point::new(0.8765, 0.2345)),
- (Point::new(0.1234, 0.9876), Point::new(0.1234, 0.9876))
- );
- let radii : Vec = vec!(2.0, 1.0, 2.0, 0.5, 0.0);
-
- for (p, &r) in points.iter().zip(radii.iter()) {
- println!("\nPoints : {} \t Radius : {:.4f}", p, r);
- is_circle(p.val0(), p.val1(), r);
- }
+ let points: Vec<(Point, Point)> = vec![
+ (Point { x: 0.1234, y: 0.9876 }, Point { x: 0.8765, y: 0.2345 }),
+ (Point { x: 0.0000, y: 2.0000 }, Point { x: 0.0000, y: 0.0000 }),
+ (Point { x: 0.1234, y: 0.9876 }, Point { x: 0.1234, y: 0.9876 }),
+ (Point { x: 0.1234, y: 0.9876 }, Point { x: 0.8765, y: 0.2345 }),
+ (Point { x: 0.1234, y: 0.9876 }, Point { x: 0.1234, y: 0.9876 })
+ ];
+ let radii: Vec = vec![2.0, 1.0, 2.0, 0.5, 0.0];
+
+ for (p, r) in points.into_iter().zip(radii.into_iter()) {
+ println!("\nPoints: ({}, {}), Radius: {:.4}", p.0, p.1, r);
+ describe_circle(p.0, p.1, r);
+ }
}
diff --git a/Task/Circles-of-given-radius-through-two-points/Scala/circles-of-given-radius-through-two-points.scala b/Task/Circles-of-given-radius-through-two-points/Scala/circles-of-given-radius-through-two-points.scala
new file mode 100644
index 0000000000..34ec951847
--- /dev/null
+++ b/Task/Circles-of-given-radius-through-two-points/Scala/circles-of-given-radius-through-two-points.scala
@@ -0,0 +1,55 @@
+import org.scalatest.FunSuite
+import math._
+
+case class V2(x: Double, y: Double) {
+ val distance = hypot(x, y)
+ def /(other: V2) = V2((x+other.x) / 2.0, (y+other.y) / 2.0)
+ def -(other: V2) = V2(x-other.x,y-other.y)
+ override def equals(other: Any) = other match {
+ case p: V2 => abs(x-p.x) < 0.0001 && abs(y-p.y) < 0.0001
+ case _ => false
+ }
+ override def toString = f"($x%.4f, $y%.4f)"
+}
+
+case class Circle(center: V2, radius: Double)
+
+class PointTest extends FunSuite {
+ println(" p1 p2 r result")
+ Seq(
+ (V2(0.1234, 0.9876), V2(0.8765, 0.2345), 2.0, Seq(Circle(V2(1.8631, 1.9742), 2.0), Circle(V2(-0.8632, -0.7521), 2.0))),
+ (V2(0.0000, 2.0000), V2(0.0000, 0.0000), 1.0, Seq(Circle(V2(0.0, 1.0), 1.0))),
+ (V2(0.1234, 0.9876), V2(0.1234, 0.9876), 2.0, "coincident points yields infinite circles"),
+ (V2(0.1234, 0.9876), V2(0.8765, 0.2345), 0.5, "radius is less then the distance between points"),
+ (V2(0.1234, 0.9876), V2(0.1234, 0.9876), 0.0, "radius of zero yields no circles")
+ ) foreach { v =>
+ print(s"${v._1} ${v._2} ${v._3}: ")
+ circles(v._1, v._2, v._3) match {
+ case Right(list) => println(list mkString ",")
+ assert(list === v._4)
+ case Left(error) => println(error)
+ assert(error === v._4)
+ }
+ }
+
+ def circles(p1: V2, p2: V2, radius: Double) = if (radius == 0.0) {
+ Left("radius of zero yields no circles")
+ } else if (p1 == p2) {
+ Left("coincident points yields infinite circles")
+ } else if (radius * 2 < (p1-p2).distance) {
+ Left("radius is less then the distance between points")
+ } else {
+ Right(circlesThruPoints(p1, p2, radius))
+ } ensuring { result =>
+ result.isLeft || result.right.get.nonEmpty
+ }
+
+ def circlesThruPoints(p1: V2, p2: V2, radius: Double): Seq[Circle] = {
+ val diff = p2 - p1
+ val d = pow(pow(radius, 2) - pow(diff.distance / 2, 2), 0.5)
+ val mid = p1 / p2
+ Seq(
+ Circle(V2(mid.x - d * diff.y / diff.distance, mid.y + d * diff.x / diff.distance), abs(radius)),
+ Circle(V2(mid.x + d * diff.y / diff.distance, mid.y - d * diff.x / diff.distance), abs(radius))).distinct
+ }
+}
diff --git a/Task/Classes/C/classes.c b/Task/Classes/C/classes.c
index 0d98c78fc9..8e7765378c 100644
--- a/Task/Classes/C/classes.c
+++ b/Task/Classes/C/classes.c
@@ -1,3 +1,5 @@
+#include
+
typedef struct sMyClass
{
int variable;
@@ -5,15 +7,14 @@ typedef struct sMyClass
MyClass MyClass_new()
{
- MyClass pthis = malloc( sizeof(struct sMyClass) );
- //memset(pthis, 0, sizeof(struct sMyClass) );
+ MyClass pthis = malloc(sizeof *pthis);
pthis->variable = 0;
return pthis;
}
void MyClass_delete(MyClass* pthis)
{
- if(pthis && *pthis)
+ if (pthis)
{
free(*pthis);
*pthis = NULL;
diff --git a/Task/Classes/Forth/classes-7.fth b/Task/Classes/Forth/classes-7.fth
new file mode 100644
index 0000000000..ebe0433718
--- /dev/null
+++ b/Task/Classes/Forth/classes-7.fth
@@ -0,0 +1,31 @@
+include FMS-SI.f
+
+:class foo \ begin class foo definition
+ ivar x \ declare an instance variable named x
+ :m put ( n -- ) x ! ;m \ a method/message definition
+ :m init: 10 self put ;m \ the constructor method
+ :m print x ? ;m \ a print method for x
+;class \ end class foo definition
+
+foo f1 \ instantiate a foo object, in the dictionary, named f1
+f1 print \ 10 send the print message to object f1
+20 f1 put \ send a message with one parameter to the object
+f1 print \ 20
+
+
+: bar \ bar is a normal Forth function definition
+ heap> foo \ instantiate a nameless object in the heap
+ dup print
+ 30 over put
+ dup print
+ foo {: f :}
+ f print
+ 30 f put
+ f print
+ f calculate_circle_area
+ procedure, pass :: get_circle_diameter
+ final :: finalize_circle
+ end type TCircle
+
+ ! extended derived type
+ type, extends(TShape) :: TRectangle
+ type(TPoint) :: A,B,C,D
+ contains
+ procedure, pass :: calculate_area => calculate_rectangle_area
+ final :: finalize_rectangle
+ end type TRectangle
+
+ ! extended derived type
+ type, extends(TRectangle) :: TSquare
+ contains
+ procedure, pass :: calculate_area => calculate_square_area
+ final :: finalize_square
+ end type TSquare
+
+ contains
+
+ ! finalization subroutines for each type
+ ! They called recursively, i.e. finalize_rectangle
+ ! will be called after finalize_square subroutine
+ subroutine finalize_circle(x)
+ type(TCircle), intent(inout) :: x
+ write(*,*) "Deleting TCircle object"
+ end subroutine finalize_circle
+
+ subroutine finalize_rectangle(x)
+ type(TRectangle), intent(inout) :: x
+ write(*,*) "Deleting also TRectangle object"
+ end subroutine finalize_rectangle
+
+ subroutine finalize_square(x)
+ type(TSquare), intent(inout) :: x
+ write(*,*) "Deleting TSquare object"
+ end subroutine finalize_square
+
+ function calculate_circle_area(this)
+ implicit none
+ class(TCircle) :: this
+ real(rdp) :: calculate_circle_area
+ this%area = pi * this%radius**2
+ calculate_circle_area = this%area
+ end function calculate_circle_area
+
+ function calculate_rectangle_area(this)
+ implicit none
+ class(TRectangle) :: this
+ real(rdp) :: calculate_rectangle_area
+ ! here could be more code
+ this%area = 1
+ calculate_rectangle_area = this%area
+ end function calculate_rectangle_area
+
+ function calculate_square_area(this)
+ implicit none
+ class(TSquare) :: this
+ real(rdp) :: calculate_square_area
+ ! here could be more code
+ this%area = 1
+ calculate_square_area = this%area
+ end function calculate_square_area
+
+ function get_circle_diameter(this)
+ implicit none
+ class(TCircle) :: this
+ real(rdp) :: get_circle_diameter
+ this % diameter = 2.0_rdp * this % radius
+ get_circle_diameter = this % diameter
+ end function get_circle_diameter
+
+end module typedefs_module
+
+!-----------------------------------------------------------------------
+!Main program
+!-----------------------------------------------------------------------
+program rosetta_class
+ use accuracy_module
+ use typedefs_module
+ implicit none
+
+ ! we need this subroutine in order to show the finalization
+ call test_types()
+
+ contains
+
+ subroutine test_types()
+ implicit none
+ ! declare object of type TPoint
+ type(TPoint), target :: point
+ ! declare object of type TCircle
+ type(TCircle),target :: circle
+ ! declare object of type TSquare
+ type(TSquare),target :: square
+
+ ! declare pointers
+ class(TPoint), pointer :: ppo
+ class(TCircle), pointer :: pci
+ class(TSquare), pointer :: psq
+
+ !constructor
+ point = TPoint(5.d0,5.d0)
+ ppo => point
+ write(*,*) "x=",point%x,"y=",point%y
+
+ pci => circle
+
+ pci % radius = 1
+ write(*,*) pci % radius
+ ! write(*,*) pci % diameter !No,it is a PRIVATE component
+ write(*,*) pci % get_circle_diameter()
+ write(*,*) pci % calculate_area()
+ write(*,*) pci % area
+
+ psq => square
+
+ write(*,*) psq % area
+ write(*,*) psq % calculate_area()
+ write(*,*) psq % area
+ end subroutine test_types
+
+end program rosetta_class
diff --git a/Task/Classes/JavaScript/classes.js b/Task/Classes/JavaScript/classes-1.js
similarity index 100%
rename from Task/Classes/JavaScript/classes.js
rename to Task/Classes/JavaScript/classes-1.js
diff --git a/Task/Classes/JavaScript/classes-2.js b/Task/Classes/JavaScript/classes-2.js
new file mode 100644
index 0000000000..b590772fd2
--- /dev/null
+++ b/Task/Classes/JavaScript/classes-2.js
@@ -0,0 +1,77 @@
+class Car {
+ /**
+ * A few brands of cars
+ * @type {string[]}
+ */
+ static brands = ['Mazda', 'Volvo'];
+
+ /**
+ * Weight of car
+ * @type {number}
+ */
+ weight = 1000;
+
+ /**
+ * Brand of car
+ * @type {string}
+ */
+ brand;
+
+ /**
+ * Price of car
+ * @type {number}
+ */
+ price;
+
+ /**
+ * @param {string} brand - car brand
+ * @param {number} weight - mass of car
+ */
+ constructor(brand, weight) {
+ if (brand) this.brand = brand;
+ if (weight) this.weight = weight
+ }
+
+ /**
+ * Drive
+ * @param distance - distance to drive
+ */
+ drive(distance = 10) {
+ console.log(`A ${this.brand} ${this.constructor.name} drove ${distance}cm`);
+ }
+
+ /**
+ * Formatted stats string
+ */
+ get formattedStats() {
+ let out =
+ `Type: ${this.constructor.name.toLowerCase()}`
+ + `\nBrand: ${this.brand}`
+ + `\nWeight: ${this.weight}`;
+
+ if (this.size) out += `\nSize: ${this.size}`;
+
+ return out
+ }
+}
+
+class Truck extends Car {
+ /**
+ * Size of truck
+ * @type {number}
+ */
+ size;
+
+ /**
+ * @param {string} brand - car brand
+ * @param {number} size - size of car
+ */
+ constructor(brand, size) {
+ super(brand, 2000);
+ if (size) this.size = size;
+ }
+}
+
+let myTruck = new Truck('Volvo', 2);
+console.log(myTruck.formattedStats);
+myTruck.drive(40);
diff --git a/Task/Classes/TXR/classes.txr b/Task/Classes/TXR/classes.txr
new file mode 100644
index 0000000000..921d923b55
--- /dev/null
+++ b/Task/Classes/TXR/classes.txr
@@ -0,0 +1,24 @@
+(defstruct shape ()
+ cached-area
+
+ (:init (self)
+ (put-line `@self is born!`))
+
+ (:fini (self)
+ (put-line `@self says goodbye!`))
+
+ (:method area (self)
+ (or self.cached-area
+ (set self.cached-area self.(calc-area)))))
+
+(defstruct circle shape
+ (radius 1.0)
+
+ (:method calc-area (self)
+ (* %pi% self.radius self.radius)))
+
+(defstruct square shape
+ (length 1.0)
+
+ (:method calc-area (self)
+ (* self.length self.length)))
diff --git a/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir b/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir
new file mode 100644
index 0000000000..c55ab39a89
--- /dev/null
+++ b/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir
@@ -0,0 +1,24 @@
+defmodule Closest_pair do
+ def bruteForce([p0,p1|_] = points) do
+ pnts = List.to_tuple(points)
+ minDist = distance(p0, p1)
+ n = tuple_size(pnts)
+ {minDistance, minPoints} = Enum.reduce(0..n-2, {minDist, [0,1]}, fn i,{mD,mP} ->
+ Enum.reduce(i+1..n-1, {mD,mP}, fn j,{md,mp} ->
+ dist = distance(elem(pnts,i), elem(pnts,j))
+ if dist < md, do: {dist, [i,j]}, else: {md,mp}
+ end)
+ end)
+ {:math.sqrt(minDistance), minPoints}
+ end
+
+ defp distance({p0x,p0y}, {p1x,p1y}) do
+ (p1x - p0x) * (p1x - p0x) + (p1y - p0y) * (p1y - p0y)
+ end
+end
+
+data = [{0.654682, 0.925557}, {0.409382, 0.619391}, {0.891663, 0.888594}, {0.716629, 0.996200},
+ {0.477721, 0.946355}, {0.925092, 0.818220}, {0.624291, 0.142924}, {0.211332, 0.221507},
+ {0.293786, 0.691701}, {0.839186, 0.728260}]
+
+IO.inspect Closest_pair.bruteForce(data)
diff --git a/Task/Closest-pair-problem/JavaScript/closest-pair-problem.js b/Task/Closest-pair-problem/JavaScript/closest-pair-problem-1.js
similarity index 100%
rename from Task/Closest-pair-problem/JavaScript/closest-pair-problem.js
rename to Task/Closest-pair-problem/JavaScript/closest-pair-problem-1.js
diff --git a/Task/Closest-pair-problem/JavaScript/closest-pair-problem-2.js b/Task/Closest-pair-problem/JavaScript/closest-pair-problem-2.js
new file mode 100644
index 0000000000..18a0fcb918
--- /dev/null
+++ b/Task/Closest-pair-problem/JavaScript/closest-pair-problem-2.js
@@ -0,0 +1,137 @@
+var Point = function(x, y) {
+ this.x = x;
+ this.y = y;
+};
+Point.prototype.getX = function() {
+ return this.x;
+};
+Point.prototype.getY = function() {
+ return this.y;
+};
+
+var mergeSort = function mergeSort(points, comp) {
+ if(points.length < 2) return points;
+
+
+ var n = points.length,
+ i = 0,
+ j = 0,
+ leftN = Math.floor(n / 2),
+ rightN = leftN;
+
+
+ var leftPart = mergeSort( points.slice(0, leftN), comp),
+ rightPart = mergeSort( points.slice(rightN), comp );
+
+ var sortedPart = [];
+
+ while((i < leftPart.length) && (j < rightPart.length)) {
+ if(comp(leftPart[i], rightPart[j]) < 0) {
+ sortedPart.push(leftPart[i]);
+ i += 1;
+ }
+ else {
+ sortedPart.push(rightPart[j]);
+ j += 1;
+ }
+ }
+ while(i < leftPart.length) {
+ sortedPart.push(leftPart[i]);
+ i += 1;
+ }
+ while(j < rightPart.length) {
+ sortedPart.push(rightPart[j]);
+ j += 1;
+ }
+ return sortedPart;
+};
+
+var closestPair = function _closestPair(Px, Py) {
+ if(Px.length < 2) return { distance: Infinity, pair: [ new Point(0, 0), new Point(0, 0) ] };
+ if(Px.length < 3) {
+ //find euclid distance
+ var d = Math.sqrt( Math.pow(Math.abs(Px[1].x - Px[0].x), 2) + Math.pow(Math.abs(Px[1].y - Px[0].y), 2) );
+ return {
+ distance: d,
+ pair: [ Px[0], Px[1] ]
+ };
+ }
+
+ var n = Px.length,
+ leftN = Math.floor(n / 2),
+ rightN = leftN;
+
+ var Xl = Px.slice(0, leftN),
+ Xr = Px.slice(rightN),
+ Xm = Xl[leftN - 1],
+ Yl = [],
+ Yr = [];
+ //separate Py
+ for(var i = 0; i < Py.length; i += 1) {
+ if(Py[i].x <= Xm.x)
+ Yl.push(Py[i]);
+ else
+ Yr.push(Py[i]);
+ }
+
+ var dLeft = _closestPair(Xl, Yl),
+ dRight = _closestPair(Xr, Yr);
+
+ var minDelta = dLeft.distance,
+ closestPair = dLeft.pair;
+ if(dLeft.distance > dRight.distance) {
+ minDelta = dRight.distance;
+ closestPair = dRight.pair;
+ }
+
+
+ //filter points around Xm within delta (minDelta)
+ var closeY = [];
+ for(i = 0; i < Py.length; i += 1) {
+ if(Math.abs(Py[i].x - Xm.x) < minDelta) closeY.push(Py[i]);
+ }
+ //find min within delta. 8 steps max
+ for(i = 0; i < closeY.length; i += 1) {
+ for(var j = i + 1; j < Math.min( (i + 8), closeY.length ); j += 1) {
+ var d = Math.sqrt( Math.pow(Math.abs(closeY[j].x - closeY[i].x), 2) + Math.pow(Math.abs(closeY[j].y - closeY[i].y), 2) );
+ if(d < minDelta) {
+ minDelta = d;
+ closestPair = [ closeY[i], closeY[j] ]
+ }
+ }
+ }
+
+ return {
+ distance: minDelta,
+ pair: closestPair
+ };
+};
+
+
+var points = [
+ new Point(0.748501, 4.09624),
+ new Point(3.00302, 5.26164),
+ new Point(3.61878, 9.52232),
+ new Point(7.46911, 4.71611),
+ new Point(5.7819, 2.69367),
+ new Point(2.34709, 8.74782),
+ new Point(2.87169, 5.97774),
+ new Point(6.33101, 0.463131),
+ new Point(7.46489, 4.6268),
+ new Point(1.45428, 0.087596)
+];
+
+var sortX = function (a, b) { return (a.x < b.x) ? -1 : ((a.x > b.x) ? 1 : 0); }
+var sortY = function (a, b) { return (a.y < b.y) ? -1 : ((a.y > b.y) ? 1 : 0); }
+
+var Px = mergeSort(points, sortX);
+var Py = mergeSort(points, sortY);
+
+console.log(JSON.stringify(closestPair(Px, Py))) // {"distance":0.0894096443343775,"pair":[{"x":7.46489,"y":4.6268},{"x":7.46911,"y":4.71611}]}
+
+var points2 = [new Point(37100, 13118), new Point(37134, 1963), new Point(37181, 2008), new Point(37276, 21611), new Point(37307, 9320)];
+
+Px = mergeSort(points2, sortX);
+Py = mergeSort(points2, sortY);
+
+console.log(JSON.stringify(closestPair(Px, Py))); // {"distance":65.06919393998976,"pair":[{"x":37134,"y":1963},{"x":37181,"y":2008}]}
diff --git a/Task/Closest-pair-problem/Perl-6/closest-pair-problem.pl6 b/Task/Closest-pair-problem/Perl-6/closest-pair-problem.pl6
index b87c283417..db1eb030a2 100644
--- a/Task/Closest-pair-problem/Perl-6/closest-pair-problem.pl6
+++ b/Task/Closest-pair-problem/Perl-6/closest-pair-problem.pl6
@@ -15,7 +15,7 @@ sub dist-squared($a,$b) {
sub closest_pair_simple(@arr is copy) {
return Inf if @arr < 2;
- my ($a, $b, $d) = @arr[0,1], dist-squared(|@arr[0,1]);
+ my ($a, $b, $d) = flat @arr[0,1], dist-squared(|@arr[0,1]);
while @arr {
my $p = pop @arr;
for @arr -> $l {
diff --git a/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx b/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx
index 72295d045e..913f69f8e1 100644
--- a/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx
+++ b/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx
@@ -1,32 +1,33 @@
-/*REXX program solves the closest pair of points problem in 2 dimensions*/
-parse arg N low high seed . /*get optional arguments from CL.*/
-if N=='' | N==',' then N=100 /*N not specified? Use default.*/
-if low=='' | low==',' then low=0
-if high=='' | high==',' then high=20000
-if seed\==''& seed\==',' then call random ,,seed /*seed for repeatable.*/
+/*REXX program solves the closest pair of points problem in two dimensions.*/
+parse arg N low high seed . /*obtain optional arguments from the CL*/
+if N=='' | N==',' then N=100 /*Not specified? Then use the default.*/
+if low=='' | low==',' then low=0 /* " " " " " " */
+if high=='' |high==',' then high=20000 /* " " " " " " */
+if datatype(seed,'W') then call random ,,seed /*seed for RANDOM repeatable.*/
w=length(high); w=w + (w//2==0)
- /*╔══════════════════════╗*/ do j=1 for N /*gen N random pts.*/
- /*║ generate N points. ║*/ @x.j=random(low,high) /*random X.*/
- /*╚══════════════════════╝*/ @y.j=random(low,high) /* " Y.*/
+ /*╔══════════════════════╗*/ do j=1 for N /*generate N random points. */
+ /*║ generate N points. ║*/ @x.j=random(low,high) /*a random X. */
+ /*╚══════════════════════╝*/ @y.j=random(low,high) /*" " Y. */
end /*j*/
A=1; B=2
-minDD=(@x.A-@x.B)**2 + (@y.A-@y.B)**2 /*distance between 1st two points*/
+minDD=(@x.A-@x.B)**2 + (@y.A-@y.B)**2 /*distance between first two points. */
- do j=1 for N-1 /*find min distance between a ···*/
- do k=j+1 to N /*point and all the other points.*/
+ do j=1 for N-1 /*find minimum distance between a ··· */
+ do k=j+1 to N /* ··· point and all the other points.*/
dd=(@x.j - @x.k)**2 + (@y.j - @y.k)**2
if dd\=0 then if dd9; m.j=p; p=p%2+1; end
- do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end
-numeric digits d; return g/1
+ _= 'For ' N " points, the minimum distance between the two points: "
+say _ center("x",w,'═')" " center('y',w,"═") ' is: ' sqrt(abs(minDD))
+say left('', length(_)-1) '['right(@x.A, w)"," right(@y.A, w)"]"
+say left('', length(_)-1) '['right(@x.B, w)"," right(@y.B, w)"]"
+exit /*stick a fork in it, we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
+ numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
+ 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)i /*make complex if X < 0.*/
diff --git a/Task/Closures-Value-capture/Delphi/closures-value-capture.delphi b/Task/Closures-Value-capture/Delphi/closures-value-capture.delphi
index 6dad738f4f..594177ec1d 100644
--- a/Task/Closures-Value-capture/Delphi/closures-value-capture.delphi
+++ b/Task/Closures-Value-capture/Delphi/closures-value-capture.delphi
@@ -1,19 +1,27 @@
program Project1;
type
- TFuncIntResult = reference to function : integer;
+ TFuncIntResult = reference to function: Integer;
+
+// use function that returns anonymous method to avoid capturing the loop variable
+function CreateFunc(i: Integer): TFuncIntResult;
+begin
+ Result :=
+ function: Integer
+ begin
+ Result := i * i;
+ end;
+end;
var
- Funcs : array [0..9] of TFuncIntResult;
- i : integer;
-
+ Funcs: array[0..9] of TFuncIntResult;
+ i: integer;
begin
- // Create 10 anonymous functions
+ // create 10 anonymous functions
for i := Low(Funcs) to High(Funcs) do
- Funcs[i] := function() : integer begin Result := i*i; end;
+ Funcs[i] := CreateFunc(i);
// call all 10 functions
for i := Low(Funcs) to High(Funcs) do
- writeln( Funcs[i]() );
-
+ Writeln(Funcs[i]());
end.
diff --git a/Task/Closures-Value-capture/Racket/closures-value-capture-1.rkt b/Task/Closures-Value-capture/Racket/closures-value-capture-1.rkt
index 90874c61ba..456484ab55 100644
--- a/Task/Closures-Value-capture/Racket/closures-value-capture-1.rkt
+++ b/Task/Closures-Value-capture/Racket/closures-value-capture-1.rkt
@@ -1,3 +1,3 @@
#lang racket
-(map (λ(f) (f))
- (for/list ([i 10]) (λ () (* i i))))
+(define functions (for/list ([i 10]) (λ() (* i i))))
+(map (λ(f) (f)) functions)
diff --git a/Task/Closures-Value-capture/Rust/closures-value-capture.rust b/Task/Closures-Value-capture/Rust/closures-value-capture.rust
index ef171bd5d6..4dfd3acf78 100644
--- a/Task/Closures-Value-capture/Rust/closures-value-capture.rust
+++ b/Task/Closures-Value-capture/Rust/closures-value-capture.rust
@@ -1,4 +1,4 @@
fn main() {
- let fs: ~[proc() -> uint] = range(0u,10).map(|i| {proc() i*i}).collect();
- println!("7th val: {}", fs[7]());
+ let fs: Vec<_> = (0..10).map(|i| {move || i*i} ).collect();
+ println!("7th val: {}", fs[7]());
}
diff --git a/Task/Closures-Value-capture/Scheme/closures-value-capture-1.ss b/Task/Closures-Value-capture/Scheme/closures-value-capture-1.ss
index 7b183257b5..d1f0faf220 100644
--- a/Task/Closures-Value-capture/Scheme/closures-value-capture-1.ss
+++ b/Task/Closures-Value-capture/Scheme/closures-value-capture-1.ss
@@ -4,7 +4,7 @@
(build-list-of-functions n (+ i 1) (cons (lambda () (* (- n i) (- n i))) list))
list))
-(define list-of-functions (build-list-of-functions 11 1 '()))
+(define list-of-functions (build-list-of-functions 10 1 '()))
(map (lambda (f) (f)) list-of-functions)
diff --git a/Task/Closures-Value-capture/Scheme/closures-value-capture-2.ss b/Task/Closures-Value-capture/Scheme/closures-value-capture-2.ss
index 1e275f67a9..d41b750074 100644
--- a/Task/Closures-Value-capture/Scheme/closures-value-capture-2.ss
+++ b/Task/Closures-Value-capture/Scheme/closures-value-capture-2.ss
@@ -1,2 +1,2 @@
-(1 4 9 16 25 36 49 64 81 100)
+'(1 4 9 16 25 36 49 64 81)
81
diff --git a/Task/Closures-Value-capture/Scheme/closures-value-capture-3.ss b/Task/Closures-Value-capture/Scheme/closures-value-capture-3.ss
new file mode 100644
index 0000000000..a8517e1afa
--- /dev/null
+++ b/Task/Closures-Value-capture/Scheme/closures-value-capture-3.ss
@@ -0,0 +1,6 @@
+(define list-of-functions (map (lambda (x) (lambda () (* x x))) (iota 0 1 10)))
+
+; print the result
+(display
+ (map (lambda (n) (n)) list-of-functions)
+(newline)
diff --git a/Task/Closures-Value-capture/TXR/closures-value-capture-1.txr b/Task/Closures-Value-capture/TXR/closures-value-capture-1.txr
new file mode 100644
index 0000000000..65c559d685
--- /dev/null
+++ b/Task/Closures-Value-capture/TXR/closures-value-capture-1.txr
@@ -0,0 +1,2 @@
+(let ((funs (mapcar (ret (op * @@1 @@1)) (range 1 10))))
+ [mapcar call [funs 0..-1]])
diff --git a/Task/Closures-Value-capture/TXR/closures-value-capture-2.txr b/Task/Closures-Value-capture/TXR/closures-value-capture-2.txr
new file mode 100644
index 0000000000..052cdc36da
--- /dev/null
+++ b/Task/Closures-Value-capture/TXR/closures-value-capture-2.txr
@@ -0,0 +1 @@
+(1 4 9 16 25 36 49 64 81)
diff --git a/Task/Closures-Value-capture/TXR/closures-value-capture-3.txr b/Task/Closures-Value-capture/TXR/closures-value-capture-3.txr
new file mode 100644
index 0000000000..460ebea752
--- /dev/null
+++ b/Task/Closures-Value-capture/TXR/closures-value-capture-3.txr
@@ -0,0 +1,5 @@
+;; Dropping distracting "skip last" requirement
+;; (not implemented in original Elisp either).
+(mapcar 'call
+ (mapcar (lambda ()
+ (lambda () (* x x))) '(1 2 3 4 5 6 7 8 9 10)))
diff --git a/Task/Collections/ABAP/collections.abap b/Task/Collections/ABAP/collections.abap
new file mode 100644
index 0000000000..bef974eeaa
--- /dev/null
+++ b/Task/Collections/ABAP/collections.abap
@@ -0,0 +1,18 @@
+REPORT z_test_rosetta_collection.
+
+CLASS lcl_collection DEFINITION CREATE PUBLIC.
+
+ PUBLIC SECTION.
+ METHODS: start.
+ENDCLASS.
+
+CLASS lcl_collection IMPLEMENTATION.
+ METHOD start.
+ DATA(itab) = VALUE int4_table( ( 1 ) ( 2 ) ( 3 ) ).
+
+ cl_demo_output=>display( itab ).
+ ENDMETHOD.
+ENDCLASS.
+
+START-OF-SELECTION.
+ NEW lcl_collection( )->start( ).
diff --git a/Task/Collections/Elixir/collections-1.elixir b/Task/Collections/Elixir/collections-1.elixir
new file mode 100644
index 0000000000..7bc037a15b
--- /dev/null
+++ b/Task/Collections/Elixir/collections-1.elixir
@@ -0,0 +1,9 @@
+empty_list = []
+list = [1,2,3,4,5]
+length(list) #=> 5
+[0 | list] #=> [0,1,2,3,4,5]
+hd(list) #=> 1
+tl(list) #=> [2,3,4,5]
+Enum.at(list,3) #=> 4
+list ++ [6,7] #=> [1,2,3,4,5,6,7]
+list -- [4,2] #=> [1,3,5]
diff --git a/Task/Collections/Elixir/collections-2.elixir b/Task/Collections/Elixir/collections-2.elixir
new file mode 100644
index 0000000000..dd7d3a39d5
--- /dev/null
+++ b/Task/Collections/Elixir/collections-2.elixir
@@ -0,0 +1,5 @@
+empty_tuple = {} #=> {}
+tuple = {0,1,2,3,4} #=> {0, 1, 2, 3, 4}
+tuple_size(tuple) #=> 5
+elem(tuple, 2) #=> 2
+put_elem(tuple,3,:atom) #=> {0, 1, 2, :atom, 4}
diff --git a/Task/Collections/Elixir/collections-3.elixir b/Task/Collections/Elixir/collections-3.elixir
new file mode 100644
index 0000000000..5f103b622e
--- /dev/null
+++ b/Task/Collections/Elixir/collections-3.elixir
@@ -0,0 +1,4 @@
+list = [{:a,1},{:b,2}] #=> [a: 1, b: 2]
+list == [a: 1, b: 2] #=> true
+list[:a] #=> 1
+list ++ [c: 3, a: 5] #=> [a: 1, b: 2, c: 3, a: 5]
diff --git a/Task/Collections/Elixir/collections-4.elixir b/Task/Collections/Elixir/collections-4.elixir
new file mode 100644
index 0000000000..ff044d52eb
--- /dev/null
+++ b/Task/Collections/Elixir/collections-4.elixir
@@ -0,0 +1,7 @@
+empty_map = Map.new #=> %{}
+map = %{:a => 1, 2 => :b} #=> %{2 => :b, :a => 1}
+map[:a] #=> 1
+map[2] #=> :b
+
+# If you pass duplicate keys when creating a map, the last one wins:
+%{1 => 1, 1 => 2} #=> %{1 => 2}
diff --git a/Task/Collections/Elixir/collections-5.elixir b/Task/Collections/Elixir/collections-5.elixir
new file mode 100644
index 0000000000..896698a49f
--- /dev/null
+++ b/Task/Collections/Elixir/collections-5.elixir
@@ -0,0 +1,3 @@
+map = %{:a => 1, :b => 2} #=> %{a: 1, b: 2}
+map.a #=> 1
+%{map | :a => 2} #=> %{a: 2, b: 2}
diff --git a/Task/Collections/Elixir/collections-6.elixir b/Task/Collections/Elixir/collections-6.elixir
new file mode 100644
index 0000000000..9ec5765d87
--- /dev/null
+++ b/Task/Collections/Elixir/collections-6.elixir
@@ -0,0 +1,10 @@
+empty_set = HashSet.new #=> #HashSet<[]>
+set1 = Enum.into(1..4,HashSet.new) #=> #HashSet<[2, 3, 4, 1]>
+Set.size(set1) #=> 4
+Set.member?(set1,3) #=> true
+Set.put(set1,9) #=> #HashSet<[2, 3, 4, 1, 9]>
+set2 = Enum.into([0,2,4,6],HashSet.new) #=> #HashSet<[0, 2, 6, 4]>
+Set.union(set1,set2) #=> #HashSet<[0, 2, 6, 4, 3, 1]>
+Set.intersection(set1,set2) #=> #HashSet<[2, 4]>
+Set.difference(set1,set2) #=> #HashSet<[3, 1]>
+Set.subset?(set1,set2) #=> false
diff --git a/Task/Collections/JavaScript/collections-1.js b/Task/Collections/JavaScript/collections-1.js
index 9b6f1dfb34..086362a6bb 100644
--- a/Task/Collections/JavaScript/collections-1.js
+++ b/Task/Collections/JavaScript/collections-1.js
@@ -2,4 +2,4 @@ var array = [];
array.push('abc');
array.push(123);
array.push(new MyClass);
-alert( array[2] );
+console.log( array[2] );
diff --git a/Task/Collections/JavaScript/collections-2.js b/Task/Collections/JavaScript/collections-2.js
index b44f8a4b2d..bbe7f21b40 100644
--- a/Task/Collections/JavaScript/collections-2.js
+++ b/Task/Collections/JavaScript/collections-2.js
@@ -1,5 +1,5 @@
-var map = {};
-map['foo'] = 'xyz'; //equivalent to: map.foo = 'xyz';
-map['bar'] = new MyClass; //equivalent to: map.bar = new MyClass;
-map['1x; ~~:-b'] = 'text'; //no equivalent
-alert( map['1x; ~~:-b'] );
+var obj = {};
+obj['foo'] = 'xyz'; //equivalent to: obj.foo = 'xyz';
+obj['bar'] = new MyClass; //equivalent to: obj.bar = new MyClass;
+obj['1x; ~~:-b'] = 'text'; //no equivalent
+console.log(obj['1x; ~~:-b']);
diff --git a/Task/Collections/PARI-GP/collections-1.pari b/Task/Collections/PARI-GP/collections-1.pari
index 9f466035e7..e2a6777891 100644
--- a/Task/Collections/PARI-GP/collections-1.pari
+++ b/Task/Collections/PARI-GP/collections-1.pari
@@ -6,3 +6,4 @@ m = matrix(1,1);
s = Set(v);
l = List(v);
vs = vectorsmall(0);
+M = Map()
diff --git a/Task/Collections/PARI-GP/collections-2.pari b/Task/Collections/PARI-GP/collections-2.pari
index 5d446db9c1..467e117789 100644
--- a/Task/Collections/PARI-GP/collections-2.pari
+++ b/Task/Collections/PARI-GP/collections-2.pari
@@ -1,3 +1,4 @@
listput(l, "hello world")
v=concat(v, [1,2,3]);
v=concat(v, 4);
+mapput(M, "key", "value");
diff --git a/Task/Collections/Perl-6/collections-1.pl6 b/Task/Collections/Perl-6/collections-1.pl6
index 1a82f22906..c10d850614 100644
--- a/Task/Collections/Perl-6/collections-1.pl6
+++ b/Task/Collections/Perl-6/collections-1.pl6
@@ -3,14 +3,14 @@ my @array = 1,2,3;
@array.push: 4,5,6;
# Hash
-my %hash = a => 1, b => 2;
+my %hash = 'a' => 1, 'b' => 2;
%hash = 3,4;
-%hash.push: e => 5, f => 6;
+%hash.push: 'e' => 5, 'f' => 6;
-# KeySet
-my $s = KeySet.new: ;
+# SetHash
+my $s = SetHash.new: ;
$s ∪= ;
-# KeyBag
-my $b = KeyBag.new: ;
-$b.push: ;
+# BagHash
+my $b = BagHash.new: ;
+$b ⊎= ;
diff --git a/Task/Collections/Perl-6/collections-2.pl6 b/Task/Collections/Perl-6/collections-2.pl6
index 2e78e92ec9..073f9a86df 100644
--- a/Task/Collections/Perl-6/collections-2.pl6
+++ b/Task/Collections/Perl-6/collections-2.pl6
@@ -1,6 +1,6 @@
# List
my @list := 1,2,3;
-my @newlist := @list, 4,5,6;
+my @newlist := |@list, 4,5,6; # |@list will slip @list into the surrounding list instead of creating a list of lists
# Set
my $set = set ;
@@ -8,4 +8,4 @@ my $newset = $set ∪ ;
# Bag
my $bag = bag ;
-my $newbag = $bag ∪ ;
+my $newbag = $bag ⊎ ;
diff --git a/Task/Color-of-a-screen-pixel/Kotlin/color-of-a-screen-pixel.kotlin b/Task/Color-of-a-screen-pixel/Kotlin/color-of-a-screen-pixel.kotlin
new file mode 100644
index 0000000000..bb2c27b458
--- /dev/null
+++ b/Task/Color-of-a-screen-pixel/Kotlin/color-of-a-screen-pixel.kotlin
@@ -0,0 +1,12 @@
+import java.awt.Color
+import java.awt.MouseInfo
+import java.awt.Robot
+
+fun getMouseColor(): Color {
+ val location = MouseInfo.getPointerInfo().getLocation()
+ return getColorAt(location.x, location.y)
+}
+
+fun getColorAt(x: Int, y: Int): Color {
+ return Robot().getPixelColor(x, y)
+}
diff --git a/Task/Colour-bars-Display/Befunge/colour-bars-display.bf b/Task/Colour-bars-Display/Befunge/colour-bars-display.bf
new file mode 100644
index 0000000000..dc8f0a7dac
--- /dev/null
+++ b/Task/Colour-bars-Display/Befunge/colour-bars-display.bf
@@ -0,0 +1,6 @@
+$:55+%#v_:1-"P"%55+/3g^
+39*,,,~@>48*,1-:#v_$"m["
diff --git a/Task/Colour-bars-Display/PHP/colour-bars-display-1.php b/Task/Colour-bars-Display/PHP/colour-bars-display-1.php
index c21aa2e734..427057a5c0 100644
--- a/Task/Colour-bars-Display/PHP/colour-bars-display-1.php
+++ b/Task/Colour-bars-Display/PHP/colour-bars-display-1.php
@@ -1,12 +1,12 @@
{408, 408}]
diff --git a/Task/Combinations-and-permutations/Erlang/combinations-and-permutations.erl b/Task/Combinations-and-permutations/Erlang/combinations-and-permutations.erl
new file mode 100644
index 0000000000..75786a410a
--- /dev/null
+++ b/Task/Combinations-and-permutations/Erlang/combinations-and-permutations.erl
@@ -0,0 +1,42 @@
+-module(combinations_permutations).
+
+-export([test/0]).
+
+perm(N, K) ->
+ product(lists:seq(N - K + 1, N)).
+
+comb(N, K) ->
+ perm(N, K) div product(lists:seq(1, K)).
+
+product(List) ->
+ lists:foldl(fun(N, Acc) -> N * Acc end, 1, List).
+
+test() ->
+ io:format("\nA sample of permutations from 1 to 12:\n"),
+ [show_perm({N, N div 3}) || N <- lists:seq(1, 12)],
+ io:format("\nA sample of combinations from 10 to 60:\n"),
+ [show_comb({N, N div 3}) || N <- lists:seq(10, 60, 10)],
+ io:format("\nA sample of permutations from 5 to 15000:\n"),
+ [show_perm({N, N div 3}) || N <- [5,50,500,1000,5000,15000]],
+ io:format("\nA sample of combinations from 100 to 1000:\n"),
+ [show_comb({N, N div 3}) || N <- lists:seq(100, 1000, 100)],
+ ok.
+
+show_perm({N, K}) ->
+ show_gen(N, K, "perm", fun perm/2).
+
+show_comb({N, K}) ->
+ show_gen(N, K, "comb", fun comb/2).
+
+show_gen(N, K, StrFun, Fun) ->
+ io:format("~s(~p, ~p) = ~s\n",[StrFun, N, K, show_big(Fun(N, K), 40)]).
+
+show_big(N, Limit) ->
+ StrN = integer_to_list(N),
+ case length(StrN) < Limit of
+ true ->
+ StrN;
+ false ->
+ {Shown, Hidden} = lists:split(Limit, StrN),
+ io_lib:format("~s... (~p more digits)", [Shown, length(Hidden)])
+ end.
diff --git a/Task/Combinations-and-permutations/Haskell/combinations-and-permutations.hs b/Task/Combinations-and-permutations/Haskell/combinations-and-permutations.hs
new file mode 100644
index 0000000000..b0038fceb7
--- /dev/null
+++ b/Task/Combinations-and-permutations/Haskell/combinations-and-permutations.hs
@@ -0,0 +1,37 @@
+perm :: Integer -> Integer -> Integer
+perm n k = product [n-k+1..n]
+
+comb :: Integer -> Integer -> Integer
+comb n k = perm n k `div` product [1..k]
+
+main :: IO ()
+main = do
+ let showBig maxlen b =
+ let st = show b
+ stlen = length st
+ in if stlen < maxlen then st else take maxlen st ++ "... (" ++ show (stlen-maxlen) ++ " more digits)"
+
+ let showPerm pr =
+ putStrLn $ "perm(" ++ show n ++ "," ++ show k ++ ") = " ++ showBig 40 (perm n k)
+ where n = fst pr
+ k = snd pr
+
+ let showComb pr =
+ putStrLn $ "comb(" ++ show n ++ "," ++ show k ++ ") = " ++ showBig 40 (comb n k)
+ where n = fst pr
+ k = snd pr
+
+ putStrLn "A sample of permutations from 1 to 12:"
+ mapM_ showPerm [(n, n `div` 3) | n <- [1..12] ]
+
+ putStrLn ""
+ putStrLn "A sample of combinations from 10 to 60:"
+ mapM_ showComb [(n, n `div` 3) | n <- [10,20..60] ]
+
+ putStrLn ""
+ putStrLn "A sample of permutations from 5 to 15000:"
+ mapM_ showPerm [(n, n `div` 3) | n <- [5,50,500,1000,5000,15000] ]
+
+ putStrLn ""
+ putStrLn "A sample of combinations from 100 to 1000:"
+ mapM_ showComb [(n, n `div` 3) | n <- [100,200..1000] ]
diff --git a/Task/Combinations-and-permutations/J/combinations-and-permutations-1.j b/Task/Combinations-and-permutations/J/combinations-and-permutations-1.j
index c6b4481312..7fdb99e17e 100644
--- a/Task/Combinations-and-permutations/J/combinations-and-permutations-1.j
+++ b/Task/Combinations-and-permutations/J/combinations-and-permutations-1.j
@@ -1,2 +1,2 @@
C=: !
-P=: (<: * (*/@}. 1+i.))"0
+P=: (%&!&x:~ * <:)"0
diff --git a/Task/Combinations-and-permutations/Julia/combinations-and-permutations-1.julia b/Task/Combinations-and-permutations/Julia/combinations-and-permutations-1.julia
new file mode 100644
index 0000000000..7ef61366b1
--- /dev/null
+++ b/Task/Combinations-and-permutations/Julia/combinations-and-permutations-1.julia
@@ -0,0 +1,10 @@
+function Base.binomial{T<:FloatingPoint}(n::T, k::T)
+ exp(lfact(n) - lfact(n - k) - lfact(k))
+end
+
+function Base.factorial{T<:FloatingPoint}(n::T, k::T)
+ exp(lfact(n) - lfact(k))
+end
+
+⊞{T<:Real}(n::T, k::T) = binomial(n, k)
+⊠{T<:Real}(n::T, k::T) = factorial(n, n-k)
diff --git a/Task/Combinations-and-permutations/Julia/combinations-and-permutations-2.julia b/Task/Combinations-and-permutations/Julia/combinations-and-permutations-2.julia
new file mode 100644
index 0000000000..eff290c5cc
--- /dev/null
+++ b/Task/Combinations-and-permutations/Julia/combinations-and-permutations-2.julia
@@ -0,0 +1,52 @@
+function picknk{T<:Integer}(lo::T, hi::T)
+ n = rand(lo:hi)
+ k = rand(1:n)
+ return (n, k)
+end
+
+nsamp = 10
+
+print("Tests of the combinations (⊞) and permutations (⊠) operators for ")
+println("integer values.")
+println()
+lo, hi = 1, 12
+print(nsamp, " samples of n ⊠ k with n in [", lo, ", ", hi, "] ")
+println("and k in [1, n].")
+for i in 1:nsamp
+ (n, k) = picknk(lo, hi)
+ println(@sprintf " %2d ⊠ %2d = %18d" n k n ⊠ k)
+end
+
+lo, hi = 10, 60
+println()
+print(nsamp, " samples of n ⊞ k with n in [", lo, ", ", hi, "] ")
+println("and k in [1, n].")
+for i in 1:nsamp
+ (n, k) = picknk(lo, hi)
+ println(@sprintf " %2d ⊞ %2d = %18d" n k n ⊞ k)
+end
+
+println()
+print("Tests of the combinations (⊞) and permutations (⊠) operators for ")
+println("(big) float values.")
+println()
+lo, hi = 5, 15000
+print(nsamp, " samples of n ⊠ k with n in [", lo, ", ", hi, "] ")
+println("and k in [1, n].")
+for i in 1:nsamp
+ (n, k) = picknk(lo, hi)
+ n = BigFloat(n)
+ k = BigFloat(k)
+ println(@sprintf " %7.1f ⊠ %7.1f = %10.6e" n k n ⊠ k)
+end
+
+lo, hi = 100, 1000
+println()
+print(nsamp, " samples of n ⊞ k with n in [", lo, ", ", hi, "] ")
+println("and k in [1, n].")
+for i in 1:nsamp
+ (n, k) = picknk(lo, hi)
+ n = BigFloat(n)
+ k = BigFloat(k)
+ println(@sprintf " %7.1f ⊞ %7.1f = %10.6e" n k n ⊞ k)
+end
diff --git a/Task/Combinations-and-permutations/Perl-6/combinations-and-permutations.pl6 b/Task/Combinations-and-permutations/Perl-6/combinations-and-permutations.pl6
index 6b0e49fe9e..48778067e3 100644
--- a/Task/Combinations-and-permutations/Perl-6/combinations-and-permutations.pl6
+++ b/Task/Combinations-and-permutations/Perl-6/combinations-and-permutations.pl6
@@ -32,7 +32,7 @@ for 10, 20 ... 60 -> $n {
say "C($n, $p) = ", C($n, $p);
}
-say;
+say '';
say "Floating point approximations:";
for 5, 50, 500, 1000, 5000, 15000 -> $n {
my $p = $n div 3;
diff --git a/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx b/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx
index 4c74d830af..6a76dc4bcd 100644
--- a/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx
+++ b/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx
@@ -1,46 +1,44 @@
-/*REXX program to compute a sampling of combinations and permutations. */
-numeric digits 100 /*use hundred digits of precision*/
+/*REXX program to compute and show a sampling of combinations and permutations*/
+numeric digits 100 /*use 100 decimal digits of precision. */
- do j=1 to 12 /*show permutations from 1──► 12 */
- _=; do k=1 to j /*step through all J permutations*/
- _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between #s. */
- end /*k*/
- say strip(_) /*show a horizontal line of PERMs*/
+ do j=1 for 12 /*show all permutations from 1 ──► 12.*/
+ _=; do k=1 for j /*step through all J permutations. */
+ _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between numbers. */
+ end /*k*/
+ say strip(_) /*show the permutations horizontally. */
end /*j*/
say
- do j=10 to 60 by 10 /*show some combinations 10──► 60*/
- _=; do k=1 to j by j%5 /*step through some combinations.*/
- _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between #s. */
+ do j=10 to 60 by 10 /*show some combinations 10 ──► 60. */
+ _=; do k= 1 to j by j%5 /*step through some combinations. */
+ _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between numbers. */
end /*k*/
- say strip(_) /*show a horizontal line of COMBs*/
+ say strip(_) /*show the combinations horizontally. */
end /*j*/
say
-numeric digits 20 /*force floating point for big #s*/
+numeric digits 20 /*force floating point for big numbers.*/
- do j=5 to 15000 by 1000 /*show a few permutations, big #s*/
- _=; do k=1 to j by j%10 for 5 /*go through some J permutations.*/
- _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between #s. */
- end /*k*/
- say strip(_) /*show a horizontal line of PERMs*/
+ do j=5 to 15000 by 1000 /*show a few permutations, big numbers.*/
+ _=; do k=1 to j for 5 by j%10 /*step through some J permutations. */
+ _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between numbers. */
+ end /*k*/
+ say strip(_) /*show the permutations horizontally. */
end /*j*/
say
- do j=100 to 1000 by 100 /*show a few combinations, big #s*/
- _=; do k=1 to j by j%5 /*step through some combinations.*/
- _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between #s. */
- end /*k*/
- say strip(_) /*show a horizontal line of COMBs*/
+ do j=100 to 1000 by 100 /*show a few combinations, big numbers.*/
+ _=; do k= 1 to j by j%5 /*step through some combinations. */
+ _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between numbers. */
+ end /*k*/
+ say strip(_) /*show the combinations horizontally. */
end /*j*/
-exit /*stick a fork in it, we're done.*/
-/*──────────────────────────────────COMB subroutine─────────────────────*/
-comb: procedure; parse arg x,y /*args: X things, Y at-a-time.*/
-if y>x then return 0 /*oops-say, to big a chunk. */
-if x=y then return 1 /* X things same as chunk size. */
-if x-y |