Better way to Insert variable every variable words (where variable is increasing)

I am working on a macro to help people train to learn speed listening.

Purpose: Basically, I think that people can learn to listen to text faster if they practice. This macro's job is to create a file that can be read by the mac speech synthesizer, but that increases its speed 1 word per minute every minute.

The way the macro currently works is that it inserts [[rate X] every X number of words by using the "alt+right arrow" repeated X times keystroke. Pretty sure it's not the most efficient way of doing it. Every time I try on a full book, it takes forever and then is going slower than I would expect. It's not that it's extremely slow, I was just wondering if there is a way of doing this that is faster (maybe a script or something).

Here's a video of what it looks like in action: https://drive.google.com/open?id=1_OgNnYZ70E3k2Hznd0lMNrsuGJOGsne-

Any thoughs?

By the way, a bit off topic, but let me know if you're interested in being a tester of the concept. I've used methods like this, though not as condensed or as formal to be able to listen to stuff at like 700 words per minute: https://drive.google.com/open?id=1qqrFQv26mnkP7k3eC1CnaQIoei80ET13

Macro: Speed Listening Trainer v2.kmmacros (2.6 KB)

You could do it using AppleScript reasonably quickly. Let's assume that your text is stored in a file at ~/Example/dialogue.txt.

The following AppleScript (which can be inserted into a Execute An AppleScript action) reads the contents of the text file; splits the text into individual items at every space, essentially breaking it into a word list; then inserts the rate marker text at the calculated position.

I hope it doesn't need to be precise with the number of words that fall in between each rate marker: ideally, from what you said, between rate markers "[[rate N]]" and "[[rate N+1]]", there should be (N+1) words of dialogue. However, for some reason, I ended up with (N+4) words of dialogue, so there's an extra three words in each rate block. Sorry. My maths was a bit off and I can't put the mental energy right now into figuring out where I went wrong. [ It's not as straightforward as removing the + 2 or something similar, as it will affect where the placement of the first rate marker occurs, plus the viability of the insertItem() handler, which, of course, can only operate within indices at which items exist. ]

After the rate markers have been inserted into the word list, the items are all joined back together and (over-)written back to the file.

property startRate : 180
property endRate : 700
property posixfile : POSIX file "/Users/%You%/Example/dialogue.txt"
property text item delimiters : space
--------------------------------------------------------------------------------
set dialogue to read the posixfile
set dialogueTextItems to the dialogue's text items

repeat with rate from startRate to endRate
	set position to 0.5 * ¬
		(rate - (startRate + 1)) * ¬
		(rate + startRate + 2) + ¬
		rate + 2 as integer
	
	if the position > (count dialogueTextItems) then exit repeat
	
	set dialogueTextItems to insertItem("[[rate " & rate & "]]", ¬
		a reference to the dialogueTextItems, ¬
		position)
end repeat

set dialogue to the dialogueTextItems as text
set eof of the posixfile to 0
write the dialogue to the posixfile as «class utf8»

