Ouch. This should be a bit faster. The trick is to do a quick first pass through and count the number of occurrences of each (1st) word, and then go through a 2nd time and output only those lines where $words{$1} == 1.

#!/usr/bin/env perl

use 5.012;
use warnings FATAL => 'all';

my %words; # Number of times word appears first in a string
my @lines = <DATA>;
chomp @lines;

$words{$_}++ for map { /^(\S+)/ ? $1 : () } @lines;
say for grep { /^(\S+)/ ? $words{$1} == 1 : 1 } @lines;

__DATA__
hello 1234 5698 7458
hi 1457 7459 6214
good_day 1458
hi 1258 3658
good_morning 4758
hi 1453
oneword
hi
[download]

Output:

hello 1234 5698 7458
good_day 1458
good_morning 4758
oneword
[download]

my @array = (
"hello 1234 5698 7458",
"hi 1457 7459 6214",
"good_day 1458",
"hi 1258 3658",
"good_morning 4758",
"hi 1453",
);

# count all occurences
my %freqs;
for my $elem (@array) {
    my ($word) = $elem =~ /^(\w+)/;
    $freqs{$word}++;
}

# remove all multifrequent words
my @new_array;
for my $elem (@array) {
    my ($word) = $elem =~ /^(\w+)/;
    unless ($freqs{$word} > 1) {
        push @new_array, $elem;
    }
}
[download]

If original order doesn't matter try this approach. Broadly, it indexes the array items by using as key the first word. If an key becomes duplicated the item is removed. In detail it uses a hash where keys are the first word of every line in the array. If it tries to add a hash item that does exist (ie, a duplicated key) it sets the hash value to empty string. Finally it filters the hash values discarding those being an empty string.

my @array = (
"hello 1234 5698 7458",
"hi 1457 7459 6214",
"good_day 1458",
"hi 1258 3658",
"good_morning 4758",
"hi 1453",
);

my %indexedArray;
my $key;

foreach (@array) {
    $key = (split())[0];
    if ( defined $indexedArray{$key} ) {
        $indexedArray{$key} = '';
    }
    else {
        $indexedArray{$key} =  $_;
    }
}

@array = grep(/.+/,values(%indexedArray));
[download]

You should turn warnings on and rerun this script.

Iterating over the array in reverse will avoid the problem of the loop indices needing adjustment after an element is deleted.

Update: You changed the script while I was replying. Your description doesn't match now, although I suspect it will in a moment. ;o)

Sorry Loops, I made some changes before reading your comment. In fact the original script didn't work and I think your comment is not suitable for the new one. Sorry again, newbie behind the wheel :/

Anyway, I think your code doesn't work because of the initial value of $x in the second loop: Instead of $length-1 it might be $q-1.

That second loop has another bug: the exit condition ($x == 0) is wrong, it might be $x >= 0 in order to process all the lines starting from the previous being processed and ending when reaching the beginning of the file (array).

Finally the length of the array changes every time you delete an item, but your variable $length doesn't refresh its value.

The best way to do what you try to do in the way you try to do is processing the array backwards as the attached code shows. I've not tested it I think it reflects "the concept"

my $woord1;
my $woord2;

my $q = $@array-2;
while ( $q >= 0 ) {
    if ($array[$q] =~ /^(\w+|\_)(\s)(\d{4})/) {
        $woord1 = $1;
        $x = $q+1;
        while ($x < $@array) {
            if ($array[$x] =~ /^(\w+|\_)(\s)(\d{4})/) {
                $woord2 = $1;
                if ($woord1 eq $woord2) {
                    print "$woord1($q)\t$woord2($x)\n are the same";
                    delete $array[$x];
                    last;
                }
            }
            else {
                $x++;
            }
        }
    }
    
    $q--;
}
[download]

Similar to other solutions but storing each line along with a reference to the relevant word count hash element in an AoA then using grep and map to print only the lines we want. Note that I have to dereference ( ${ $_->[ 1 ] } ) to get at the value in the hash.

$ perl -Mstrict -Mwarnings -E '
open my $inFH, q{<}, \ <<EOD or die $!;
hello 1234 5698 7458
hi 1457 7459 6214
good_day 1458
hi 1258 3658 
good_morning 4758
hi 1453
EOD

my @lines;
my %counts;

while ( <$inFH> )
{
    my $first = ( split )[ 0 ];
    $counts{ $first } ++;
    push @lines, [ $_, \ $counts{ $first } ];
}

print for
   map  { $_->[ 0 ] }
   grep { ${ $_->[ 1 ] } == 1 }
   @lines;'
hello 1234 5698 7458
good_day 1458
good_morning 4758
$
[download]

I hope this is of interest.