2
$\begingroup$

I would like to exclude non-western characters and words from a text file. I do not know how to insert the text file here, but I suppose you can do without it. All your suggestions will be much appreciated.

Update: I have used:

Alphabet["Russian"]
Select[dict21, Not@StringContainsQ[#, Alternatives @@ dict24Russion] &]

The problem is that there are several alphabets in the text (even unknown). There must be some solution of kind "include only Alphabet[]". What do you think?

$\endgroup$
  • 1
    $\begingroup$ You simply wish to delete all characters which are not from Alphabet[]? $\endgroup$ – Alexey Popkov Sep 16 '17 at 16:20
  • $\begingroup$ Exactly. Russian was just an example. $\endgroup$ – JSP Sep 16 '17 at 16:24
  • $\begingroup$ You can post your text file at pastebin.com and provide a link in your question. $\endgroup$ – Alexey Popkov Sep 16 '17 at 16:24
  • $\begingroup$ @JSP LanguageIdentify may be useful. i.stack.imgur.com/O4SK7.png $\endgroup$ – Alexey Golyshev Sep 16 '17 at 16:30
  • 3
    $\begingroup$ What does "Western" even mean? I find it a very weird description. $\endgroup$ – Szabolcs Sep 16 '17 at 17:35
6
$\begingroup$

How to delete all characters except from a list.

First, here is a string containing all the characters currently supported by String in the Wolfram Language:

allSupportedCharacters = FromCharacterCode@Range[0, 65535];

And here is a list of characters you wish to keep in the string:

list = Alphabet[];

Processing the string:

StringReplace[allSupportedCharacters, Except[list] -> ""]
"abcdefghijklmnopqrstuvwxyz"

or alternatively

StringDelete[allSupportedCharacters, Except[list]]
"abcdefghijklmnopqrstuvwxyz"

EDIT

Per request from a comment:

StringReplace[Import["https://sv.wikipedia.org/wiki/Kategori:Sjötermer"], 
 Except[list] -> ""]

screenshot

$\endgroup$
  • $\begingroup$ Thank you. However, Mathematica says "The argument Except[list] is not a valid string pattern" $\endgroup$ – JSP Sep 16 '17 at 16:55
  • $\begingroup$ @JSP Which Mathematica version do you use? $\endgroup$ – Alexey Popkov Sep 16 '17 at 16:56
  • $\begingroup$ version 10.3.0.0 $\endgroup$ – JSP Sep 16 '17 at 16:57
  • $\begingroup$ @JSP I have no access to version 10.3.0 but with version 10.4.1 my code works perfectly. Even with version 8.0.4 StringReplace[allSupportedCharacters, Except[list] -> ""] works if I set list = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"};. Are you sure you have reproduced my steps exactly? $\endgroup$ – Alexey Popkov Sep 16 '17 at 17:02
  • $\begingroup$ @JSP You haven't defined list, otherwise it wouldn't have said Except[list] – it would have replaced list with whatever you defined it to be in the message. $\endgroup$ – C. E. Sep 16 '17 at 17:11
3
$\begingroup$

Here's a better StringDelete than my first method, courtesy of Alexey Popkov:

text = Import["https://sv.wikipedia.org/wiki/Kategori:Sjötermer"];

pattern =
  Except[
   Join[Alphabet["Swedish"], 
    ToUpperCase@Alphabet["Swedish"], {PunctuationCharacter, 
     WhitespaceCharacter}
    ]
   ];

{timing, result} = StringDelete[text, pattern] // RepeatedTiming;
{timing, StringTake[result, 50]}

{0.00033, "Hjälp     Kategori:Sjötermer  

 Från Wikipedia  
 "}

Note how fast it is. And note that all it leaves behind are the Swedish diacritics:

StringCases[result,
 (Except[WhitespaceCharacter]?(Not@*PrintableASCIIQ))]

{"ä", "ö", "å", "ö", "ä", "å", "ö", "ä", "ä", "å", "ä", "ö", "å", \
"ö", "å", "ä", "ö", "ö", "ö", "ö", "ö", "ä", "ö", "ä", "ö", "å", "ä", \
"ö", "å", "ä", "å", "å", "å", "å", "ä", "ä", "ö", "ö", "ö", "ö", "ö", \
"ö", "å", "å", "ä", "å", "ö", "å", "ö", "ö", "ö", "ä", "ä", "ä", "ö", \
"å", "ä", "ä", "å", "å", "å", "ö", "ä", "ä", "ä", "ä", "å", "ä", "ä", \
"ä", "ä", "ä", "ä", "ä", "ä", "ö", "ö", "ä", "ä", "å", "ö", "ö", "å", \
"ö", "ö", "ä", "ö", "ä", "ä", "å", "ä", "ä", "ä", "å", "‎", "ä", "ä", \
"ä", "ä", "ö", "å", "ä", "ä", "ö", "å"}

We can compile it as a regex too, but unsurprisingly we get no noticeable boost:

regex =
  RegularExpression@
   StringPattern`PatternConvert[pattern][[1]];

StringDelete[text, regex] // RepeatedTiming // First

0.00032

Here's a way that works by matching only against LetterCharacter:

pattern2 =
  Except[
   Join[Function[Join[#, ToUpperCase[#]]]@Alphabet["Swedish"]],
   LetterCharacter
   ];

{timing2, result2} = StringDelete[text, pattern2] // RepeatedTiming;
timing2

0.00042

Here's a StringCases way:

StringJoin@
 StringCases[
  Import["https://sv.wikipedia.org/wiki/Kategori:Sjötermer"],
  (Alternatives @@ 
     Join[Alphabet["Swedish"], ToUpperCase@Alphabet["Swedish"]]) | 
   PunctuationCharacter | WhitespaceCharacter
  ]

Here's an updated regex base method which is faster than the StringCases way:

regex =
  RegularExpression[
   StringPattern`PatternConvert[(
       RegularExpression["[A-z]+"] |
        Alternatives @@
         Function[Join[#, ToUpperCase[#]]]@

          DeleteCases[Alphabet["Swedish"], 
           Alternatives @@ Alphabet[]]
       ) | PunctuationCharacter | WhitespaceCharacter
     ][[1]]
   ];

StringJoin@
 StringCases[
  text,
  regex
  ]

Note that this is much faster than the older method and gives similar results

{timing1, result1} =
  StringJoin@
    StringCases[
     text,
     regex
     ] // AbsoluteTiming;
{timing1, StringTake[result1, 100]}

{timing1, result1} =
  StringJoin@
    StringCases[
     text,
     regex
     ] // AbsoluteTiming;
{timing1, StringTake[result1, 100]}

{0.000769, "Hjälp     Kategori:Sjötermer  

 Från Wikipedia  

  Hoppa till:  navigering , sök    

 Termerna har"}
$\endgroup$
  • $\begingroup$ LetterCharacter?PrintableASCIIQ is equivalent to much faster RegularExpression["[A-z]"]. $\endgroup$ – Alexey Popkov Sep 16 '17 at 18:28
  • $\begingroup$ @AlexeyPopkov Oh true. Originally I didn't have the LetterCharacter in there, but that caused funky-ness. Except you mean RegularExpression["[^A-Z]+"]], I think. In any add the RemoveDiacritics onto C.E.'s answer as a comment. $\endgroup$ – b3m2a1 Sep 16 '17 at 18:29
  • $\begingroup$ It works nicely but I would like to have the whole text in Swedish, the å, ä and ö disappear, "Sjötermer - > Sjtermer" $\endgroup$ – JSP Sep 16 '17 at 18:31
  • $\begingroup$ @JSP Yeah that's where the RemoveDiacritics comes into play. Unless you want to keep those? $\endgroup$ – b3m2a1 Sep 16 '17 at 18:31
  • $\begingroup$ @AlexeyPopkov actually it's not quite the same. This preserves punctuation. The regex should be expanded for that. $\endgroup$ – b3m2a1 Sep 16 '17 at 18:33
3
$\begingroup$

It is especially easy to express the character range Alphabet[] that you mention using RegularExpression:

StringDelete["adeфfgh12cа34", RegularExpression["[^a-z]+"]]

"adefghc"

It will also be faster than other options. (Thanks to Alexey for pointing me towards StringDelete.)

To do the same for other alphabets I would suggest just looking at what you need beyond the a-z range, then just add that. So in the case of the Swedish alphabet it would be:

StringDelete["adeфfgh12cа34", RegularExpression["[^a-zåäö]+"]]

Also note that if you need to match capital letters as well then you should use

StringDelete["adeфfgh12cа34", RegularExpression["[^A-Za-zÅÄÖåäö]+"]]

Furthermore, you might want to add special characters which, while not in the alphabet, are used in Swedish texts:

str = "Spörj, forskare, så långt du gitter,
  vad residens som själen har.
  Det bästa svar blir Dumboms svar:
  \"Min vän, hon sitter där hon sitter.\"";
StringDelete[str, RegularExpression["[^A-Za-zÅÄÖåäö\n., –\"]+"]]

(* Out:
"Spörj, forskare, så långt du gitter,
vad residens som själen har.
Det bästa svar blir Dumboms svar
\"Min vän, hon sitter där hon sitter.\""
*)

\n corresponds to a new line.

$\endgroup$
  • 1
    $\begingroup$ StringDelete[string, RegularExpression["[^a-z]+"]] is even more than twice as fast. (+1) $\endgroup$ – Alexey Popkov Sep 16 '17 at 17:59
  • $\begingroup$ This works nicely! While we are at it, how to add the Swedish characters, that is characters Alphabet[] and Alphabet["Swedish"] or more generally how to add alphabets? I will now try to learn about RegularExpression too. $\endgroup$ – JSP Sep 16 '17 at 18:20
  • $\begingroup$ @JSP Unless you need your code to cover arbitrary alphabets then I would just create a specific pattern for the particular alphabet that I'm interested in. I added a note on how to do it for the Swedish alphabet to the answer as an example. $\endgroup$ – C. E. Sep 16 '17 at 20:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.