display dialog "Document processing complete."
--------------------------------------------------------------------------------
###HANDLERS
#
# insertItem():
#	Inserts a new element, x, into list L at position (index) i. 
to insertItem(x, L as list, i as integer)
	local x, L, i
	
	if i = 1 or i = -((L's length) + 1) then return {} & x & L
	if i = -1 or i = ((L's length) + 1) then return {} & L & x
	if i < 0 then set i to i + 1
	
	script Array
		property |x₋| : items 1 thru (i - 1) of L
		property |x₊| : items i thru -1 of L
	end script
	
	tell the Array to return {} & its |x₋| & x & its |x₊|
end insertItem

The script should terminate when either the last rate marker has been placed, or the end of the dialogue text is reached, whichever comes first.

I tested this script on a 930KB text file containing 3,300 lines, totalling 136,500 words. Starting at rate marker 180, it reached rate marker 550. It took about 60 seconds to complete from within Script Editor on a MacBook 1.2 GHz Intel Core m5 8GB RAM.

You can likely increase performance by running it from Script Debugger or FastScripts. I'm not sure what Keyboard Maestro's AppleScript performance is like as a rule, since speed is very rarely, if ever, one of my personal priorities for the sorts of macros and scripts I run.

2 Likes

... and a variant using a KM Execute a Javascript for Automation action.

Seems to need less than a second to tag Pride and Prejudice (690K text file, 124,000 words):

Read-rate tagging of source file.kmmacros (22.4 KB)

Untitled

Javascript for Automation Source

(() => {
    'use strict';

    const main = () => {
        const
            kme = Application('Keyboard Maestro Engine'),
            vars = map(
                k => kme.getvariable(k), [
                    'qtSourcePath', 'qtTargetPath',
                    'qtStartRate', 'qtMaxRate'
                ]
            ),
            wds = readFile(head(vars)).split(/(?=\s+)/),
            intWords = wds.length,
            [intStart, intMax] = map(
                x => parseInt(x, 10), [vars[2], vars[3]]
            ),
            fpOut = vars[1],
            strTagged = concatMap(
                tpl => {
                    const
                        iPosn = fst(tpl),
                        iRate = snd(tpl);
                    return `[[rate ${iRate}]]${
                    concat(wds.slice(iPosn - iRate, iPosn))
                }`;
                },
                iterateUntil(
                    tpl => intMax <= snd(tpl) || intWords <= fst(tpl),
                    tpl => {
                        const d = 1 + snd(tpl);
                        return Tuple(d + fst(tpl), d);
                    },
                    Tuple(intStart, intStart)
                )
            );
        return (
            writeFile(fpOut,strTagged),
            `${wds.length} rate-tagged words written to:\n\t${fpOut}`
        );
    };

    // GENERIC FUNCTIONS --------------------------------------

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        xs.length > 0 ? (() => {
            const unit = typeof xs[0] === 'string' ? '' : [];
            return unit.concat.apply(unit, xs);
        })() : [];

    // concatMap :: (a -> [b]) -> [a] -> [b]
    const concatMap = (f, xs) => [].concat.apply([], xs.map(f));

    // fst :: (a, b) -> a
    const fst = tpl => tpl[0];

    // head :: [a] -> a
    const head = xs => xs.length ? xs[0] : undefined;

    // iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
    const iterateUntil = (p, f, x) => {
        let vs = [x],
            h = x;
        while (!p(h))(h = f(h), vs.push(h));
        return vs;
    };

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // readFile :: FilePath -> IO String
    const readFile = strPath => {
        const
            error = $(),
            str = ObjC.unwrap(
                $.NSString.stringWithContentsOfFileEncodingError(
                    $(strPath)
                    .stringByStandardizingPath,
                    $.NSUTF8StringEncoding,
                    error
                )
            );
        return Boolean(error.code) ? (
            ObjC.unwrap(error.localizedDescription)
        ) : str;
    };

    // showJSON :: a -> String
    const showJSON = x => JSON.stringify(x, null, 2);

    // snd :: (a, b) -> b
    const snd = tpl => tpl[1];

    // tail :: [a] -> [a]
    const tail = xs => xs.length > 0 ? xs.slice(1) : [];

    // writeFile :: FilePath -> String -> IO ()
    const writeFile = (strPath, strText) =>
        $.NSString.alloc.initWithUTF8String(strText)
        .writeToFileAtomicallyEncodingError(
            $(strPath)
            .stringByStandardizingPath, false,
            $.NSUTF8StringEncoding, null
        );

    // MAIN ---
    return main();
})();

1 Like

FWIW, this analogous AS script also takes less than 5 seconds to rate-tag Pride and Prejudice, but apart from being a little slower than the JS, it also replaces paragraph breaks with spaces, making the text less readable to the eye, though still (I think) readable to the speech generator:

use framework "Foundation"
use scripting additions

on run
    
    tell application "Keyboard Maestro Engine"
        set fpSource to getvariable ("qtSourcePath")
        set fpTarget to getvariable ("qtTargetPath")
        set intStart to (getvariable ("qtStartRate")) as number
        set intMax to (getvariable ("qtMaxRate")) as number
    end tell
    
    set wds to (|words|(readFile(fpSource)))
    set intWords to length of wds
    
    script isCompleted
        on |λ|(tpl)
            (intMax ≤ item 2 of tpl) or (intWords ≤ item 1 of tpl)
        end |λ|
    end script
    
    script nextTag
        on |λ|(tpl)
            set d to 1 + (item 2 of tpl)
            {d + (item 1 of tpl), d}
        end |λ|
    end script
    
    script taggedSection
        on |λ|(tpl)
            set iPosn to item 1 of tpl
            set iRate to item 2 of tpl
            "[[rate " & iRate & "]] " & unwords((items (1 + iPosn - iRate) thru min(intWords, iPosn) of wds))
        end |λ|
    end script
    
    set strTagged to concat(map(taggedSection, ¬
        iterateUntil(isCompleted, nextTag, {intStart, intStart})))
    
    writeFile(fpTarget, strTagged)
    return (intWords as string) & " rate-tagged words written to " & ¬
        linefeed & fpTarget
end run

-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
    set lng to length of xs
    if 0 < lng and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to lng
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    if 0 < lng and class of (item 1 of xs) is text then
        set acc to ""
    else
        set acc to {}
    end if
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & |λ|(item i of xs, i, xs)
        end repeat
    end tell
    return acc
end concatMap

-- fst :: (a, b) -> a
on fst(tpl)
    if class of tpl is record then
        |1| of tpl
    else
        item 1 of tpl
    end if
end fst

-- iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
on iterateUntil(p, f, x)
    script
        property mp : mReturn(p)'s |λ|
        property mf : mReturn(f)'s |λ|
        property lst : {x}
        on |λ|(v)
            repeat until mp(v)
                set v to mf(v)
                set end of lst to v
            end repeat
            return lst
        end |λ|
    end script
    |λ|(x) of result
end iterateUntil

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- readFile :: FilePath -> IO String
on readFile(strPath)
    set ca to current application
    set e to reference
    set {s, e} to (ca's NSString's ¬
        stringWithContentsOfFile:((ca's NSString's ¬
            stringWithString:strPath)'s ¬
            stringByStandardizingPath) ¬
            encoding:(ca's NSUTF8StringEncoding) |error|:(e))
    if e is missing value then
        s as string
    else
        (localizedDescription of e) as string
    end if
end readFile

-- snd :: (a, b) -> b
on snd(tpl)
    if class of tpl is record then
        |2| of tpl
    else
        item 2 of tpl
    end if
end snd

-- unwords :: [String] -> String
on unwords(xs)
    set {dlm, my text item delimiters} to {my text item delimiters, space}
    set s to xs as text
    set my text item delimiters to dlm
    return s
end unwords

-- words :: String -> [String]
on |words|(s)
    set ca to current application
    (((ca's NSString's stringWithString:(s))'s ¬
        componentsSeparatedByCharactersInSet:(ca's ¬
            NSCharacterSet's whitespaceAndNewlineCharacterSet()))'s ¬
        filteredArrayUsingPredicate:(ca's ¬
            NSPredicate's predicateWithFormat:"0 < length")) as list
end |words|

-- use framework "Foundation"
-- writeFile :: FilePath -> String -> IO ()
on writeFile(strPath, strText)
    set ca to current application
    (ca's NSString's stringWithString:strText)'s ¬
        writeToFile:(stringByStandardizingPath of ¬
            (ca's NSString's stringWithString:strPath)) atomically:true ¬
            encoding:(ca's NSUTF8StringEncoding) |error|:(missing value)
end writeFile
1 Like

Out of curiosity, how long does my script take on the same source material you used to test your scripts ? Of course it will be slower, but I’m wondering by what factor.

Good question – seems to take about 15 seconds with the PrideAndPrejudice.txt file. Very usable.

Thank you. I knew my hardware was negatively affecting the performance in a not insubstantial way.

1 Like

Thank you @ComplexPoint and @CJK. I ended up using the javascript.