aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

18
Task/ABC-Problem/Astro/abc-problem.astro
View file

@ -1,12 +1,12 @@
fun abc(s, list):
return true if s.empty
for i in [:list.size]:
return any([abc(s[:!1], delete(val list, i))]) ...
if s[!0] in list[i] else true
fun abc(str, list):
if list.isEmpty: return true
for i in indices(list) where s[!1] in list[i]:
return abc(str[:!2], remove(val list, i))
false
let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
let list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW",
"HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for s in test:
print "$:.-8(s) | $(abc(s, list))"
let list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for str in test:
print "$:>8(s) | $(abc(s, list))"

6
Task/ABC-Problem/Elena/abc-problem.elena
View file

@ -9,19 +9,19 @@ extension op
[
var list := ArrayList new:blocks.
^ $nil == self literal; upperCase; seekEach(:ch)
^ nil == self literal; upperCase; seekEach(:ch)
[
var index := list indexOfElement
((:word)(word indexOf:ch at:0 != -1) asComparator).
if (index>=0)
[ list remove at:index. ^ false ];
[ list removeAt:index. ^ false ];
[ ^ true ]
]
]
}
program =
public program =
[
var blocks := ("BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",

24
Task/ABC-Problem/Julia/abc-problem.julia
View file

@ -1,9 +1,17 @@
function abc (str, list)
isempty(str) && return true
for i = eachindex(list)
str[end] in list[i] &&
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
return true
end
false
function abc(str::AbstractString, list)
isempty(str) && return true
for i in eachindex(list)
str[end] in list[i] &&
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
return true
end
return false
end
let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"],
list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for str in test
@printf("%-8s | %s\n", str, abc(str, list))
end
end

13
Task/ABC-Problem/Maple/abc-problem.maple
View file

@ -1,14 +1,15 @@
canSpell := proc(w)
local blocks, i, j, word, letterFound;
blocks := [["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"], ["Q", "D"], ["F", "S"],
["J", "W"], ["H", "U"], ["V", "I"], ["A", "N"], ["O", "B"], ["E", "R"], ["F", "S"], ["L", "Y"], ["P", "C"], ["Z", "M"]];
blocks := Array([["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"],
["Q", "D"], ["F", "S"], ["J", "W"], ["H", "U"], ["V", "I"], ["A", "N"], ["O", "B"], ["E", "R"],
["F", "S"], ["L", "Y"], ["P", "C"], ["Z", "M"]]);
word := StringTools[UpperCase](convert(w, string));
for i to length(word) do
letterFound := false;
for j to numelems(blocks) do
if not letterFound and (substring(word, i) = blocks[j][1] or substring(word, i) = blocks[j][2]) then
blocks[j][1] := undefined;
blocks[j][2] := undefined;
for j to numelems(blocks)/2 do
if not letterFound and (substring(word, i) = blocks[j,1] or substring(word, i) = blocks[j,2]) then
blocks[j,1] := undefined;
blocks[j,2] := undefined;
letterFound := true;
end if;
end do;

14
Task/ABC-Problem/Oforth/abc-problem.oforth
View file

@ -1,10 +1,14 @@
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] const: ABCBlocks
import: mapping
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
const: ABCBlocks
: canMakeWord(w, blocks)
| i |
w isEmpty ifTrue: [ true return ]
w empty? ifTrue: [ true return ]
blocks size loop: i [
blocks at(i) include(w first toUpper) ifFalse: [ continue ]
canMakeWord(w right(w size 1 -), blocks del(i, i)) ifTrue: [ true return ]
w first >upper blocks at(i) include? ifFalse: [ continue ]
canMakeWord( w right( w size 1- ), blocks del(i, i) ) ifTrue: [ true return ]
]
false ;
false
;

16
Task/ABC-Problem/Red/abc-problem.red Normal file
View file

@ -0,0 +1,16 @@
Red []
test: func [ s][
p: copy "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
forever [
if 0 = length? s [ return 'true ] ;; if string cleared, all chars found/removed
if tail? p [ return 'false ] ;; if at end of search block - not found
rule: reduce [ first p '| second p] ;; construct parse rule from string
either parse s [ to rule remove rule to end ] [ ;; remove found char from string
remove/part p 2 ;;character found , remove block
p: head p ;;start from remaining string at beginning aka head
] [ p: skip p 2 ] ;; else move to next block
]
]
foreach word split {A bark book TrEAT COmMoN SQUAD conFUsE} space [
print reduce [ pad copy word 8 ":" test word]
]

34
Task/ABC-Problem/VBA/abc-problem.vba Normal file
View file

@ -0,0 +1,34 @@
Option Explicit
Sub Main_ABC()
Dim Arr, i As Long
Arr = Array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE")
For i = 0 To 6
Debug.Print ">>> can_make_word " & Arr(i) & " => " & ABC(CStr(Arr(i)))
Next i
End Sub
Function ABC(myWord As String) As Boolean
Dim myColl As New Collection
Dim NbLoop As Long, NbInit As Long
Dim b As Byte, i As Byte
Const BLOCKS As String = "B,O;X,K;D,Q;C,P;N,A;G,T;R,E;T,G;Q,D;F,S;J,W;H,U;V,I;A,N;O,B;E,R;F,S;L,Y;P,C;Z,M"
For b = 0 To 19
myColl.Add Split(BLOCKS, ";")(b), Split(BLOCKS, ";")(b) & b
Next b
NbInit = myColl.Count
NbLoop = NbInit
For b = 1 To Len(myWord)
For i = 1 To NbLoop
If i > NbLoop Then Exit For
If InStr(myColl(i), Mid(myWord, b, 1)) <> 0 Then
myColl.Remove (i)
NbLoop = NbLoop - 1
Exit For
End If
Next
Next b
ABC = (NbInit = (myColl.Count + Len(myWord)))
End Function